Difference between revisions of "Web/Libraries/Formlets"
ChrisEidhof (talk | contribs) |
|||
Line 42: | Line 42: | ||
=== Simple validation === |
=== Simple validation === |
||
=== Monadic validation === |
=== Monadic validation === |
||
+ | |||
+ | == A working example == |
||
+ | |||
+ | This example code has shown to work with the latest formlets release (0.4.7): |
||
+ | <haskell> |
||
+ | module Main where |
||
+ | |||
+ | import HAppS.Server |
||
+ | import Control.Applicative |
||
+ | import Control.Applicative.Error |
||
+ | import Control.Applicative.State |
||
+ | import Text.XHtml.Strict.Formlets |
||
+ | import Text.XHtml.Strict ((+++), (<<), (!)) |
||
+ | import qualified Text.XHtml.Strict as X |
||
+ | import qualified Data.Map as M |
||
+ | |||
+ | type MyForm a = XHtmlForm IO a |
||
+ | |||
+ | data Date = Date {month :: Integer, day :: Integer} deriving Show |
||
+ | |||
+ | validDate :: Date -> Bool |
||
+ | validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31] |
||
+ | |||
+ | dateComponent :: MyForm Date |
||
+ | dateComponent = Date <$> inputInteger (Just 1) <*> inputInteger (Just 16) |
||
+ | |||
+ | dateFull :: MyForm Date |
||
+ | dateFull = dateComponent `check` ensure validDate "This is not a valid date" |
||
+ | |||
+ | handleDate :: [ServerPart Response] |
||
+ | handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d) |
||
+ | |||
+ | data User = User {name :: String, pass :: String, birthdate :: Date} deriving Show |
||
+ | |||
+ | userFull :: MyForm User |
||
+ | userFull = User <$> input Nothing <*> password Nothing <*> dateFull |
||
+ | |||
+ | handleUser = withForm "user" userFull showErrorsInline (\u -> okHtml $ show u) |
||
+ | |||
+ | withForm :: String -> MyForm a -> (X.Html -> [String] -> Web Response) -> (a -> Web Response) -> [ServerPart Response] |
||
+ | withForm name frm handleErrors handleOk = |
||
+ | [dir name |
||
+ | [ method GET $ createForm [] frm >>= okHtml |
||
+ | , withDataFn lookPairs $ \d -> [method POST $ handleOk' $ simple d] |
||
+ | ] |
||
+ | ] |
||
+ | where handleOk' d = do let (extractor, html, _) = runFormState d "" frm |
||
+ | v <- liftIO extractor |
||
+ | case v of |
||
+ | Failure faults -> do f <- createForm d frm |
||
+ | handleErrors f faults |
||
+ | Success s -> handleOk s |
||
+ | simple d = map (\(k,v) -> (k, Left v)) d |
||
+ | |||
+ | showErrorsInline :: X.Html -> [String] -> Web Response |
||
+ | showErrorsInline renderedForm errors = |
||
+ | okHtml $ X.toHtml (show errors) +++ renderedForm |
||
+ | |||
+ | createForm :: Env -> MyForm a -> Web X.Html |
||
+ | createForm env frm = do |
||
+ | let (extractor, xml, endState) = runFormState env "" frm |
||
+ | xml' <- liftIO xml |
||
+ | return $ X.form ! [X.method "POST"] << (xml' +++ X.submit "submit" "Submit") |
||
+ | |||
+ | okHtml :: (X.HTML a) => a -> Web Response |
||
+ | okHtml content = ok $ toResponse $ htmlPage $ content |
||
+ | |||
+ | htmlPage :: (X.HTML a) => a -> X.Html |
||
+ | htmlPage content = (X.header << (X.thetitle << "Testing forms")) +++ (X.body << content) |
||
+ | |||
+ | main = simpleHTTP (nullConf {port = 5000}) (handleDate ++ handleUser) |
||
+ | </haskell> |
||
== How it works == |
== How it works == |
Revision as of 16:43, 22 September 2008
Introduction
Formlets are a way of building HTML forms that are type-safe, handle errors, abstract and are easy to combine into bigger forms. Here's an example:
name :: Form String
name = input Nothing
The input function takes a Maybe String, and produces a XHtmlForm String. The Maybe String is used for default values. If you give it a nothing, it won't have a default value. If you pass in a (Just "value"), it will be pre-populated with the value "value".
You can easily combine formlets using the Applicative Functor combinators. Suppose you have a User-datatype:
data User = User {name :: String, age :: Integer, email :: String}
You can then build a form that produces a user:
userForm :: Form User
userForm = User <$> name <*> inputInteger <*> input Nothing
You can also have more advanced widgets, like a radio-choice, that's where you use enumRadio:
enumRadio :: (Monad m, Enum a) => [(a, String)] -> Maybe a -> Form a
So it asks for a list of pairs with a value and the corresponding label, a possible default-value and it will return something of type a.
chooseBool :: Form Bool
chooseBool = enumRadio [(True, "Yes"), (False, "No")] True
Now we have a widget for booleans that we can use everywhere in our forms!
The basics
Simple validation
Monadic validation
A working example
This example code has shown to work with the latest formlets release (0.4.7):
module Main where
import HAppS.Server
import Control.Applicative
import Control.Applicative.Error
import Control.Applicative.State
import Text.XHtml.Strict.Formlets
import Text.XHtml.Strict ((+++), (<<), (!))
import qualified Text.XHtml.Strict as X
import qualified Data.Map as M
type MyForm a = XHtmlForm IO a
data Date = Date {month :: Integer, day :: Integer} deriving Show
validDate :: Date -> Bool
validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31]
dateComponent :: MyForm Date
dateComponent = Date <$> inputInteger (Just 1) <*> inputInteger (Just 16)
dateFull :: MyForm Date
dateFull = dateComponent `check` ensure validDate "This is not a valid date"
handleDate :: [ServerPart Response]
handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d)
data User = User {name :: String, pass :: String, birthdate :: Date} deriving Show
userFull :: MyForm User
userFull = User <$> input Nothing <*> password Nothing <*> dateFull
handleUser = withForm "user" userFull showErrorsInline (\u -> okHtml $ show u)
withForm :: String -> MyForm a -> (X.Html -> [String] -> Web Response) -> (a -> Web Response) -> [ServerPart Response]
withForm name frm handleErrors handleOk =
[dir name
[ method GET $ createForm [] frm >>= okHtml
, withDataFn lookPairs $ \d -> [method POST $ handleOk' $ simple d]
]
]
where handleOk' d = do let (extractor, html, _) = runFormState d "" frm
v <- liftIO extractor
case v of
Failure faults -> do f <- createForm d frm
handleErrors f faults
Success s -> handleOk s
simple d = map (\(k,v) -> (k, Left v)) d
showErrorsInline :: X.Html -> [String] -> Web Response
showErrorsInline renderedForm errors =
okHtml $ X.toHtml (show errors) +++ renderedForm
createForm :: Env -> MyForm a -> Web X.Html
createForm env frm = do
let (extractor, xml, endState) = runFormState env "" frm
xml' <- liftIO xml
return $ X.form ! [X.method "POST"] << (xml' +++ X.submit "submit" "Submit")
okHtml :: (X.HTML a) => a -> Web Response
okHtml content = ok $ toResponse $ htmlPage $ content
htmlPage :: (X.HTML a) => a -> X.Html
htmlPage content = (X.header << (X.thetitle << "Testing forms")) +++ (X.body << content)
main = simpleHTTP (nullConf {port = 5000}) (handleDate ++ handleUser)