Skip to content
This repository
branch: master
Martin Rehfeld
file 245 lines (192 sloc) 8.004 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244
> {-# 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 A

> import Text.Digestive
> import Text.Digestive.Blaze.Html5
> import Text.Digestive.Happstack
> import Text.Digestive.Util

Simple forms and validation
---------------------------

Let'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 m v a` type
has three parameters:

- `v`: the type for messages and errors (usually a `String`-like type, `Text` in
  this case);
- `m`: the monad we are operating in, not specified here;
- `a`: the return type of the `Form`, in this case, this is obviously `User`.

> userForm :: Monad m => Form Text m User

We 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 (== '@')

More validation
---------------

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]]

Composing forms
---------------

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" .: packageForm

Views
-----

As 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.

[blaze-html]: http://jaspervdj.be/blaze/

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.br

Like 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.br

The 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 :: Monad m => (v -> w) -> View v -> View w

A backend
---------

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.

[Happstack]: http://happstack.com/

> 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 site

Utilities
---------

> template :: H.Html -> H.Html
> template body = H.docTypeHtml $ do
> H.head $ do
> H.title "digestive-functors tutorial"
> css
> H.body body

> css :: 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;"
> "}"
Something went wrong with that request. Please try again.