Digestive functors 0.0.2



Published on December 9, 2010 under the tag An upgrade of formletsPublished on December 9, 2010 under the tag haskell

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;

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:

The layered design

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) (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) (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 weights values) = sum $ zipWith ( * ) weights values weightedSum (weights values)) 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] a,a)[a][a] = inputTextRead "Can't read list" ( Just def) <++ errors listForm definputTextReaddef)errors

Let us examine this a little more closely.

= listForm def ~~~~~ { . haskell} haskell} We create a new Haskell function which returns a list . `def` is the default create a newfunction which returns a listis the default . value that the user will see when he accesses the web page ~~~~~ { . haskell} haskell} "Can't read list" ( Just def) inputTextReaddef)

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 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] [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 listForm s into a form we can use for our WeightedSum type. We compose using the standard <$> and <*> applicative interface.

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

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;

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 = check "Lists must be of equal size" $ \( WeightedSum l1 l2) -> equalSizecheck\(l1 l2) length l1 == length l2 l1l2

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 () () = do blaze response $ addHeader "Content-Type" "text/html; charset=UTF-8" modifyResponseaddHeader $ renderHtml response writeLBSrenderHtml response

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

weightedSumHandler :: Snap () () = do weightedSumHandler

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" eitherSnapForm weightedSumForm 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 form'blaze let (formHtml', enctype) = renderFormHtml form' (formHtml', enctype)renderFormHtml form' ! A.type_ "text/css" $ do H.styleA.type_ "input {display: block;}

" ".digestive-error-list {

" " color: white;

" " background-color: rgb(100, 0, 0);

" "}" "Evaluate a weighted sum" H.h1 ! A.enctype (H.stringValue $ show enctype) H.formA.enctype (H.stringValueenctype) ! A.method "POST" ! A.action "/" $ do A.methodA.action formHtml' ! A.type_ "submit" ! A.value "Submit" H.inputA.type_A.value

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 weightedSum'blaze "HUGE SUCCES" H.h1 $ do H.p "Result: " H.strong $ show $ weightedSum weightedSum' H.stringweightedSum weightedSum'

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

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

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!