regular-web-0.1: Generic programming for the webSource codeContentsIndex
Generics.Regular.Formlets
Portabilitynon-portable
Stabilityexperimental
Maintainerchris@eidhof.nl
Contents
Generic forms
Generic forms with fclabels
Default Formlet typeclass
Extra form types
Description

Generic generation of formlets http://hackage.haskell.org/package/formlets. These functions are only defined for record datatypes that contain a single constructor.

Consider the datatype Person:

 data Person = Person {
    _name   :: String
  , _age    :: Int
  , _isMale :: Bool
 } deriving (Show, Eq)

We prefix all our fields with an underscore (_), so that our datatype will play nice with fclabels.

 $(deriveAll ''Person "PFPerson")
 type instance PF Person = PFPerson

We can construct an example person:

 chris    :: Person
 chris    = Person "chris" 25 True
 personForm :: XFormlet Identity Person
 personForm = gformlet

We can print formHtml to get the Html of the form with the chris value already filled in:

 formHtml :: X.Html
 (_, Identity formHtml, _) = F.runFormState [] (personForm (Just chris))
Synopsis
gform :: (Regular a, GFormlet (PF a), Functor m, Applicative m, Monad m) => Maybe a -> XForm m a
gformlet :: (Regular a, GFormlet (PF a), Functor m, Applicative m, Monad m) => XFormlet m a
class GFormlet f
type XForm m a = XHtmlForm m a
type XFormlet m a = XHtmlFormlet m a
projectedForm :: (Regular a, GFormlet (PF a), Applicative m, Monad m) => (b :-> a) -> b -> XForm m b
class Formlet a where
formlet :: (Functor m, Applicative m, Monad m) => XFormlet m a
data YesNo
= Yes
| No
boolToYesNo :: Bool :<->: YesNo
Generic forms
gform :: (Regular a, GFormlet (PF a), Functor m, Applicative m, Monad m) => Maybe a -> XForm m aSource
gformlet :: (Regular a, GFormlet (PF a), Functor m, Applicative m, Monad m) => XFormlet m aSource
class GFormlet f Source
show/hide Instances
Formlet a => GFormlet (K a)
(GFormlet (S s f), GFormlet g) => GFormlet (:*: (S s f) g)
(Constructor c, GFormlet f) => GFormlet (C c f)
(Selector s, GFormlet f) => GFormlet (S s f)
type XForm m a = XHtmlForm m aSource
type XFormlet m a = XHtmlFormlet m aSource
Generic forms with fclabels
projectedForm :: (Regular a, GFormlet (PF a), Applicative m, Monad m) => (b :-> a) -> b -> XForm m bSource

Generic forms almost never match the real world. If you want to change a generic form, you can either implement it from scratch, or use the projectedForm function.

As an example, we will to remove the age field from the form, and change the _isMale field to a Yes/No choice instead of a True/False choice. The datatype YesNo is defined in this module.

 data PersonView = PersonView {
    __name   :: String
  , __isMale :: YesNo
 }
 $(deriveAll ''PersonView "PFPersonView")
 type instance PF PersonView = PFPersonView

We can now use fclabels to convert back and forth between Person and PersonView. First, we use Template Haskell to generate some accessor functions:

 $(mkLabels [''Person])

This is the bidirectional function between Person and PersonView. How to write such a function is explained in the well-documented fclabels package at http://hackage.haskell.org/package/fclabels.

 toView :: Person :-> PersonView
 toView = Label (PersonView <$> __name `for` name <*> __isMale `for` (boolToYesNo `iso` isMale))

Now that we have a function with type Person :-> PersonView, we can render a form for personView and update the original person. Note that the argument is not a Maybe value, in contrast with the gformlet function.

 personForm' :: Person -> XForm Identity Person
 personForm' = projectedForm toView
 formHtml' :: X.Html
 (_, Identity formHtml', _) = F.runFormState [] (personForm' chris)
Default Formlet typeclass
class Formlet a whereSource
Methods
formlet :: (Functor m, Applicative m, Monad m) => XFormlet m aSource
show/hide Instances
Extra form types
Currently, this section is very limited. We expect to add more types in the future, suggestions are welcome.
data YesNo Source
This datatype is used to display Bool values as Yes or No.
Constructors
Yes
No
show/hide Instances
boolToYesNo :: Bool :<->: YesNoSource
This is an fclabels function that converts between Bool and YesNo values.
Produced by Haddock version 2.7.2