Difference between revisions of "Web/Libraries/Formlets"

From HaskellWiki
< Web‎ | Libraries
Jump to navigation Jump to search
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)

How it works

Advanced: rolling your own output type

References