Basic Happstack Blog App

Happstack is improving, and my old blog posts on HAppS are now out of date. So we're in need of a bare-bones app to demonstrate functionality. I also wanted a simple app without authentication capability to demonstrate how to integrate Happstack-Auth into a project. Blog apps seem to be one of the canonical beginner's examples in the web framework world, so I thought that would be a good choice to start with. As usual, this post is literate haskell and should compile as Main.lhs.

> {-# OPTIONS -fglasgow-exts #-}
> {-# LANGUAGE TemplateHaskell , FlexibleInstances,
>              FlexibleContexts, UndecidableInstances, OverlappingInstances,
>              MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
> 
> module Main where
> 
> import Control.Concurrent
> import Control.Monad
> import Control.Monad.Reader
> import Control.Monad.State (modify,put,get,gets,MonadState)
> import Data.Generics hiding ((:+:))
> import Happstack.Server
> import Happstack.State

First, we define a blog post. A post has a title and a body, both of type String. The deriving clause is required by the Happstack state mechanism. The Ord instance isn't actually required for this example, but it is required if you want to build an IxSet from this data type, so I'm in the habit of including it.

> data Post = Post {
>   postTitle :: String,
>   postBody :: String
> } deriving (Read,Show,Ord,Eq,Typeable,Data)

Our top level blog state will be a simple list of posts.

> data BlogState = BlogState {
>   postDB :: [Post]
> } deriving (Read,Show,Ord,Eq,Typeable,Data)

These are the standard Version and Serialize instances needed by Happstack's state mechanism. I won't go into detail about them here. Jeremy Shaw has a nice post describing them in much more detail.

> instance Version Post
> $(deriveSerialize ''Post)
> instance Version BlogState
> $(deriveSerialize ''BlogState)

Our state has to be an instance of component. We have no dependencies and our state's initial value is a simple empty list.

> instance Component BlogState where
>   type Dependencies BlogState = End
>   initialValue = BlogState []

Now we need some accessor functions. For now we'll keep it simple with a function to add a post, and one to get the list of all posts.

> addPost :: (MonadState BlogState m) => Post -> m ()
> addPost p = modify $ (\s -> BlogState $ p:(postDB s))
>
> getPosts :: (MonadReader BlogState m) => m [Post]
> getPosts = asks postDB

Now the required Template Haskell voodoo to build these methods for us.

   
> $(mkMethods ''BlogState ['addPost, 'getPosts])

Before we go further I want to add a little infrastructure code that will simplify things later. It's a simple function that redirects the client to the specified URL.

> redir url = seeOther url (toResponse "")

New we define the layout of our site. We have one URL at "http://site.com/new". A GET request to this url returns a static HTML file containing a new post form. The form POSTS the results to the same URL, so we have to define a function to handle this request. The last "methodSP GET" matches the root URL "http://site.com/" and will just display the list of posts.

> impl = msum
>   [ dir "new" newPostHandlers 
>   , methodSP GET viewPostsHandler
>   ]
>
> newPostHandlers = msum [methodSP GET $ fileServe ["new_post.html"] "."
>                        ,methodSP POST addPostHandler]

The msum in newPostHandlers is new as of Happstack 0.2. In prior versions, some functions required or returned data of type ServerPartT, and some used [ServerPartT]. Other functions required WebT data. In Happstack 0.2, everything was unified to work around a single ServerPartT. If you have an abstraction that needs several ServerPartTs, you usually want to collapse them using msum. Our new post handler gets POSTed values from the HTTP request, constructs a Post, passes that to AddPost, and redirects to the root.

> addPostHandler = do
>   (Just title) <- getDataFn $ look "title"
>   (Just body) <- getDataFn $ look "body"
>   update $ AddPost (Post title body)
>   redir "/"

The view posts handler queries the GetPosts action for the list of posts. If the list is empty, it returns a simple message, otherwise it returns the posts as a string. toResponse converts strings into responses with a content type of text/plain. Generating proper HTML pages is not hard, but is beyond the scope of this example.

> viewPostsHandler = do
>   posts <- query $ GetPosts
>   case posts of
>     [] -> ok $ toResponse "No posts yet"
>     otherwise -> ok $ toResponse $ unlines $ map show posts

The rest of the code is standard infrastructure for a Happstack application. The only thing we have to do is declare an entry point with our state Component and pass it to startSystemState. Then we pass our previously defined impl function to simpleHTTP and we're done. A clean, working Happstack application in 75 lines of code.

> entryPoint :: Proxy BlogState
> entryPoint = Proxy
> 
> main = do 
>   control <- startSystemState entryPoint
>   tid <- forkIO $ simpleHTTP nullConf impl
>   waitForTermination
>   putStrLn "Shutting down..."
>   killThread tid
>   shutdownSystem control
>   putStrLn "Shutdown complete"

The code for this app is available in the Happstack-Auth github repository in the demos/Blog-NoAuth directory. In the next post I will show how to add authentication to this app using the auth framework I mentioned in the last post.