So, last thursday I escaped Belgium for a bit and travelled to Odessa to attend OdHac, a Haskell Hackathon organised there by Roman and hosted by Provectus IT.

Odessa is a really sweet city. One thing I noticed is that while some of the buildings seem to be in a deplorable condition from the outside, they actually turn out to be very nice once you’re indoors! This was for example the case for the hostel I was staying in. The contrast is also seen elsewhere in the city, with brand new appartements next to ramshackle, desolated houses.

Picture by Simon Meier

This is, however, not the case for the very centre of the city – around the famous Potemkin Stairs. This neighbourhood is absolutely amazing.

Picture by some random Ukranian guy

Hakyll at OdHac

At the Hackathon, I did a small presentation about Hakyll on friday, and some awesome people decided to help me improve Hakyll a bit this weekend. We were able to implement some exciting features.

Working on Hakyll, picture by Roman Cheplyaka

If-else conditionals in templates

We added some functionality to the Hakyll templates which you allows you to check if a certain value is defined. We chose to use the same syntax as Pandoc, to further ease integration:

<h1>$title$</h1>
$if(author)$
    <em>by $author$</em>
$endif$

We also support if-else-endif. On the plane back, I also took the time to implement $foreach$ and $partial$.

Teasers

Teasers allow you to write a short introduction for a blogpost, and make it easy to reproduce this introduction on another page together with a “Read more” link. We decided to implement the convention used in Wordpress, which means you define your teasers using the following simple format:

---
title: Some post
---

This is the introduction.

<!--more-->

The rest of the post...

Pagination

We also started to work on a generic Pagination module. It’s not finished yet but it should be possible to clean this up and package it by the end of the week. I’m quite excited about this feature because lots of people have requested it in the past.

Additionally, we did some performance improvements and fixed a bug or two. All in all, a very productive and fun Hackathon! I hope to package up all these changes and push them to Hackage soon.

Thanks for contributing to Hakyll, Alexey Smirnov, Anton Dubovik, Dmitriy Shamatrin, Ivan Veselov and Pavel Poukh! And, of course, thanks for organizing, Roman!

Main changes

• The important Compiler type has been changed from Arrow to Monad: this makes it much easier to write custom compilers, as most Haskellers are more familiar with monads.

• The template stays superficially the same, but it has grown much more powerful and flexible underneath.

• Early and fast access to metadata makes things such as tags and pagination much easier.

• All items (images, css…) can now have metadata associated. Metadata can no longer be manipulated, and this immutability should reduce the number of encountered bugs.

• A check command has been added. This allows you to check that all internal (or external) links are still alive.

Installation, migration

In order to install Hakyll 4, grab it from Hackage:

cabal update
cabal install hakyll

Here are some useful links:

• Website: http://jaspervdj.be/hakyll/
• Tutorial index: http://jaspervdj.be/hakyll/tutorials.html
• Migration guide: http://jaspervdj.be/hakyll/tutorials/hakyll-3-to-hakyll4-migration-guide.html

All feedback is welcome as always.

The context of this problem is related to optimization problems: given some value, we want to produce a bunch of related values.

An example of where such an operation can be found is shrink :: Arbitrary a => a -> [a], found in the QuickCheck library.

Alex and I encountered an fun problem while working on something similar at Tsuru. This blogpost is not really aimed at people who have just begun reading about Haskell as it contains little text and requires some intuition about sums and products (in the more general sense).

> {-# LANGUAGE FlexibleInstances #-}
> import Control.Applicative
> import Data.Traversable

We can capture our idea of related values in a typeclass:

> class Wiggle a where
>     wiggle :: a -> [a]

And define a simple instance for Int or Double:

> instance Wiggle Int where
>     wiggle x = [x - 1, x, x + 1]

> instance Wiggle Double where
>     wiggle x = let eps = 0.03 in [x - eps, x, x + eps]

The interesting notion is to define instances for more general (combined) types. Given a tuple, we can wiggle it in two ways: either wiggle one of its components, or wiggle them both. Let’s express both notions using two simple newtypes ¹:

> newtype Product a = Product {unProduct :: a}
>     deriving (Show)

> instance (Wiggle a, Wiggle b) => Wiggle (Product (a, b)) where
>     wiggle (Product (x, y)) =
>         [Product (x', y') | x' <- wiggle x, y' <- wiggle y]

> newtype Sum a = Sum {unSum :: a}
>     deriving (Show)

> instance (Wiggle a, Wiggle b) => Wiggle (Sum (a, b)) where
>     wiggle (Sum (x, y)) =
>         [Sum (x', y) | x' <- wiggle x] ++
>         [Sum (x, y') | y' <- wiggle y]

The same applies to structures such as lists. We can wiggle all elements of a list, or just a single one (if the list is non-empty). Both instances are reasonably straightforward to write.

The interesting question is if and how we can do it for a more general family of structures than lists? Foldable? Traversable?

A Wiggle instance for traversable products is not that hard:

> instance (Traversable t, Wiggle a) => Wiggle (Product (t a)) where
>     wiggle (Product xs) = map Product $ traverse wiggle xs

But how about the instance:

> instance (Traversable t, Wiggle a) => Wiggle (Sum (t a)) where
>     wiggle = wiggleSum

The solution

Is it possible? Can you come up with a nicer solution than we have?

> wiggleSum :: (Traversable t, Wiggle a) => Sum (t a) -> [Sum (t a)]
> wiggleSum = map Sum . concatMap sequenceA . rightOnce .
>         traverse (\x -> Parent (Leaf [x]) (Leaf (wiggle x))) . unSum

> data Tree a
>     = Leaf a
>     | Parent (Tree a) (Tree a)
>     deriving (Show)

> instance Functor Tree where
>     fmap f (Leaf x)     = Leaf (f x)
>     fmap f (Parent x y) = Parent (fmap f x) (fmap f y)

> instance Applicative Tree where
>     pure = Leaf
>     Parent f g <*> x          = Parent (f <*> x) (g <*> x)
>     Leaf f     <*> Leaf x     = Leaf (f x)
>     Leaf f     <*> Parent x y = Parent (f <$> x) (f <$> y)

> leftMost :: Tree a -> a
> leftMost (Leaf x)     = x
> leftMost (Parent x _) = leftMost x

> rightOnce :: Tree a -> [a]
> rightOnce (Leaf _)     = []
> rightOnce (Parent x y) = leftMost y : rightOnce x

If you are only interested in the neat Haskell trick, skip this section. It has been a while since I updated my personal blog here. There has been a lot going on in my life in the past few months, including exams, a breakup with my girlfriend and moving to Tokyo for an internship at Tsuru Capital.

It has been really great so far, the work is interesting, so are the people, and we have a nice view from the office.

View from the Tsuru Capital office

Prologue

This blogpost is written in literate Haskell (source here), so you can drop it in a file, load it in GHCi and play around with it, should you feel like doing this.

> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE OverloadedStrings #-}
> {-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE TypeSynonymInstances #-}
> import Control.Applicative
> import Control.Monad
> import Data.Aeson

A lot of serialization libraries use a technique employing two typeclasses (or one typeclass with two methods) in order to convert data from and to some format. An example is the excellent aeson library:

> data Food = Food
>     { foodName :: String
>     , foodCost :: Int
>     } deriving (Show)

> instance ToJSON Food where
>     toJSON (Food name cost) = object
>         [ "name" .= name
>         , "cost" .= cost
>         ]

> instance FromJSON Food where
>     parseJSON (Object obj) = Food
>         <$> obj .: "name"
>         <*> obj .: "cost"
>     parseJSON _ = mzero

Some other libraries using this technique are cassava, postgresql-simple, and binary.

While working on some new internal SQLite bindings and utilities at Tsuru, I discovered another technique which is more concise, but keeps the nice Applicative interface. The code in this blogpost disregards performance and only supports the most basic of features in order to be easier to understand.

Primitive types

We start out by defining a typeclass for primitive serializable types, such as Int and String. We disregard performance, as said before, and we are also going to ignore proper error checking: we just serialize these primitive types to Strings.

> class Field a where
>     fieldType :: a -> String  -- Should work with 'undefined'
>     fieldRead :: String -> a
>     fieldShow :: a -> String

> instance Field String where
>     fieldType = const "TEXT"
>     fieldRead = id  -- We need proper escaping here
>     fieldShow = id

> instance Field Int where
>     fieldType = const "INTEGER"
>     fieldRead = read
>     fieldShow = show

These fields are sufficient to store some Food, so what else do we need? We need “instantiations” of these fields which actually represent a part of a record. This can be modeled as:

> data FieldInfo t a = FieldInfo
>     { fieldName    :: String
>     , fieldExtract :: t -> a
>     }

Let’s give an example, we would map the cost of food as:

> costFieldInfo :: FieldInfo Food Int
> costFieldInfo = FieldInfo "cost" foodCost

This costFieldInfo is not used in the code below, it is just an example.

GADTs

In the case of an SQLite database, such a FieldInfo actually represent a column in our table. We will be building our table using Applicative, without actually evaluating anything yet. This seems related to free monads – determining the exact category-theoretical relation is left as an excercise for the mathematical-minded reader.

We just have constructors for each method of the applicative interface, plus an SQLite primitive to add a column to our table.

This requires the great GADTs extension, it is not possible to do this with Haskell 98 datatypes – the wiki page has more information.

> data Table t f where
>     -- Applicative interface:
>     -- <$>, pure and <*>
>     Map  :: (a -> b) -> Table t a -> Table t b
>     Pure :: a -> Table t a
>     App  :: Table t (a -> b) -> Table t a -> Table t b
> 
>     -- Primitives
>     Column :: Field a => FieldInfo t a -> Table t a

This makes the Functor and Applicative instances trivial to implement.

> instance Functor (Table t) where
>     fmap = Map

> instance Applicative (Table t) where
>     pure  = Pure
>     (<*>) = App

This GADT allows us to model actual tables:

> foodTable :: Table Food Food
> foodTable = Food
>     <$> Column (FieldInfo "name" foodName)
>     <*> Column (FieldInfo "cost" foodCost)

Let’s make some nicer syntax and write foodTable again:

> column :: Field a => String -> (t -> a) -> Table t a
> column name extract = Column (FieldInfo name extract)

> foodTable' :: Table Food Food
> foodTable' = Food
>     <$> column "name" foodName
>     <*> column "cost" foodCost

Lookin’ good!

The real work

While procrastrinating by creating GADT wrappers is fun, at one point we should write some actual implementation.

These implementations work by evaluating the trees we created with the different constructors for the GADT.

Our first method crawls the table tree and returns the name and type of each column:

> metaRecord :: Table t t -> [(String, String)]
> metaRecord = go
>   where
>     go :: forall t a. Table t a -> [(String, String)]
>     go (Map _ t)   = go t
>     go (Pure _ )   = []
>     go (App t1 t2) = go t1 ++ go t2
>     go (Column fi) = [(fieldName fi, fieldType (undefined :: a))]

The second method is only slightly more complicated: instead of returning the type of each column, it calls our custom extract function for that column to get its value. We can then call fieldShow on that to do the final serialization, and what we get is the serialized name and value of each column.

> toRecord :: forall t. Table t t -> t -> [(String, String)]
> toRecord tab x = go tab
>   where
>     go :: forall a. Table t a -> [(String, String)]
>     go (Map _ t)   = go t
>     go (Pure _ )   = []
>     go (App t1 t2) = go t1 ++ go t2
>     go (Column fi) =
>         [(fieldName fi, fieldShow $ fieldExtract fi x)]

The deserialization method is the hardest. It works by actually evaluating the tree we built. Because of our GADT use, we can do this in a type-safe way.

> fromRecord :: forall t. Table t t -> [(String, String)] -> t
> fromRecord tab record = go tab
>   where
>     go :: forall a. Table t a -> a
>     go (Map f t)   = f (go t)
>     go (Pure x)    = x
>     go (App ft t)  = (go ft) (go t)
>     go (Column fi) = case lookup (fieldName fi) record of
>         Nothing  -> error $ "Missing field: " ++ fieldName fi
>         Just str -> fieldRead str

Utilities

We add a small utility function to pretty-print our records:

> printRecord :: [(String, String)] -> IO ()
> printRecord = putStrLn . unlines . map (\(x, y) -> x ++ " = " ++ y)

And a typeclass so we do not have to create an xxxTable function for each datatype:

> class HasTable t where
>     table :: Table t t

Demo

Now let’s implement food serialization for real: we only need to implement a single typeclass with a single method!

> instance HasTable Food where
>     table = Food
>         <$> column "name" foodName
>         <*> column "cost" foodCost

Some concrete deliciousness:

> ramen :: Food
> ramen = Food "ラーメン" 800

And a trivial demo:

> main :: IO ()
> main = do
>     putStrLn "Meta record (used in CREATE TABLE... etc.):"
>     printRecord $ metaRecord (table :: Table Food Food)
> 
>     putStrLn "Serialized ramen:"
>     printRecord (toRecord table ramen)
> 
>     putStrLn "Deserialized sashimi:"
>     print (fromRecord table [("name", "刺身"), ("cost", "1200")] :: Food)

Conclusion

I think this is a nice use case of GADTs, and although it has a performance impact, it looks like it is worth it (for now). If it turns out that we can nicely generalize this code, we will probably release it on Hackage. But feel free to steal the idea, and comments are also welcome, of course!

Exercise for the reader: can you make Table a Monad? Why (not)?

blaze-markup and blaze-svg

A few weeks ago, Deepak Jois emailed me that he would like to create a blaze-html package for SVG. He started doing so by first simply copying the blaze-html code and creating blaze-svg from there.

Obviously, blaze-html and blaze-svg contained a lot of common code, so we (mostly Deepak, he really deserves all credit for this) extracted the shared code into a new blaze-markup package, upon which both packages now depend.

Backwards-incompatible changes

This move introduced some backwards-incompatible changes, which we catch with deprecation warnings in a few places, but there have also been some module changes, which might break your code when you upgrade.

The Text.Blaze module no longer contains an Html type. Instead, it has a Markup type. However, in Text.Blaze.Html, we have

type Html = Markup

so the best way to upgrade is to change every Text.Blaze import into a Text.Blaze.Html import.

Additionally, the renderHtml methods have been renamed to renderMarkup. When you use a renderHtml method, you will see a deprecation warning. The best way to resolve this warning is to import e.g., Text.Blaze.Html.Renderer.Utf8 instead of Text.Blaze.Renderer.Utf8.

Easier creation of custom nodes

blaze-html 0.5 introduces easy creation of custom nodes. In the following snippet, test1 and test2 generate the same HTML:

{-# LANGUAGE OverloadedStrings #-}
import Text.Blaze.Html (Html)
import Text.Blaze.Html5 (p)
import Text.Blaze.Internal

test1 :: Html
test1 = p "Hello world"

test2 :: Html
test2 = customParent "p" "Hello world"

However, you should void usage of customParent (and customLeaf, customAttribute) whenever possible, which is why they are placed in the Text.Blaze.Internal module. They are much slower than their regular counterparts, and also less safe since they’re vulnerable to typos.

Simple manipulations of the HTML tree

I’ve also decided I will add some very simple manipulations of the HTML tree when needed. For now, a single manipulation contents is included, since another package (to be released in the future) depends on it.

This very fast function takes the text content of the HTML tree, so it is available for rendering. Let’s look at a simple example:

{-# LANGUAGE OverloadedStrings #-}
import Text.Blaze.Html (Html, contents, (!))
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

test :: Html
test = do
    H.p "Hello "
    H.img ! A.src "foo.png"
    H.p "World!"

-- Renders: <p>Hello </p><img src=\"foo.png\"><p>World!</p>
test1 = renderHtml test

-- Renders "Hello World!"
test2 = renderHtml $ contents test

Installation

You can install the new version just by running

cabal update && cabal install blaze-html

You should definitely contact me if you run into any trouble, I’ll try to get back to you as fast as possible. In the meanwhile, I’m going to enjoy the rest of the Utrecht Hackathon!

At this point, it seems that every self-respecting hacker has at least already implemented an optimizing assembler, a dissassembler, an emulator, a debugger, or even an operating system or an LLVM backend.

I obviously couldn’t lag behind and took the opportunity to think about the design of such an emulator in Haskell. This blogpost is the result of my search, and my experiments with different designs until I arrived at something which had all the nice properties I desired.

The full implementation of this design can be found here.

The core of the problem: load and store

When designing a system, it’s often a good idea to start from a minimal but functional core and work your way up from there – this is also the approach I have taken here.

We can create such a core system by defining the state of the emulator as a datatype with a few primitive operations on it. The state of the emulator can be represented as a Memory datatype. It’s a tiny wrapper around a mutable array, and has three basic operations:

module Memory where

data Address
    = Pc
    | Sp
    | Ram Word16
    -- And more...

data Memory s = Memory  -- Exact definition omitted

new   :: ST s (Memory s)
load  :: Memory s -> Address -> ST s Word16
store :: Memory s -> Address -> Word16 -> ST s ()

Using the above Address datatype, we’re able to access and modify all of the values the emulator needs using two simple operations: load and store. The fact that we can access and modify, for example, the stack pointer (Sp) in the same way as we would modify a value in the RAM (Ram 0x1000) simplifies the implementation of the actual emulator. As an example, think of code like this:

SET SP, I
SET [0x1000], SP

This all runs in the ST monad. This monad is perhaps a bit of a strange beast, since it allows destructive updates: this means we can update words in the RAM of the CPU really fast. However, the result remains pure nonetheless: unlike the IO monad, code written in the ST monad can only modify state internal to the monad. This is guaranteed by the type system using the Rank2Types extension.

This is great because it allows us to have a really fast emulator, of which we can trivially say it is deterministic.

A necessary abstraction

However, while the current specification does not include keyboard input and video output, this will certainly be added in the future. If we want to support that in our emulator, does it mean that we will eventually be forced to run our code in the IO monad, and that our brave efforts to build a deterministic emulator have been in vain?

Not exactly. Using a typeclass, it is possible to build an extremely useful abstraction layer which helps us with this problem.

module Emulator.Monad where

class Monad m => MonadEmulator m where
    load  :: Address -> m Word16
    store :: Address -> Word16 -> m ()

We can now implement most of the emulator with just the type MonadEmulator m => m (), since we really only need load and store.

The following (overly simplified and incorrect) snippet illustrates that fact.

module Emulator where

import Emulator.Monad

step :: MonadEmulator m => m ()
step = do
    -- Load the next instruction (at PC) and execute it
    pc    <- load Pc 
    instr <- load (Ram pc)
    store Pc (pc + 1)
    execute instr

A deterministic implementation

We can write a simple, nice and pure implementation of this typeclass by using ST, as we previously discussed. We need access to the Memory, and for this purpose we can simply wrap a ReaderT around ST:

module Emulator.Monad.ST where

import Emulator.Monad
import Memory (Memory)
import qualified Memory as Memory

newtype STEmulator s a = STEmulator (ReaderT (Memory s) (ST s) a)
    deriving (Monad)

instance MonadEmulator (STEmulator s) where
    load address = STEmulator $ do
        mem <- ask
        lift $ Memory.load mem address
    store address word = STEmulator $ do
        mem <- ask
        lift $ Memory.store mem address word

runSTEmulator :: (forall s. STEmulator s a) -> a
-- Implementation uses runST to produce a pure result:
-- runST :: (forall s. ST s a) -> a

And a bit of IO

As briefly discussed before, we want to be able to add keyboard input and video output. I’ll focus on video output for this blogpost, since it’s a little easier to explain. The specification for video output is not yet released, but it was possible to deduce a lot from some screenshots.

The video memory starts at 0x8000, and when we store characters at these addresses, they are displayed on the video terminal. Note that we don’t need to extend the MonadEmulator typeclass for this purpose: we already support writing values to 0x8000 + i, because we can reach those addresses through the regular store operation, discussed above!

But actually displaying the video terminal is something we can’t do with our STEmulator – let’s add an IOEmulator as well.

The stToIO function from Control.Monad.ST allows us to reuse everything in the Memory module.

stToIO :: ST RealWorld a -> IO a

Note that this is not an unsafe function: converting ST to IO is always safe this way (converting IO to ST, however, is tricky business, but this is not needed for our emulator).

Almost exactly like our STEmulator is a ReaderT wrapper around ST, our IOEmulator starts out like a ReaderT wrapper around IO.

module Emulator.Monad.IO where

import Emulator.Monad
import Memory (Memory)
import qualified Memory as Memory

newtype IOEmulator a = IOEmulator (ReaderT (Memory RealWorld) IO a)
    deriving (Monad, MonadIO)

instance MonadEmulator IOEmulator where
    load address = IOEmulator $ do
        mem <- ask
        lift $ stToIO $ Memory.load mem address
    store address word = IOEmulator $ do
        mem <- ask
        lift $ stToIO $ Memory.store mem address word

runIOEmulator :: IOEmulator a -> IO a
-- Implementation trivial, omitted

If we now have some code for an emulator, we can run it in two ways:

-- Load a program, execute 1000 instructions, return the value in the RAM at
-- position 0x1000.
test :: MonadEmulator m => m Word16
test = do
    loadProgram [0xa461, 0x7001, 0x8403 {-# and more... #-}]
    replicateM_ 1000 step
    load (Ram 0x1000)

t1 :: Word16
t1 = runSTEmulator test

t2 :: IO Word16
t2 = runIOEmulator test

Let’s not stop here yet, because with our current version of IOEmulator, all we’ve done is create an impure version of STEmulator, without any extra features!

Adding the desired features is relatively easy at this point: suppose we want to add support for the video terminal. We just modify the store implementation of IOEmulator a little:

store address word = IOEmulator $ do
    mem <- ask
    lift $ stToIO $ Memory.store mem address word
    lift $ video address word  -- New line added here

And a video terminal implementation!

video :: Address -> Word16 -> IO ()
video (Ram address) word
    | address < videoStart = return ()
    | address >= videoEnd  = return ()
    | otherwise            = do
        -- Calculate row, column, character code and draw!
        return ()
  where
    videoStart = 0x8000
    videoEnd   = videoStart + rows * columns  -- Unknown yet?
video _ _ = return ()

Conclusion

ST is a wonderful tool for problems that require (local) destructive updates for performance reasons ¹. Additionally, we can easily convert it to IO, which allows us to simply pick one of the two using an abstraction layer: we can have deterministic results for tests, proper keyboard/video support, and the entire implementation of the actual CPU is shared code.

My thanks to Andy Georges and Toon Willems for proofreading and some corrections.

Daniel Patterson has been so kind to implement file uploads for the Snap backend of digestive-functors – this was previously only implemented in the Happstack. The great thing is that this implementation still has all flexible options Snap allows for file uploads.

For now, digestive-functors enforced you to use the blaze-html library, simply because no other frontend library was available. Snap users will be delighted to hear we’ve written a Heist library now. Let’s take a look at an example. I’ll go over the forms rather quickly and focus on the Heist library. If this is the first time you read about digestive-functors, you might want to take a glance at this tutorial first.

First, we need some datatypes:

data Date = Date
    { dateDay   :: Int
    , dateMonth :: Int
    , dateYear  :: Int
    } deriving (Show)

data Sex = Female | Male
    deriving (Eq, Show)

data User = User
    { userName      :: Text
    , userPassword  :: Text
    , userSex       :: Sex
    , userBirthdate :: Date
    } deriving (Show)

And then some forms:

dateForm :: Monad m => Form Text m Date
dateForm = check "Not a valid date" validDate $ Date
    <$> "day"   .: stringRead "Not a number" (Just 16)
    <*> "month" .: stringRead "Not a number" (Just 6)
    <*> "year"  .: stringRead "Not a number" (Just 1990)
  where
    validDate (Date day month _) =
        day   >= 1 && day   <= 31 &&
        month >= 1 && month <= 12

userForm :: Monad m => Form Text m User
userForm = User
    <$> "name"      .: text (Just "Jasper")
    <*> "password"  .: text Nothing
    <*> "sex"       .: choice [(Female, "Female"), (Male, "Male")] Nothing
    <*> "birthdate" .: dateForm

Because of the composable nature of digestive-functors, we will first write a template for the date form, and reuse that for the user form.

Let’s place the template for the date form in snaplets/heist/date-form.tpl. Almost all splices take a ref attribute, which tells the library what the field is for – by doing this, we automatically get the previous value if a form submission fails, etc. We can also easily pass arbitrary attributes to the input elements, like we do with size here.

<dfInputText ref="day" size="2" />
/
<dfInputText ref="month" size="2" />
/
<dfInputText ref="year" size="4" />

There’s a bit more in snaplets/heist/user-form.tpl.

• dfForm generates a <form> tag, and takes care of the method and enctype attributes for us – we just have to take care of action.

• We use dfChildErrorList with ref="" to generate a list of all errors. It is also possible to generate the errors next to the relevant fields, should you wish to do so.

• There’s obviously more than dfInputText – we have dfInputPassword here, and dfInputSelect to generate a combobox.

• In order to reuse the date-form template, we first use dfSubView. This changes the focus on the “form tree”, so our date-form template can use month instead of birthdate.month. The apply splice is a standard Heist splice.

<dfForm action="/">
    <dfChildErrorList ref="" />

    <dfLabel ref="name">Name: </dfLabel>
    <dfInputText ref="name" />
    <br>

    <dfLabel ref="password">Password: </dfLabel>
    <dfInputPassword ref="password" />
    <br>

    <dfLabel ref="sex">Sex: </dfLabel>
    <dfInputSelect ref="sex" />
    <br>

    Birthday:
    <dfSubView ref="birthdate">
        <apply template="date-form" />
    </dfSubView>
    <br>

    <dfInputSubmit value="Enter" />
</dfForm>

The digestive-functors-heist library provides no Snaplet but integrates well with the concept. We just need to call runForm from the digestive-functors-snap library, and most is taken care of:

form :: Handler App App ()
form = do
    (view, result) <- runForm "form" userForm
    case result of
        Just x  -> -- do something with the user in x...
        Nothing -> heistLocal (bindDigestiveSplices view) $ render "user-form"

I hope this quick glance at the library was useful. Any comments and criticism are welcome, as always. The full source code for this example can be found here (snap-heist.hs, and the templates in snaplets/heist/templates).

This blogpost is very general, so some users might want to jump directly to the tutorial. Installation is through cabal: cabal install digestive-functors.

What are formlets?

In 2008, a paper was published, called “The Essence of Form Abstraction”. The paper applied a well-known functional design pattern (Applicative Functors) to have clean way of creating HTML forms, which are inherently composable.

Let’s have a quick look at how this typically works. The following code is based on the initial Haskell implementation of formlets by the paper authors, later maintained by Chris Eidhof and others. We usually have a data structure we want to create a type for:

data Date = Date {month :: Integer, day :: Integer} deriving (Show)

…for which we create a form…

validDate :: Date -> Bool
validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31]

dateComponent :: FailingForm Date
dateComponent = Date <$> inputIntegerF (Just 1) <*> inputIntegerF (Just 16)

dateFull :: FailingForm Date
dateFull = dateComponent `check` ensure validDate "This is not a valid date"

And to illustrate the power of any formlets library, it’s composability, let’s see how you can easily reuse the dateFull form anywhere:

data User = User {name :: String, password :: String, birthdate :: Date}
    deriving (Show)

userFull :: FailingForm User
userFull = User <$> inputF Nothing <*> passwordF Nothing <*> dateFull

digestive-functors

While I was working on a few patches for the formlets library back in 2010, I noticed a few things were impossible to do using this library.

For example, For usability reasons, you might want to add <label> tags in your forms. These labels need to be associated with an input element using the for attribute – when this is the case, the user will be able to click the label instead of the (relatively small) checkbox. Demo:

Another thing is error handling. When evaluating a form using the original formlets library, you would get a list of errors, and the user would see something like this:

While this is usually pretty clear, it is nicer when the library can actually associate the errors with input field(s), so you are able to show something like:

Along with some other things, these were the practical improvements the digestive-functors library made in comparison to formlets.

digestive-functors 0.3

However, one serious issue remained. When you write down a form in a formlets library, you specify the HTML layout as well as the validation rules. This is really a bad thing: sepataration of model and view is a well known goal in programming.

Separating the HTML layout and the validation rules would lead to a number of benefits:

• It would be possible to create multiple representations for a single form (a good example is a login form in the site header, and a login form in the page body, which you see find on many websites).

• The code to specify the validation rules becomes smaller and easier to read.

• It becomes easier to insert custom HTML code in between your form HTML.

• You can rewrite the form using another HTML templating engine, e.g. blaze-html, Hamlet or Heist, without touching the validation rules.

However, it does seem to come with a serious disadvantage as well:

• It seems impossible ¹ to have a type-safe coupling between validation rules and HTML layout without losing flexibility or ease-of-use.

In order to make the coupling between the validation rules and the HTML layout, digestive-functors-0.3 uses simple Text values. An example of some validation rules:

dateForm = check "This is not a valid date" validDate $ Date
    <$> "month" .: stringRead "Could not parse month"
    <*> "day"   .: stringRead "Could not parse day"

A major difference you can immediately notice is that we use Text labels ("month", "day") and use the custom .: operator to assign these to parts of our form. We will use these labels to refer to fields in the HTML layout.

Form composition is obviously still very important. Let’s give an example by implemening userForm using dateForm:

userForm = User
    <$> "name"      .: string Nothing
    <*> "password"  .: string Nothing
    <*> "birthdate" .: dateForm

One important difference between userFull and userForm is that we used string twice here – where the original one used inputF and passwordF. This is a result of the separation of concerns. After all, a password is just a string: it is up to the view to represent it as a password box.

Let’s look at the views now and write an HTML layout using e.g. blaze-html. The code for this is a bit verbose (HTML always is), but clear, and it’s possible to add some utility combinators for it:

dateView view = do
    errorList "month" view
    label     "month" view "Month: "
    inputText "month" view
    H.br

    errorList "day" view
    label     "day" view "Day: "
    inputText "day" view
    H.br

Views are composable as well, which is very important. A developer might want to inline a view, e.g.:

userView view = do
    errorList "name" view
    label     "name" view "Name: "
    inputText "name" view
    H.br

    errorList     "password" view
    label         "password" view "Password: "
    inputPassword "password" view
    H.br

    errorList "birthdate.month" view
    label     "birthdate.month" view "Month: "
    inputText "birthdate.month" view
    H.br

    errorList "birthdate.day" view
    label     "birthdate.day" view "Day: "
    inputText "birthdate.day" view
    H.br

A few things to note. While "name" and "password" are both of the same type (String) we chose to use a textbox for the former and a password box for the latter: this is a possibility we gain because of the separation we made. A (probably more useful) example is when the user has to choose between a number of options (e.g. Apples, Oranges or Bananas), we can decide in the view code whether we want to use a combobox or a set of radio buttons.

We use a "foo.bar" notation to refer to fields of “subforms”. This is useful when a designer wants a custom form layout, but it leads to duplication of code. To counter this, views are composable, just like forms!

userView view = do
    -- Name, password...

    dateView $ subView "birthdate" view

This concludes this blogpost about the digestive-functors 0.3 release.

Note that I have omitted types and other details – you can find everything in this tutorial. The digestive-functors library provides a very easy interface for writing these view libraries: you can basically query the previous input, errors, etc. for each field. This makes it very easy to add libraries for e.g. Hamlet or Heist (but I haven’t done so yet, if anyone is interested, contact me!).

1. Proposes a simplistic build system model
2. Gives an implementation using Monads, and fails
3. Gives a working implementation using Arrow (and Applicative)

Setup

> {-# LANGUAGE Arrows #-}
> import Prelude hiding (id, (.))

> import Control.Applicative (Applicative (..), (<$>))
> import Control.Arrow (Arrow (..), returnA, (>>>))
> import Control.Category (Category (..))
> import Control.Monad ((<=<))
> import Control.Monad.State (StateT)
> import System.Directory (doesFileExist, getModificationTime)

This post uses incremental build systems (think make or ant) as an example. These systems allow you to specify commands which are only executed if the destination file is out-of-date. The reason I’m using this example is that it’s highly applicable in Hakyll, a static site compiler which is one of my side projects.

Let’s use a bottom-up approach and first write a simple function to only do out-of-date builds. The runBuild function checks the modification times of the dependencies and the destination file, and based on that information, calls or doesn’t call the IO String workhorse. This is obviously very limited functionality, but it’s just an example.

> runBuild :: FilePath    -- ^ Destination
>          -> [FilePath]  -- ^ Dependencies
>          -> IO String   -- ^ Workhorse which produces output
>          -> IO ()       -- ^ May or may not run the workhorse
> runBuild dest deps f = do
>     exists       <- doesFileExist dest
>     depsModified <- mapM getModificationTime deps
>     case (exists, depsModified) of
>         (False, _) -> run
>         (True, []) -> dontRun
>         (True, _)  -> do
>             destModified <- getModificationTime dest
>             if destModified < maximum depsModified then run else dontRun
>   where
>     dontRun = putStrLn $ "Up to date: " ++ dest
>     run = do
>         putStrLn $ "Building " ++ dest
>         writeFile dest =<< f

Let’s implement the Unix paste command. We first have a pure version:

> paste :: String -> String -> String
> paste x y = unlines $ zipWith (\x' y' -> x' ++ "\t" ++ y') (lines x) (lines y)

And now we can apply our runBuild function:

> testBuild :: IO ()
> testBuild = runBuild "test-io.txt" ["rainbows.txt", "unicorns.txt"] $ do
>     x <- readFile "rainbows.txt"
>     y <- readFile "unicorns.txt"
>     return $ paste x y

This works fine, but the annoyance is that we manually have to specify our dependencies: this quickly becomes very tedious. Instead, our goal is to automate the dependency tracking. Haskell allows for many abstractions, so let’s have a look at how we can accomplish this.

Monads

Let’s see if we can capture this behaviour in a Monad. If we declare our Monad as a simple datatype which holds the dependencies and the actual workhorse. we get something like:

> data BuildM a = BuildM [FilePath] (IO a)

Running is easy:

> runBuildM :: FilePath -> BuildM String -> IO ()
> runBuildM dest (BuildM deps f) = runBuild dest deps f

And a readFile could be implemented like:

> readFileM :: FilePath -> BuildM String
> readFileM path = BuildM [path] $ readFile path

However, problems arise when we try to pin down the Monad instance for this datatype.

> instance Monad BuildM where
>     return x              = BuildM []   $ return x
>     (BuildM deps f) >>= g = BuildM deps $ do
>         -- Where do the dependencies of g's result go?
>         BuildM _ y <- g <$> f
>         y

Clearly, this datatype doesn’t allow us to get fs dependencies in mx >>= f. We can write the following piece of code, but it won’t be correct, as it ignores the "unicorns.txt" dependency.

> testBuildM :: IO ()
> testBuildM = runBuildM "test-m.txt" $ do
>     x <- readFileM "rainbows.txt"
>     y <- readFileM "unicorns.txt"
>     return $ paste x y

Other datatypes are possible, e.g. one could also try something like:

> type BuildM' = StateT [FilePath] IO

This kind of definition leads to another problem: the mx in mx >>= f will always be executed, even if everything is up-to-date. This behaviour is inherently coupled to the use of Monads, consider code like this:

> testBuildM' :: IO ()
> testBuildM' = runBuildM "test-m.txt" $ do
>     x <- readFileM "rainbows.txt"
>     y <- if length x > 200 then readFileM "unicorns.txt" else return ""
>     return $ paste x y

We need to evaluate x in order to determine the dependencies! This is not how a build system should work: the system should not inspect x and just add "unicorns.txt" as a dependency, regardless of the value of x. The fact that we can’t get around this makes it clear that Monads are not a good choice here.

Arrows

Two other possibilities will work well here: Arrows and Applicative. I’ll demonstrate the Arrow solution first, because it is a bit more generic ¹.

The datatype looks a lot like the one used for the Monad instance ²:

> data BuildA a b = BuildA [FilePath] (a -> IO b)

Running this build datatype is also straightforward ³.

> runBuildA :: FilePath -> BuildA () String -> IO ()
> runBuildA dest (BuildA deps f) = runBuild dest deps $ f ()

Arrows are a generalized version of functions, and can be used in a similar way. Each Arrow is also a Category, so we first need to declare a Category instance. In order to make our BuildA an Category, we need an identity operation, and function composition.

The BuildA a a identity operation is straightforward to implement: it obviously has no dependencies, it is a build step which does absolutely nothing. A composition of two build steps takes the sum of dependencies and composes the workhorses using <=< ⁴:

> instance Category BuildA where
>     id                        = BuildA [] return
>     BuildA d1 f . BuildA d2 g = BuildA (d1 ++ d2) (f <=< g)

This is not enough to instantiate an Arrow, though. Two more methods need to be implemented: arr and first.

arr is reasonably simple and allows the user to “lift” a pure function into an Arrow. For our example, this yields the type signature arr :: (a -> b) -> BuildA a b – the implementation is straightforward.

In order to allow the programmer to build computations using Arrows, a mechanism to pass variables through computations is needed. In our example, we have first :: BuildA a b -> BuildA (a, c) (b, c): it transforms a simple Arrow into an Arrow which carries an additional variable through the computation.

> instance Arrow BuildA where
>     arr f                 = BuildA [] (return . f)
>     first (BuildA deps f) = BuildA deps $ \(x, y) -> do
>         x' <- f x
>         return (x', y)

Let’s write the Arrow version of readFileM which also automatically adds a dependency:

> readFileA :: FilePath -> BuildA () String
> readFileA path = BuildA [path] $ \() -> readFile path

Using Arrow notation, we can now implement a (not very pretty) solution which does bear a lot of resemblance to testBuildM, with the difference that this version actually works with proper dependency management:

> testBuildA :: IO ()
> testBuildA = runBuildA "test-a.txt" $ proc () -> do
>     x <- readFileA "rainbows.txt" -< ()
>     y <- readFileA "unicorns.txt" -< ()
>     returnA -< paste x y

However, writing ugly code like this obviously isn’t the way we want to go. Arrow-based code can be made a whole lot prettier if you write as much code as possible as a processing Arrow. For example, we could write an Arrow-based variant of paste which processes a file by pasting another file next to it:

> pasteFileA :: FilePath -> BuildA String String
> pasteFileA path = proc x -> do
>     y <- readFileA path -< ()
>     returnA -< paste x y

With utilities like this, we can write a much prettier testBuildA which clearly demonstrates the processing approach. >>> is left-to-right composition of Arrows, much like a flipped version of .:

> testBuildA' :: IO ()
> testBuildA' = runBuildA "test-a.txt" $
>     readFileA "rainbows.txt" >>>
>     pasteFileA "unicorns.txt"

Epilogue: Applicative functors

Arrow and Applicative show similar behaviour in many cases. For our example, we also could’ve chosen to implement our solution using Applicative instead of Arrow. I’ve chosen Arrow for two reasons:

• It is often more natural to model a building process as an Arrow.
• We can actually write an Applicative instance for the same datatype, giving the user the freedom of choice!

It’s a fun challenge to implement this Applicative instance for the BuildA datatype.

> instance Functor (BuildA a) where
>     fmap f (BuildA deps g) = BuildA deps (fmap f . g)
> 
> instance Applicative (BuildA a) where
>     pure x                      = BuildA [] $ const $ return x
>     BuildA d1 f <*> BuildA d2 g = BuildA (d1 ++ d2) $ \x -> f x <*> g x
> 
> testBuildApp :: IO ()
> testBuildApp = runBuildA "test-app.txt" $
>     paste <$> readFileA "rainbows.txt" <*> readFileA "unicorns.txt"

I hope this blogpost made some of the advantages and disadvantages between Monad and Arrow clear. All comments and feedback are welcome, as always. Thanks to nudded for proofreading.

I’ve been working on a websockets library lately, and this blogpost is mostly based upon work on that library. The code given in this blogpost is not the code from the library, but a stand-alone simplification, to make it more accessible to readers.

This blogpost is based upon the enumerator library by John Millikin. Multiple implementations of the Iteratee concept exist, I chose this one because it’s currently the most popular implementation for the packages I work on (mostly web-related). Additionally, alternatives to iteratees are being developed and I am certainly very curious as to how this will turn out.

Iteratees are often lauded because they offer great performance characteristics in comparison to lazy I/O. Another key feature provided by iteratees is composability (even for pure operations!) – on which I will focus this blogpost. An understanding of Iteratees is not required for this blogpost, and be aware that my goal is to merely spark your interest, not to fully explain them.

> import Blaze.ByteString.Builder (Builder)
> import Data.ByteString (ByteString)
> import Data.Enumerator ((=$))
> import Data.Monoid (mappend, mempty)
> import qualified Blaze.ByteString.Builder as BB
> import qualified Data.Attoparsec as A
> import qualified Data.Attoparsec.Enumerator as A
> import qualified Data.ByteString as B
> import qualified Data.ByteString.Lazy as BL
> import qualified Data.Enumerator as E
> import qualified Data.Enumerator.List as EL

The problem

Different versions of the WebSockets protocol exist. We obviously want to share as much code as possible in between these versions, to avoid duplication. We can define a common Message datatype which can be used for all versions:

> data Message
>     = TextMessage BL.ByteString
>     | PingMessage
>     | CloseMessage
>     deriving (Show)

Now, for each version, we want to be able to parse these messages. That means that:

1. we agree on a common interface (e.g. ByteString -> Message);
2. we implement this interface for each version;
3. we choose the right implementation at runtime.

The first WebSockets drafts (referred to Hybi00) offered a very simple message format. A parser could be implemented easily:

> parseMessageHybi00 :: A.Parser Message
> parseMessageHybi00 = error "Omitted for brevity"

However – this is not the case for later versions of the protocol (referred to as Hybi10). These later versions introduced frames. This allows an web application to multiplex different messages onto the socket – more specifically, it can insert control messages (e.g. ping) in between messages with huge payloads. This increases the complexity of our server, since we have to demultiplex these frames again.

We have three types of frames in the simplification of the protocol:

> data FrameType = TextFrame | PingFrame | CloseFrame
>     deriving (Show)

And a frame has a type, a flag indicating whether or not this is the last frame, and a payload.

> data Frame = Frame FrameType Bool ByteString
>     deriving (Show)

These are not hard to parse either:

> parseFrameHybi10 :: A.Parser Frame
> parseFrameHybi10 = error "Omitted for brevity"

But if we want to have a common interface, we will need to access the result as a Message. Remember that, we want the Hybi00 and the Hybi10 implementations to offer the same interface: simply put, something like ByteString -> Message.

In a more simple world, we would’ve been able to write a simple [Frame] -> Message function. This is clearly not the case here, as many frames can produce many messages. [Frame] -> [Message] looks better, but what do we do with leftover input which belongs to some next message? We clearly need a stateful demultiplexer.

A stateful demultiplexer

Most demultiplexers are obviously stateful – the reason why I mentioned this here is because our demultiplexer will be explicitly stateful. Explicit state is not always a good thing: when this state impacts your entire application, it quickly becomes tedious to pass around and manage. But here, we can clearly restrict the statefulness to the demultiplexer.

In our simplification, TextMessage is the only kind of message that can be split up in frames. This simplifies our demultiplexer greatly: we only need to keep track of the leftover input. This is not the case for the actual implementation, so it’s probably a good idea to see the demultiplexer as some kind of black box, accessible only through the functions emptyDemultiplexState and demultiplex.

> type DemultiplexState = Builder

> emptyDemultiplexState :: DemultiplexState
> emptyDemultiplexState = mempty

> demultiplex :: Frame -> DemultiplexState -> ([Message], DemultiplexState)
> demultiplex (Frame CloseFrame _ _)   ds = ([CloseMessage], ds)
> demultiplex (Frame PingFrame _ _)    ds = ([PingMessage], ds)
> demultiplex (Frame TextFrame fin bs) ds = case fin of
>     False -> ([], ds')
>     True  -> ([TextMessage $ BB.toLazyByteString ds'], emptyDemultiplexState)
>   where
>     ds' = ds `mappend` BB.fromByteString bs

Such a straightforward Haskell implementation is easy to read, debug and understand, but having to manually keep track of the state is surely a disadvantage… or not?

A common interface

At a first sight, a disadvantage of such a stateful demultiplexer is that we clearly cannot use a simple interface such as:

> type Interface0 = ByteString -> Message

nor can we use (superficially) more complex interfaces such as:

> type Interface1 = [ByteString] -> [Message]

precisely because we have to keep track of the DemultiplexState for the Hybi10 version. Well, we can easily solve this:

> type Interface2 =  DemultiplexState
>                 -> ByteString -> ([Message], DemultiplexState)

…given this interface, it is possible to write a correct implementation for Hybi00 as well as Hybi10: the Hybi00 implementation would simply ignore the DemultiplexState, and the Hybi10 implementation would use it as input for the demultiplex function.

This is clearly an example of when explicit state becomes tedious to manage: suppose we add another stateful component for some Hybi9000 implementation. Then, we would have to adapt our Interface2 too also incorporate this state: it seems we’re going down a very dangerous road here.

Enter Iteratee

As the title and introduction of this blogpost suggested, there is a better way to solve this problem using Iteratees. I’m not going to go through all Iteratee concepts here, but you should be able to follow with a basic Haskell knowledge: let the types guide you.

An Enumeratee x y m b is a stream transformer which turns values of the type x to values of the type y. We’ll agree on such an interface (feel free to safely ignore the m and b parameters if you’re unfamiliar with Iteratees):

> type Interface3 m b = E.Enumeratee B.ByteString Message m b

The implementation for Hybi00 looks fairly easy:

> implHybi00 :: Monad m => Interface3 m b
> implHybi00 = E.sequence $ A.iterParser parseMessageHybi00

The trick is that we turn our parser into an Iteratee using the iterParser function from the attoparsec-enumerator library. Such an Iteratee reads ByteStrings as input, and produces our Message: by repeatedly applying this parser (using sequence), we obtain the stream transformer we wanted.

This is not very impressive, since a simple function could’ve be enough for the Hybi00 implementation. But let’s look at the Hybi10 implementation:

> implFramesHybi00 :: Monad m => E.Enumeratee B.ByteString Frame m b
> implFramesHybi00 = E.sequence $ A.iterParser parseFrameHybi10

constructing a stream transformer from ByteString to Frame is similar to what we did for Hybi00. But we can implement an additional stream transformer:

> framesToMessages :: Monad m => E.Enumeratee Frame Message m b
> framesToMessages = EL.concatMapAccum step emptyDemultiplexState
>   where
>     step ds frame = let (msgs, ds') = demultiplex frame ds in (ds', msgs)

And compose these stream transformers to obtain our implementation:

> implHybi10 :: Monad m => Interface3 m b
> implHybi10 = (implFramesHybi00 =$) . framesToMessages

Mission completed – and we’ve successfully hidden our state management from the users of this interface.

Conclusion

I’ve demonstrated that Iteratees allow you to write clear, concise and explicitly stateful Haskell code, which is still composable without having to manually manage this state in higher levels of your application. This is not a new thing: it is probably the essence of stream processing in Haskell. Yet Iteratees combine this with great performance and elegance, making it a very interesting feature.