Stuff

Links

Digestive functors 0.0.2

Update

This code no longer works with the current version of the digestive functors library. Up-to-date examples can be found here in the github repo. The updated version of this blogpost is available here.

Intro

Today, I’m releasing something I’ve been working on a while. I planned to complete it on BelHac, but it all got delayed a little.

When I was writing the blaze-html backend for formlets a while ago, I found formlets one of the most interesting libraries I had ever worked with. However, there were a few things that annoyed me:

• it was very hard to generate semantic HTML <label>s;
• there was no good way to print error messages next to the fields that caused the errors;
• it fixed too many types, such as, for example, the type for file uploads. If I wanted to use iteratees for file uploads, this would be quite a challenge to implement.

With the blessing of Chris, I decided to create a new version from scratch.

Digestive functors 0.0.2

This file is written in literate Haskell. You can find the source code right here. If you install digestive-functors-blaze and digestive-functors-snap from Hackage, you should be good to go: run this file with runghc and you should have a small webapp running at localhost:8000.

We import Text.Digestive to get the general API provided by digestive functors:

{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
import Control.Applicative ((<$>), (<*>))
import Text.Digestive

The digestive functors library is structured into three layers:

For the actual web server responsible for I/O, we use Snap. A Happstack backend is available, too.

import Text.Digestive.Forms.Snap
import Snap.Types
import Snap.Http.Server (httpServe)

We use blaze as frontend. This is the only supported frontend for now, but we are going to work on other frontends such as HSP.

import Text.Digestive.Blaze.Html5
import Text.Blaze (Html, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Renderer.Utf8 (renderHtml)

To illustrate use of the library, we will build a small webapp to calculate a weighted sum. We have a simple datatype describing the input for our mind-blowing calculations:

data WeightedSum = WeightedSum [Double] [Double]

Of course, we also require a function for calculating the result:

weightedSum :: WeightedSum -> Double
weightedSum (WeightedSum weights values) = sum $ zipWith (*) weights values

To obtain the sum, we will need two lists, entered by the user. We will rely on the property that list is an instance of Read.

listForm :: (Read a, Show a) => [a] -> SnapForm Html BlazeFormHtml [a]
listForm def = inputTextRead "Can't read list" (Just def) <++ errors

Let us examine this a little more closely.

listForm def =
~~~~~{.haskell}

We create a new Haskell function which returns a list. `def` is the default
value that the user will see when he accesses the web page.

~~~~~{.haskell}
inputTextRead "Can't read list" (Just def)

The above specifies a textbox for values instantiating Read. We give an error message in case the user enters something invalid – this error message will be thrown when the value cannot be read. We also pass our default value.

<++ errors

<++ is an operator used to append certain “special” forms on the right side (of course, ++> also exists). Here, we append errors – this will basically generate a list of errors for the corresponding field. Now we can look at the type of the form:

SnapForm Html BlazeFormHtml [a]

This simply is a form using the Snap backend, using the Html type for the errors (we use Html rather than String because we might want to have some extra formatting in the errors). BlazeFormHtml is the “view” we produce, and our form will return an [a].

One of the main reasons for using applicative functors to create forms is composability. We compose two listForms into a form we can use for our WeightedSum type. We compose using the standard <$> and <*> applicative interface.

weightedSumForm :: SnapForm Html BlazeFormHtml WeightedSum
weightedSumForm = (`validate` equalSize) $ (<++ errors) $ WeightedSum
    <$> label "Weights: " ++> listForm [0.4, 0.4, 0.2]
    <*> label "Values: "  ++> listForm [64, 67, 91]

We use the label function here to create a semantic HTML <label> (when the user clicks the label, the corresponding input field will be selected). We validate our form using the equalSize validator (explained a bit further down).

We also append errors to our WeightedSum form. The digestive functors library has two main functions for selecting errors:

• errors lists only the errors corresponding to this exact form;
• childErrors lists all errors belonging to form, as well as all errors belonging to one of the children forms. In this case, using childErrors would mean that we would see “Can’t read list” errors appearing twice (once for the listForm, and once for this form) – but it can be quite useful in certain scenario’s.

To calculate a weighted sum, the lists must be of the same size – this is why we have the equalSize validator. Writing validators is not very hard; this one is particulary easy because it is a pure validator.

equalSize :: Validator Snap Html WeightedSum
equalSize = check "Lists must be of equal size" $ \(WeightedSum l1 l2) ->
    length l1 == length l2

With the check function, you simply provide an error message and a predicate, and you are done.

Next, we need to get the webapp running on Snap. For this, the first thing we require is a simple utility function to render our blaze templates:

blaze :: Html -> Snap ()
blaze response = do
    modifyResponse $ addHeader "Content-Type" "text/html; charset=UTF-8"
    writeLBS $ renderHtml response

Second, we write a Snap handler to serve this form, as follows.

weightedSumHandler :: Snap ()
weightedSumHandler = do

The real digestive magic is provided by the eitherSnapForm function. It evaluates the form on a POST request, and views the form on a GET requiest.

    r <- eitherSnapForm weightedSumForm "weighted-sum-form"
    case r of

Should we get a form back, either something went wrong, or the user only wishes to view the form. In both cases, we simply render the form using blaze.

        Left form' -> blaze $ do
            let (formHtml', enctype) = renderFormHtml form'
            H.style ! A.type_ "text/css" $ do
                  "input {display: block;}\n"
                  ".digestive-error-list {\n"
                  "    color: white;\n"
                  "    background-color: rgb(100, 0, 0);\n"
                  "}"
            H.h1 "Evaluate a weighted sum"
            H.form ! A.enctype (H.stringValue $ show enctype)
                   ! A.method "POST" ! A.action "/" $ do
                formHtml'
                H.input ! A.type_ "submit" ! A.value "Submit"

Note how we also receive the encoding type (enctype) from the renderFormHtml function. We use .digestive-error-list to style it up a little. Obviously, these classes are completely customizable.

If we received an actual WeightedSum, it means that the user filled in everything correctly, i.e., the input validated. We can now evaluate and print this result.

        Right weightedSum' -> blaze $ do
            H.h1 "HUGE SUCCES"
            H.p $ do
                H.strong "Result: "
                H.string $ show $ weightedSum weightedSum'

Finally, all we need to complete this example is a main function to server the handler, and we are set!

main :: IO ()
main = httpServe "*" 8000 "weighted-sum" Nothing Nothing weightedSumHandler

That’s it

I hope this blogpost clarified what the digestive functors library is and how you use it. If you’re interested, feel free to check out digestive-functors on GitHub. As always, feedback is welcome. Kudos to Itkovian for proofreading this post!