Difference between revisions of "Web/Libraries/Formlets"

From HaskellWiki
< Web‎ | Libraries
Jump to: navigation, search
(Added reference to Chris Done)
(Updated to use happstack-0.2.1; may not be fully idiomatic)
Line 47: Line 47:
 
[http://hackage.haskell.org/cgi-bin/hackage-scripts/package/formlets Formlets]
  
[http://hackage.haskell.org/cgi-bin/hackage-scripts/package/formlets Formlets]
 
and
  
and
−
[http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HAppS-Server HAppS-Server].
 +
[http://hackage.haskell.org/package/happstack-server Happstack-Server].
   
 
=== Prepare your system ===
  
=== Prepare your system ===
−
First install Formlets and HAppS-Server on your system:
 +
First install Formlets and Happstack-Server on your system:
   
 
<pre>
  
<pre>
−
$ cabal install formlets happs-server
 +
$ cabal install formlets happstack-server
 
</pre>
  
</pre>
   
Line 62: Line 62:
 
module Main where
  
module Main where
   
−
import HAppS.Server
  
  +
import Control.Applicative
−
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 qualified Data.Map as M
 +
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 = dateComponent `check` ensure validDate "This is not a valid date"
 +
dateFull = dateComponent `check` ensure validDate "This is not a valid date"
   
−
handleDate :: [ServerPart Response]
 +
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 94: Line 94:
 
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] -> Web Response) -> (a -> Web Response) -> [ServerPart Response]
  
  +
withForm
−
withForm name frm handleErrors handleOk =
  
  +
:: String
−
[dir name
+
-> MyForm a
−
[ method GET $ createForm [] frm >>= okHtml
 +
-> (X.Html -> [String] -> ServerPartT IO Response)
−
, withDataFn lookPairs $ \d -> [method POST $ handleOk' $ simple d]
 +
-> (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
  
  +
where
⚫
v <- liftIO extractor
  
  +
handleOk' d = do
⚫
case v of
  
  ⚫
let (extractor, html, _) = runFormState d "" frm
⚫
Failure faults -> do f <- createForm d frm
  
  ⚫
v <- liftIO extractor
−
handleErrors f faults
  
  ⚫
case v of
−
Success s -> handleOk s
  
  ⚫
Failure faults -> do
−
simple d = map (\(k,v) -> (k, Left v)) d
 +
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] -> Web Response
 +
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 -> Web X.Html
 +
createForm :: Env -> MyForm a -> ServerPartT IO X.Html
 
createForm env frm = do
  
createForm env frm = do
 
let (extractor, xml, endState) = runFormState env "" frm
  
let (extractor, xml, endState) = runFormState env "" frm
Line 119: Line 119:
 
return $ X.form ! [X.method "POST"] << (xml' +++ X.submit "submit" "Submit")
  
return $ X.form ! [X.method "POST"] << (xml' +++ X.submit "submit" "Submit")
   
−
okHtml :: (X.HTML a) => a -> Web Response
 +
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 << (X.thetitle << "Testing forms")) +++ (X.body << content)
 +
htmlPage content = (X.header << (X.thetitle << "Testing forms"))
  +
+++ (X.body << content)
  +
  +
main = simpleHTTP (nullConf {port = 5000}) (handleDate `mplus` handleUser)
  +
   
−
main = simpleHTTP (nullConf {port = 5000}) (handleDate ++ handleUser)
  
 
</haskell>
  
</haskell>
   
 
=== Running the example ===
  
=== Running the example ===
−
Start up the HAppS server with
 +
Start up the Happstack server with
 
<pre>
  
<pre>
 
$ runhaskell Main.hs
  
$ runhaskell Main.hs

Revision as of 02:48, 10 August 2009

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
  xml' <- liftIO xml
  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/.

How it works

Advanced: rolling your own output type

Other resources

References

Retrieved from "https://wiki.haskell.org/index.php?title=Web/Libraries/Formlets&oldid=29475"