Personal tools

Web/Libraries/Formlets

From HaskellWiki

< Web | Libraries(Difference between revisions)
Jump to: navigation, search
(added more detailed instructions)
(use HackagePackage template)
 
(10 intermediate revisions by 9 users not shown)
Line 45: Line 45:
 
== A working example ==
 
== A working example ==
 
Below is a self-contained example that uses
 
Below is a self-contained example that uses
[http://hackage.haskell.org/cgi-bin/hackage-scripts/package/formlets Formlets]
+
{{HackagePackage|id=formlets}}
 
and
 
and
[http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HAppS-Server HAppS-Server].
+
{{HackagePackage|id=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
xml' <- liftIO xml
+
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
Line 134: Line 133:
 
and point your web browser at http://localhost:5000/date/
 
and point your web browser at http://localhost:5000/date/
 
and http://localhost:5000/user/.
 
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:
  +
<haskell>
  +
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
  +
  +
</haskell>
  +
  +
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:
  +
  +
<haskell>
  +
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)
  +
  +
</haskell>
  +
  +
Also add the following to the top of Main.hs:
  +
<haskell>
  +
{-# LANGUAGE TypeSynonymInstances, NoMonomorphismRestriction #-}
  +
</haskell>
  +
  +
and add this to the list of inputs:
  +
  +
<haskell>
  +
import Text.Formlets.MassInput as MI
  +
</haskell>
  +
Then run Main.hs again and point your browser at http://localhost:5000/userextra
   
 
== How it works ==
 
== How it works ==
   
 
=== Advanced: rolling your own output type ===
 
=== Advanced: rolling your own output type ===
  +
  +
== Other resources ==
  +
* [http://chrisdone.com/blog/html/2008-12-14-haskell-formlets-composable-web-form-construction-and-validation.html Chris Done gives many examples in this blog post]
  +
* A [http://gitit.golubovsky.org/plugins/Formlet.hs plugin] for [http://gitit.net Gitit] implementing the [[#The_example_code|example]] (slightly modified) on a [http://gitit.golubovsky.org/Formlet Wiki page]
   
 
== References ==
 
== References ==
   
* [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/formlets Formlets library on hackage]
+
* {{HackagePackage|id=formlets}} library on hackage
 
* [http://groups.inf.ed.ac.uk/links/formlets/ Papers on formlets]
 
* [http://groups.inf.ed.ac.uk/links/formlets/ Papers on formlets]
 
* [http://en.wikibooks.org/wiki/Haskell/Applicative_Functors Applicative Functors wikibook]
 
* [http://en.wikibooks.org/wiki/Haskell/Applicative_Functors Applicative Functors wikibook]
  +
   
 
[[Category:Web]]
 
[[Category:Web]]
  +
[[Category:Applicative Functor]]

Latest revision as of 06:56, 16 September 2013

Contents

[edit] 1 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!

[edit] 2 The basics

[edit] 2.1 Simple validation

[edit] 2.2 Monadic validation

[edit] 3 A working example

Below is a self-contained example that uses formlets and happstack-server.

[edit] 3.1 Prepare your system

First install Formlets and Happstack-Server on your system:

$ cabal install formlets happstack-server

[edit] 3.2 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)

[edit] 3.3 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/.

[edit] 3.4 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

[edit] 4 How it works

[edit] 4.1 Advanced: rolling your own output type

[edit] 5 Other resources

[edit] 6 References