From HaskellWiki
< Web‎ | Libraries
Revision as of 16:43, 22 September 2008 by Huschi (talk | contribs)
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.


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 at the moment of this writing):

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)

How it works

Advanced: rolling your own output type