{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
import Control.Applicative ((<$>), (<*>))
import Data.Maybe (isJust)import Data.Text (Text)
import Text.Blaze ((!))
import qualified Data.Text as T
import qualified Happstack.Server as Happstack
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as Aimport Text.Digestive
import Text.Digestive.Blaze.Html5
import Text.Digestive.Happstack
import Text.Digestive.UtilLet's start by creating a very simple datatype to represent a user:
data User = User
{ userName :: Text
, userMail :: Text
} deriving (Show)And dive in immediately to create a Form for a user. The Form v m a
type has three parameters:
v: the type for messages and errors (usually aString-like type,Textin this case);m: the monad we are operating in, not specified here;a: the return type of theForm, in this case, this is obviouslyUser.
userForm :: Monad m => Form Text m UserWe create forms by using the Applicative interface. A few form types
are provided in the Text.Digestive.Form module, such as text,
string, bool...
In the digestive-functors library, the developer is required to label
each field using the .: operator. This might look like a bit of a
burden, but it allows you to do some really useful stuff, like
separating the Form from the actual HTML layout.
userForm = User
<$> "name" .: text Nothing
<*> "mail" .: check "Not a valid email address" checkEmail (text Nothing)The check function enables you to validate the result of a form. For
example, we can validate the email address with a really naive
checkEmail function.
checkEmail :: Text -> Bool
checkEmail = isJust . T.find (== '@')For our example, we also want descriptions of Haskell libraries, and in order to do that, we need package versions...
type Version = [Int]We want to let the user input a version number such as 0.1.0.0. This
means we need to validate if the input Text is of this form, and then
we need to parse it to a Version type. Fortunately, we can do this in
a single function: validate allows conversion between values, which
can optionally fail.
readMaybe :: Read a => String -> Maybe a is a utility function
imported from Text.Digestive.Util.
validateVersion :: Text -> Result Text Version
validateVersion = maybe (Error "Cannot parse version") Success .
mapM (readMaybe . T.unpack) . T.split (== '.')A quick test in GHCi:
ghci> validateVersion (T.pack "0.3.2.1")
Success [0,3,2,1]
ghci> validateVersion (T.pack "0.oops")
Error "Cannot parse version"
It works! This means we can now easily add a Package type and a Form
for it:
data Category = Web | Text | Math
deriving (Bounded, Enum, Eq, Show)data Package = Package Text Version Category
deriving (Show)packageForm :: Monad m => Form Text m Package
packageForm = Package
<$> "name" .: text Nothing
<*> "version" .: validate validateVersion (text (Just "0.0.0.1"))
<*> "category" .: choice categories Nothing
where
categories = [(x, T.pack (show x)) | x <- [minBound .. maxBound]]A release has an author and a package. Let's use this to illustrate the composability of the digestive-functors library: we can reuse the forms we have written earlier on.
data Release = Release User Package
deriving (Show)releaseForm :: Monad m => Form Text m Release
releaseForm = Release
<$> "author" .: userForm
<*> "package" .: packageFormAs mentioned before, one of the advantages of using digestive-functors
is separation of forms and their actual HTML layout. In order to do
this, we have another type, View.
We can get a View from a Form by supplying input. A View contains
more information than a Form, it has:
- the original form;
- the input given by the user;
- any errors that have occurred.
It is this view that we convert to HTML. For this tutorial, we use the
blaze-html library, and some helpers from
the digestive-functors-blaze library.
Let's write a view for the User form. As you can see, we here refer to
the different fields in the userForm. The errorList will generate a
list of errors for the "mail" field.
userView :: View H.Html -> H.Html
userView view = do
label "name" view "Name: "
inputText "name" view
H.br
errorList "mail" view
label "mail" view "Email address: "
inputText "mail" view
H.brLike forms, views are also composable: let's illustrate that by adding a
view for the releaseForm, in which we reuse userView. In order to do
this, we take only the parts relevant to the author from the view by
using subView. We can then pass the resulting view to our own
userView.
We have no special view code for Package, so we can just add that to
releaseView as well. childErrorList will generate a list of errors
for each child of the specified form. In this case, this means a list of
errors from "package.name" and "package.version". Note how we use
foo.bar to refer to nested forms.
releaseView :: View H.Html -> H.Html
releaseView view = do
H.h2 "Author"
userView $ subView "author" view
H.h2 "Package"
childErrorList "package" view
label "package.name" view "Name: "
inputText "package.name" view
H.br
label "package.version" view "Version: "
inputText "package.version" view
H.br
label "package.category" view "Category: "
inputSelect "package.category" view
H.brThe attentive reader might have wondered what the type parameter for
View is: it is the String-like type used for e.g. error messages.
But wait! We have
releaseForm :: Monad m => Form Text m Release
releaseView :: View H.Html -> H.Html
... doesn't this mean that we need a View Text rather than a
View Html? The answer is yes -- but having View Html allows us to
write these views more easily with the digestive-functors-blaze
library. Fortunately, we will be able to fix this using the Functor
instance of View.
fmap :: (v -> w) -> View v -> View w
To finish this tutorial, we need to be able to actually run this code.
We need an HTTP server for that, and we use
Happstack for this tutorial. The
digestive-functors-happstack library gives about everything we need
for this.
site :: Happstack.ServerPart Happstack.Response
site = do
Happstack.decodeBody $ Happstack.defaultBodyPolicy "/tmp" 4096 4096 4096
r <- runForm "test" releaseForm
case r of
(view, Nothing) -> do
let view' = fmap H.toHtml view
Happstack.ok $ Happstack.toResponse $
template $
form view' "/" $ do
releaseView view'
H.br
inputSubmit "Submit"
(_, Just release) -> Happstack.ok $ Happstack.toResponse $
template $ do
css
H.h1 "Release received"
H.p $ H.toHtml $ show release
main :: IO ()
main = Happstack.simpleHTTP Happstack.nullConf sitetemplate :: H.Html -> H.Html
template body = H.docTypeHtml $ do
H.head $ do
H.title "digestive-functors tutorial"
css
H.body bodycss :: H.Html
css = H.style ! A.type_ "text/css" $ do
"label {width: 130px; float: left; clear: both}"
"ul.digestive-functors-error-list {"
" color: red;"
" list-style-type: none;"
" padding-left: 0px;"
"}"
Thank you for this!