Formlets in Haskell

One of the most low-level parts of web development is building forms. You need to code to both build forms and handle them, and manually sync that code to make sure the names match up. In this post, we will use formlets and HAppS-Server to solve those problems. Formlets are a way to compose parts of a form into a complete form, without having to worry about names, types and validations.

 module Main where
 import HAppS.Server
 import Control.Applicative
 import Control.Applicative.Error
 import Control.Applicative.State
 import Text.Formlets
 import Text.XHtml.Strict ((+++), (<<), (!))
 import qualified Text.XHtml.Strict as X
 import qualified Data.Map as M

First of all, we are going to build a form that accepts a date (consisting of two parts: a month and a day). Our datatype reflects this:

 data Date = Date {month :: Integer, day :: Integer} deriving Show

We want to prevent the user from entering weird dates, so

 validDate :: Date -> Bool
 validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31]

Now we are going to write a FailingForm that reads two integers, and uses them to create a real Date. Using applicative style, we can nicely express this:

 dateComponent :: FailingForm Date
 dateComponent = Date <$> inputIntegerF (Just 1) <*> inputIntegerF (Just 16)

We can now combine dateComponent and validDate to create a validating Date component:

 dateFull :: FailingForm Date
 dateFull   = dateComponent `check` ensure validDate "This is not a valid date"

Finally, if we use some helper functions we can create a ServerPart, which is everything HAppS needs in order to run:

 handleDate :: [ServerPart Response]
 handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d)

This will show a form, and if you press “Submit”, it will make sure all validations pass, and show you the value. If the form doesn’t get validated, it will show a list of errors, and you can change your previously entered values.

To demonstrate the compositionality of formlets, we will create a User datatype, and use the date-formlet to let the user enter a birthDate:

 data User = User {name :: String, password :: String, birthdate :: Date} deriving Show
 
 userFull :: FailingForm User
 userFull = User <$> inputF Nothing <*> passwordF Nothing <*> dateFull

And that’s all there is to it! We now have user form that asks for a name, a password and a birthdate. We can use the withForm function again to handle the GET and POST:

 handleUser = withForm "user" userFull showErrorsInline (\u -> okHtml $ show u)

Finally, here are all the helper functions we used:

 withForm :: String -> FailingForm a -> (X.Html -> [String] -> Web Response) -> (a -> Web Response) -> [ServerPart Response]
 withForm name frm handleErrors handleOk = 
   [dir name 
      [ method GET           $ okHtml $ createForm [] frm
      , withDataFn lookPairs $ \d -> [method POST $ handleOk' d]
      ]
   ]
   where ((extractor, html), endState) = runFormState [] frm 0
         handleOk' d = case extractor d of
                         Failure faults -> handleErrors (createForm d frm) faults
                         Success s      -> handleOk s
 
 showErrorsInline :: X.Html -> [String] -> Web Response
 showErrorsInline renderedForm errors =
   okHtml $ X.toHtml (show errors) +++ renderedForm
 
 createForm :: Env -> FailingForm a -> X.Html
 createForm env frm =
   X.form ! [X.method "POST"] << (xml +++ X.submit "submit" "Submit")
    where ((extractor, xml), endState) = runFormState env frm 0
 
 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)

For the full code, see Main.lhs. Make sure you have installed HAppS-Server and formlets from hackage. Enjoy!

Update: There is now a wiki page on Formlets which we try to keep up to date with examples that compile with the latest version. The example above only works with an old version of formlets.


About this entry