Simple Haskell Web Programming with HAppS

Motivation

There are two or three CGI libraries for Haskell. But if you ask the cognoscenti (to be found on the #haskell IRC channel) for Haskell web programming recommendations they will almost invariably point you at HAppS.

HAppS may have many virtues but it’s documentation and associated tutorial do not number among them.

Copying the first Rails screencast, Creating a Blog in Fifteen Minutes, I figured that a good example web application is a blogging system. Leaving aside that blogging is now pass�, here is my HAppS tutorial.

Please note that I am a fairly inexperienced Haskell programmer and almost all the advice I give will be wrong. Some of what I say will necessarily be vague because I don’t understand it completely myself. But the advantage to my tutorial is that it will at least be comprehensible! I hope that some Haskell gurus will read this and find my mistakes and update me in the comments. Thanks!

Installation

For installation of HAppS, please see my earlier post.

Hello, World

First, let’s get HAppS working and see something in our browser. Save the following listing to Hello.hs:

import HAppS
import HAppS.Protocols.SimpleHTTP2
 
main = stdHTTP [debugFilter, noState, h () GET $ ok $ val "Hello, World"]

If you compile that with:

ghc --make Hello.hs -o hello

And then run the resulting “hello” binary (./hello under Unix, hello under Windows). If you visit http://localhost:8000/ in your browser you should see “Hello, World” displayed.

So what have we actually done there? Well, I don’t really know. But certainly we’ve passed a list of directives to the stdHTTP function. One of which (the bit starting “h”) says: “if you get a GET request of any sort, respond with a page containing the text ‘Hello, World'”. Let’s just leave it at that for now.

Blog System

Weren’t we meant to building a blogging system? Yes! OK, let’s start with the URL scheme. We want the following paths in our system:

GET  /new 		=> Show the "create new post" form
POST /new	 	=> Create a new post using the submitted values
GET /post/$id 	=> Display the post with id $id
GET /			=> Dispaly the last 5 posts

The way to describe this scheme to HAppS is through the first and second arguments to the h request-handling function. The first argument is the path as a list (each element in the list representing a directory) and the second argument is the type of request (GET, POST and so on). So for displaying the “create new post form” we use h ["new"] GET.

Our GET /post/$id path is slightly tricky in that we don’t want to write out a very long list of post ids. We want to do some pattern matching. You can do this in HAppS with the re function. This tells HAppS to interpret the paths in the list as regular expressions. So for GET /post/$id we can use h ["post", "(0-9 )"] GET.

Putting that all together gives us:

import HAppS
import HAppS.Protocols.SimpleHTTP2
 
main = stdHTTP $ debugFilter : noState : 
           [h ["new"]                           GET  $ ok $ val "Show create post form"
           ,h ["new"]                           POST $ ok $ val "Save post and forward to display post"
           ,h (re ["post", "([0-9] )"])  GET  $ ok $ \\(id:_) () -> respond ("Display post "    id)
           ,h [""]                              GET  $ ok $ val "Display five most recent posts"
           ]

HTML in Haskell

Those calls to val are just placeholders. What we really want to return is some HTML.

The most common way to get HTML in Haskell seems to be to use one of the HTML combinator libraries such as Text.XHTL.Strict. This is only tangentially related to HAppS so I’ll just point you at this simple example and these fairly comprehensible notes and move on.

Now we have:

import HAppS
import HAppS.Protocols.SimpleHTTP2
import Text.XHtml.Strict

main :: IO ()
main = stdHTTP $ debugFilter : noState : 
           [h ["new"]                           GET  $ ok $ val showCreatePostPage
           ,h ["new"]                           POST $ ok $ val "Save post and forward to display post"
           ,h (re ["post", "([0-9] )"])  GET  $ ok $ \\(id:_) () -> respond ("Display post "    id)
           ,h [""]                              GET  $ ok $ val "Display five most recent posts"
           ]

-- Handlers

showCreatePostPage :: String
showCreatePostPage = showHtml getCreatePostPage

-- HTML Functions

getCreatePostPage :: Html
getCreatePostPage = mkHeader "New Post"
        body < < [
        (h1 << "New Post") 
            getCreatePostForm
        ]

getCreatePostForm :: Html
getCreatePostForm = (form ! [action "/new", method "post"] << (fieldset << [
        label ! [thefor "title"] << "Post Title", br,
        input ! [name "title", identifier "title", thetype "text"], br, br,
        label ! [thefor "body"] << "Post Body", br,
        textarea ! [name "body", identifier "body", rows "10", cols "40"] << "", br, br,
        submit "create" "Create Post"
    ]))

mkHeader :: String -> Html
mkHeader title = (header < < (thetitle << (title    " - HBlog")))

State

Of course I've chickened out above. Yes, I've provided some HTML that never changes. But what about the pages that depend on state? What about the display of the posts themselves? It's time to get rid of that odd-looking noState directive and start storing some blog posts. This is where it gets a little bit hairy.

While you could use a relational database with HAppS, it actually has it's own in-built haskell type-based storage system. It has lots of whizzy features that I'm not concerned about here to do with atomicicity and all that kind of shenanigans. But let's stay focused - we need a way of storing some blog posts. That means we need to define a type that derives Show and Read.

data Posts = Posts [Post] deriving (Read, Show) 
data Post = Post { pTitle :: String, pBody :: String } deriving (Read, Show)

What’s more we have to give it some instances so that HAppS can start it up, and know how to store it.

instance Serialize Posts where 
    typeString _ = "Posts"
    encodeStringM = defaultEncodeStringM
    decodeStringM = defaultDecodeStringM

instance StartState Posts where
    startStateM = return $ Posts []

OK, so now we know where we are going to store our posts. But how do we construct them in the first place? Well, Post is a record type, I will assume you know how to use record types. But what about extracting the values from the post body to slot into the record?

Strings we can get with:

v < - lookMb return req "fieldName"

where req is the Request, the second parameter passed to the function after ok in our request handlers. This code must appear in a do block.

Ints we can get with:

v < - lookMb readM req "fieldName"

Quite what the meaning of this distinction is, I don't know. So please leave a comment if you understand this better than me.

The state of the application itself (in our case a Posts, or list of Post) you can retrieve with get and update with put as long as you are within the appropriate Monad. This probably makes more sense in the context of a full example:

module Main where

import Control.Monad.State (get, put)
import Debug.Trace
import HAppS
import HAppS.Protocols.SimpleHTTP2
import Text.XHtml.Strict

main :: IO ()
main = stdHTTP $ debugFilter : 
           [h ["new"]                           GET  $ ok $ val showCreatePostPage
           ,h ["new"]                           POST $ ok createPost
           ,h (re ["post", "([0-9] )"])         GET  $ ok showPost
           ,h [""]                              GET  $ ok showPosts
           ]

-- State

data Posts = Posts [Post] deriving (Read, Show) 
data Post = Post { pTitle :: String, pBody :: String } deriving (Read, Show)

instance Serialize Posts where 
    typeString _ = "Posts"
    encodeStringM = defaultEncodeStringM
    decodeStringM = defaultDecodeStringM

instance StartState Posts where
    startStateM = return $ Posts []

-- Handlers

showCreatePostPage = showHtml getCreatePostPage

showPost (rawId:_) () = do
    (Posts posts) < - get
    let postId = read rawId :: Int
        post = posts !! postId 
    respond $ showHtml $ getPostsHtml [post]

showPosts () () = do
    (Posts posts) <- get
    respond $ showHtml $ getPostsHtml $ take 5 $ reverse posts 

createPost () req = do
    title <- lookMb return req "title"
    body  <- lookMb return req "body"
    let p = Post { pTitle = title, pBody = body }
    (Posts ps) <- get
    put (Posts (ps    [p]))
    respond $ "Post created"

-- HTML Functions

getCreatePostPage :: Html
getCreatePostPage = mkHeader "New Post"
        body << [
        (h1 << "New Post") 
            getCreatePostForm
        ]

getCreatePostForm :: Html
getCreatePostForm = (form ! [action "/new", method "post"] << (fieldset << [
        label ! [thefor "title"] << "Post Title", br,
        textfield "title", br, br,
        label ! [thefor "body"] << "Post Body", br,
        textarea ! [name "body", identifier "body", rows "10", cols "40"] << "", br, br,
        submit "create" "Create Post"
    ]))

getPostsHtml :: [Post] -> Html
getPostsHtml posts = foldl (   ) noHtml (map getPostHtml posts)

getPostHtml :: Post -> Html
getPostHtml post = 
    thediv 
        < < h2 << (pTitle post)
            p << (pBody post)

mkHeader :: String -> Html
mkHeader title = (header < < (thetitle << (title    " - HBlog")))

Once your HAppS application has state then wherever you run it it will create directories to store state information. If you change your state type, you must delete these directories (you will lose existing state of your app) to prevent errors like: *** Exception: user error (decodeStringM: parsing length field failed @ "").

Conclusion

So there you have a working blog publishing system in HAppS. It's more a proof of concept than a useable application. But hopefully it shows you how to create a simple application in HAppS without boiling your brain too much. There are zillions of improvements that could be made: add comments; make Posts a sequence and not a list; add error handling for empty fields; redirect to post display after creation; handle error when post id is greater than the number of posts; don't number posts starting from 0; allow deletion of posts; and many many others.

I must credit Eric Mertens for his sterling work on HPaste whose source code I read to make sense of much of what HAppS was doing.

Please do correct all my terrible misunderstandings and mistakes in the comments!