Web/Libraries/Formlets
From HaskellWiki
m (Formlets moved to Web/Libraries/Formlets) |
|||
| (10 intermediate revisions not shown.) | |||
| Line 44: | Line 44: | ||
== A working example == | == A working example == | ||
| + | Below is a self-contained example that uses | ||
| + | [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/formlets Formlets] | ||
| + | and | ||
| + | [http://hackage.haskell.org/package/happstack-server Happstack-Server]. | ||
| + | |||
| + | === Prepare your system === | ||
| + | First install Formlets and Happstack-Server on your system: | ||
| + | |||
| + | <pre> | ||
| + | $ cabal install formlets happstack-server | ||
| + | </pre> | ||
| + | |||
| + | === The example code === | ||
| + | Put the following in a file called <hask>Main.hs</hask>: | ||
| - | |||
<haskell> | <haskell> | ||
module Main where | module Main where | ||
| - | import | + | import Control.Applicative |
| - | + | import Control.Applicative.Error | |
| - | import Control.Applicative.Error | + | import Control.Applicative.State |
| - | import Control.Applicative.State | + | import Data.List as List |
| - | import Text.XHtml.Strict.Formlets | + | import Happstack.Server |
| - | import Text.XHtml.Strict ((+++), (<<), (!)) | + | import Text.Formlets |
| - | import qualified Text.XHtml.Strict as X | + | import Text.XHtml.Strict.Formlets |
| - | + | import Text.XHtml.Strict ((+++),(<<),(!)) | |
| + | import qualified Text.XHtml.Strict as X | ||
type MyForm a = XHtmlForm IO a | type MyForm a = XHtmlForm IO a | ||
| - | data Date = Date {month :: Integer, day :: Integer} deriving Show | + | data Date = Date {month :: Integer, day :: Integer} |
| + | deriving Show | ||
validDate :: Date -> Bool | validDate :: Date -> Bool | ||
validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31] | validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31] | ||
| - | dateComponent :: MyForm Date | + | dateComponent :: MyForm Date |
dateComponent = Date <$> inputInteger (Just 1) <*> inputInteger (Just 16) | dateComponent = Date <$> inputInteger (Just 1) <*> inputInteger (Just 16) | ||
dateFull :: MyForm Date | dateFull :: MyForm Date | ||
| - | dateFull | + | dateFull = dateComponent `check` ensure validDate "This is not a valid date" |
| - | handleDate :: | + | handleDate :: ServerPartT IO Response |
handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d) | handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d) | ||
| - | data User = User {name :: String, pass :: String, birthdate :: Date} deriving Show | + | data User = User {name :: String, pass :: String, birthdate :: Date} |
| + | deriving Show | ||
userFull :: MyForm User | userFull :: MyForm User | ||
| Line 81: | Line 97: | ||
handleUser = withForm "user" userFull showErrorsInline (\u -> okHtml $ show u) | handleUser = withForm "user" userFull showErrorsInline (\u -> okHtml $ show u) | ||
| - | withForm :: String -> MyForm a -> (X.Html -> [String] -> | + | withForm |
| - | withForm name frm handleErrors handleOk = | + | :: String |
| - | + | -> MyForm a | |
| - | + | -> (X.Html -> [String] -> ServerPartT IO Response) | |
| - | + | -> (a -> ServerPartT IO Response) | |
| - | + | -> ServerPartT IO Response | |
| + | withForm name frm handleErrors handleOk = dir name $ msum | ||
| + | [ methodSP GET $ createForm [] frm >>= okHtml | ||
| + | , withDataFn lookPairs $ \d -> | ||
| + | methodSP POST $ handleOk' $ simple d | ||
] | ] | ||
| - | where handleOk' d = do let (extractor, html, _) = runFormState 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 = List.map (\(k,v) -> (k, Left v)) d | ||
| - | showErrorsInline :: X.Html -> [String] -> | + | showErrorsInline :: X.Html -> [String] -> ServerPartT IO Response |
showErrorsInline renderedForm errors = | showErrorsInline renderedForm errors = | ||
okHtml $ X.toHtml (show errors) +++ renderedForm | okHtml $ X.toHtml (show errors) +++ renderedForm | ||
| - | createForm :: Env -> MyForm a -> | + | createForm :: Env -> MyForm a -> ServerPartT IO X.Html |
createForm env frm = do | createForm env frm = do | ||
| - | let (extractor, xml, endState) = runFormState env | + | let (extractor, xml, endState) = runFormState env frm |
| - | + | return $ X.form ! [X.method "POST"] << (xml +++ X.submit "submit" "Submit") | |
| - | return $ X.form ! [X.method "POST"] << (xml | + | |
| - | okHtml :: (X.HTML a) => a -> | + | okHtml :: (X.HTML a) => a -> ServerPartT IO Response |
okHtml content = ok $ toResponse $ htmlPage $ content | okHtml content = ok $ toResponse $ htmlPage $ content | ||
htmlPage :: (X.HTML a) => a -> X.Html | htmlPage :: (X.HTML a) => a -> X.Html | ||
| - | htmlPage content = (X.header | + | htmlPage content = (X.header << (X.thetitle << "Testing forms")) |
| + | +++ (X.body << content) | ||
| - | main = simpleHTTP (nullConf {port = 5000}) (handleDate ++ handleUser) | + | main = simpleHTTP (nullConf {port = 5000}) (handleDate `mplus` handleUser) |
| + | |||
| + | |||
| + | </haskell> | ||
| + | |||
| + | === Running the example === | ||
| + | Start up the Happstack server with | ||
| + | <pre> | ||
| + | $ runhaskell Main.hs | ||
| + | </pre> | ||
| + | and point your web browser at http://localhost:5000/date/ | ||
| + | and http://localhost:5000/user/. | ||
| + | |||
| + | === Extending the example === | ||
| + | Text.XHtml.Strict.Formlets provides form elements other than text input. To see some of them in action we can make some simple modifications to Main.hs. | ||
| + | |||
| + | Add the following lines to the end of Main.hs: | ||
| + | <haskell> | ||
| + | data UserExtra = UserExtra {userBase :: User | ||
| + | , likesSpam :: Bool | ||
| + | , eyeColour :: EyeColour | ||
| + | , luckyNumber :: Integer | ||
| + | , favouriteThings :: [String] } | ||
| + | deriving Show | ||
| + | |||
| + | data EyeColour = Blue | Green | Grey | Brown | ||
| + | deriving (Show, Eq, Enum, Bounded) | ||
| + | |||
| + | userExtraFull :: MyForm UserExtra | ||
| + | userExtraFull = UserExtra <$> userFull <*> checkbox (Just False) | ||
| + | <*> enumSelect [] (Just Blue) | ||
| + | <*> listSelect [] [1..10] (Just 7) <*> myFavourites | ||
| + | |||
| + | handleUserExtra = withForm "userextra" userExtraFull showErrorsInline (\u -> okHtml $ show u) | ||
| + | |||
| + | selectTest = select [] [(1, X.p << "One"), (2, X.p << "Two")] Nothing | ||
| + | |||
| + | listSelect attrs xs = select attrs (zip xs (map show xs)) | ||
| + | |||
| + | myFavourites :: MyForm [String] | ||
| + | myFavourites = MI.massInput input (\x -> X.p << x) id $ | ||
| + | Just ["Raindrops on roses" | ||
| + | , "Whiskers on kittens" | ||
| + | , "Bright copper kettles" | ||
| + | , "Warm woolen mittens"] | ||
| + | |||
| + | massInputJsFile = "massinput.js" | ||
| + | |||
| + | massInputJs = | ||
| + | dir massInputJsFile $ | ||
| + | liftIO $ | ||
| + | return $ toResponse $ MI.jsMassInputCode | ||
| + | |||
| + | </haskell> | ||
| + | |||
| + | You will then need to modify the 'htmlPage' and 'main' methods to serve the 'userextra' page and link to the javascript needed for massinput functionality: | ||
| + | |||
| + | <haskell> | ||
| + | htmlPage :: (X.HTML a) => a -> X.Html | ||
| + | htmlPage content = | ||
| + | (X.header << ((X.thetitle << "Testing forms") | ||
| + | +++ (X.script ! [X.thetype "text/javascript", X.src "http://ajax.googleapis.com/ajax/libs/jquery/1.3/jquery.min.js"] << "") | ||
| + | +++ (X.script ! [X.thetype "text/javascript", X.src massInputJsFile] << "") | ||
| + | )) | ||
| + | +++ (X.body << content) | ||
| + | |||
| + | main = simpleHTTP (nullConf {port = 5000}) (handleDate `mplus` handleUser `mplus` handleUserExtra `mplus` massInputJs) | ||
| + | |||
| + | </haskell> | ||
| + | |||
| + | Also add the following to the top of Main.hs: | ||
| + | <haskell> | ||
| + | {-# LANGUAGE TypeSynonymInstances, NoMonomorphismRestriction #-} | ||
| + | </haskell> | ||
| + | |||
| + | and add this to the list of inputs: | ||
| + | |||
| + | <haskell> | ||
| + | import Text.Formlets.MassInput as MI | ||
</haskell> | </haskell> | ||
| + | Then run Main.hs again and point your browser at http://localhost:5000/userextra | ||
== How it works == | == How it works == | ||
=== Advanced: rolling your own output type === | === Advanced: rolling your own output type === | ||
| + | |||
| + | == Other resources == | ||
| + | * [http://chrisdone.com/blog/html/2008-12-14-haskell-formlets-composable-web-form-construction-and-validation.html Chris Done gives many examples in this blog post] | ||
| + | * A [http://gitit.golubovsky.org/plugins/Formlet.hs plugin] for [http://gitit.net Gitit] implementing the [[#The_example_code|example]] (slightly modified) on a [http://gitit.golubovsky.org/Formlet Wiki page] | ||
== References == | == References == | ||
| Line 124: | Line 230: | ||
* [http://groups.inf.ed.ac.uk/links/formlets/ Papers on formlets] | * [http://groups.inf.ed.ac.uk/links/formlets/ Papers on formlets] | ||
* [http://en.wikibooks.org/wiki/Haskell/Applicative_Functors Applicative Functors wikibook] | * [http://en.wikibooks.org/wiki/Haskell/Applicative_Functors Applicative Functors wikibook] | ||
| + | |||
[[Category:Web]] | [[Category:Web]] | ||
| + | [[Category:Applicative Functor]] | ||
Current revision
Contents |
1 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!
2 The basics
2.1 Simple validation
2.2 Monadic validation
3 A working example
Below is a self-contained example that uses Formlets and Happstack-Server.
3.1 Prepare your system
First install Formlets and Happstack-Server on your system:
$ cabal install formlets happstack-server
3.2 The example code
Put the following in a file calledmodule Main where import Control.Applicative import Control.Applicative.Error import Control.Applicative.State import Data.List as List import Happstack.Server import Text.Formlets import Text.XHtml.Strict.Formlets import Text.XHtml.Strict ((+++),(<<),(!)) import qualified Text.XHtml.Strict as X 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 :: ServerPartT IO 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] -> ServerPartT IO Response) -> (a -> ServerPartT IO Response) -> ServerPartT IO Response withForm name frm handleErrors handleOk = dir name $ msum [ methodSP GET $ createForm [] frm >>= okHtml , withDataFn lookPairs $ \d -> methodSP 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 = List.map (\(k,v) -> (k, Left v)) d showErrorsInline :: X.Html -> [String] -> ServerPartT IO Response showErrorsInline renderedForm errors = okHtml $ X.toHtml (show errors) +++ renderedForm createForm :: Env -> MyForm a -> ServerPartT IO X.Html createForm env frm = do let (extractor, xml, endState) = runFormState env frm return $ X.form ! [X.method "POST"] << (xml +++ X.submit "submit" "Submit") okHtml :: (X.HTML a) => a -> ServerPartT IO 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 `mplus` handleUser)
3.3 Running the example
Start up the Happstack server with
$ runhaskell Main.hs
and point your web browser at http://localhost:5000/date/ and http://localhost:5000/user/.
3.4 Extending the example
Text.XHtml.Strict.Formlets provides form elements other than text input. To see some of them in action we can make some simple modifications to Main.hs.
Add the following lines to the end of Main.hs:
data UserExtra = UserExtra {userBase :: User , likesSpam :: Bool , eyeColour :: EyeColour , luckyNumber :: Integer , favouriteThings :: [String] } deriving Show data EyeColour = Blue | Green | Grey | Brown deriving (Show, Eq, Enum, Bounded) userExtraFull :: MyForm UserExtra userExtraFull = UserExtra <$> userFull <*> checkbox (Just False) <*> enumSelect [] (Just Blue) <*> listSelect [] [1..10] (Just 7) <*> myFavourites handleUserExtra = withForm "userextra" userExtraFull showErrorsInline (\u -> okHtml $ show u) selectTest = select [] [(1, X.p << "One"), (2, X.p << "Two")] Nothing listSelect attrs xs = select attrs (zip xs (map show xs)) myFavourites :: MyForm [String] myFavourites = MI.massInput input (\x -> X.p << x) id $ Just ["Raindrops on roses" , "Whiskers on kittens" , "Bright copper kettles" , "Warm woolen mittens"] massInputJsFile = "massinput.js" massInputJs = dir massInputJsFile $ liftIO $ return $ toResponse $ MI.jsMassInputCode
You will then need to modify the 'htmlPage' and 'main' methods to serve the 'userextra' page and link to the javascript needed for massinput functionality:
htmlPage :: (X.HTML a) => a -> X.Html htmlPage content = (X.header << ((X.thetitle << "Testing forms") +++ (X.script ! [X.thetype "text/javascript", X.src "http://ajax.googleapis.com/ajax/libs/jquery/1.3/jquery.min.js"] << "") +++ (X.script ! [X.thetype "text/javascript", X.src massInputJsFile] << "") )) +++ (X.body << content) main = simpleHTTP (nullConf {port = 5000}) (handleDate `mplus` handleUser `mplus` handleUserExtra `mplus` massInputJs)
Also add the following to the top of Main.hs:
{-# LANGUAGE TypeSynonymInstances, NoMonomorphismRestriction #-}and add this to the list of inputs:
import Text.Formlets.MassInput as MI
Then run Main.hs again and point your browser at http://localhost:5000/userextra
4 How it works
4.1 Advanced: rolling your own output type
5 Other resources
- Chris Done gives many examples in this blog post
- A plugin for Gitit implementing the example (slightly modified) on a Wiki page
