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 "". 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 "" 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.


Ram said…
AweSome Just in time for me.
Ram said…
I installed Happstack on Vista last week, this week i will write a simple local app. It would be great if you could shed some more light on how the State stuff works.
mightybyte said…
I'm not familiar with all the inner workings of the state system. But it hasn't been too hard to get a basic working knowledge of how to use it. If you're looking for low-level details talk to some of the other gurus in #happs.
@Ram: I've coincidentally been writing a bit about how State works on my blog -- this post on the basics of using Happstack.State might be what you're looking for. My next few posts will correct some flaws in that code; I'm basically writing about some things I learned from writing a toy app while I'm learning the ins and outs of Happstack myself.

Popular posts from this blog

Ember.js is driving me crazy

Dependent Types are a Runtime Maybe

Setting Up A Private Nix Cache