Web/Libraries/Formlets
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
Below is a self-contained example that uses formlets and happstack-server.
Prepare your system
First install Formlets and Happstack-Server on your system:
$ cabal install formlets happstack-server
The example code
Put the following in a file called Main.hs
:
module 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)
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/.
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
How it works
Advanced: rolling your own output type
Other resources
- Chris Done gives many examples in this blog post
- A plugin for Gitit implementing the example (slightly modified) on a Wiki page
References
- formlets library on hackage
- Papers on formlets
- Applicative Functors wikibook