{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} module Main where import Control.Applicative ((<$>)) import Control.Concurrent (forkIO, killThread) import Control.Monad (msum) import Control.Monad.Trans(MonadIO(liftIO)) import Data.List (sort) import Happstack.Server (Browsing(DisableBrowsing), Conf(port), Method(GET), Response, ServerPartT, asContentType, dir, serveDirectory, methodM, nullConf, ok, nullDir, seeOther, serveFile, simpleHTTP, toResponse) import Happstack.Server.HSP.HTML () import Happstack.State (waitForTermination) import HSP.Google.Analytics(UACCT(UACCT), analytics) import HSP import HSP.ServerPartT () import IrcLog import qualified HSX.XMLGenerator as HSX import Network(PortID(PortNumber)) import System.Console.GetOpt (ArgDescr(NoArg, ReqArg), ArgOrder(Permute), OptDescr(Option), getOpt) import System.Directory (createDirectoryIfMissing, getDirectoryContents) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.FilePath import System.IO (stdout) import System.Log.Logger (Priority(DEBUG, INFO, ERROR), logM, rootLoggerName, setHandlers, setLevel, updateGlobalLogger) import System.Log.Handler.Simple (fileHandler, streamHandler) #ifdef __CABAL__ import Paths_happstackDotCom (getDataDir) #endif main :: IO () main = do #ifdef __CABAL__ dd <- getDataDir let defaultConf' = defaultConf { dataDir = dd } #else let defaultConf' = defaultConf #endif -- parse the command-line options progName <- getProgName args <- getArgs appConf <- case parseConfig args of (Left e) -> do logM progName ERROR (unlines e) exitFailure (Right f) -> return (f defaultConf') -- create log directory if missing createDirectoryIfMissing True (logDir appConf) -- setup the log files setupLogger progName (logDir appConf) (logMode appConf) -- start IRC bot ircTids <- if (ircBot appConf) then ircLog (ircLogDir appConf) "irc.freenode.net" (PortNumber 6667) (ircNick appConf) (User (ircNick appConf) "happstack.com" "irc.freenode.net" "happstack.com bot") (ircChan appConf) else return [] let themeDir = (dataDir appConf) "theme" httpTid <- forkIO $ simpleHTTP (httpConf appConf) (impl themeDir (docDir appConf) (ircLogDir appConf)) waitForTermination killThread httpTid mapM_ killThread ircTids impl :: FilePath -> FilePath -> FilePath -> ServerPartT IO Response impl themeDir docDir ircLogDir = msum [ dir "favicon.ico" $ serveFile (asContentType "http://image/vnd.microsoft.icon") (themeDir "favicon.ico") , dir "theme" $ serveDirectory DisableBrowsing [] themeDir , dir "irc-logs" $ msum [ do methodM GET ; (ok . toResponse) =<< (unXMLGenT $ ircLogs ircLogDir) , serveDirectory DisableBrowsing [] ircLogDir ] , dir "index.html" $ (ok . toResponse) =<< (unXMLGenT home) , dir "download" $ (ok . toResponse) =<< (unXMLGenT download) , dir "docs" $ msum [ do { nullDir ; (ok . toResponse) =<< (unXMLGenT docs) } , dir "crashcourse" $ serveDirectory DisableBrowsing [] "/home/jeremy/public_html/happstack-crashcourse" , serveDirectory DisableBrowsing [] docDir ] , dir "community" $ (ok . toResponse) =<< (unXMLGenT community) , methodM GET >> seeOther "/index.html" (toResponse "index.html") ] data AppConf = AppConf { httpConf :: Conf , dataDir :: FilePath , docDir :: FilePath , ircLogDir :: FilePath , logDir :: FilePath , logMode :: LogMode , ircBot :: Bool , ircNick :: String , ircChan :: String } defaultConf :: AppConf defaultConf = AppConf { httpConf = nullConf , dataDir = "" , docDir = "docs" , ircLogDir = "irc-logs" , logDir = "logs" , logMode = Development , ircBot = False , ircNick = "synthea" , ircChan = "#happs" } data LogMode = Production | Development deriving (Read, Show, Eq, Ord, Enum, Bounded) setupLogger :: String -> FilePath -> LogMode -> IO () setupLogger progName logDir logMode = do appLog <- fileHandler (logDir (progName ++ "_root.log")) DEBUG accessLog <- fileHandler (logDir (progName ++ "_access.log")) INFO stdoutLog <- streamHandler stdout DEBUG case logMode of Development -> do -- Root Log updateGlobalLogger rootLoggerName (setLevel DEBUG . setHandlers [appLog, stdoutLog]) -- Access Log updateGlobalLogger "Happstack.Server.AccessLog.Combined" (setLevel INFO . setHandlers [accessLog]) Production -> do -- Root Log updateGlobalLogger rootLoggerName (setLevel INFO . setHandlers [appLog]) -- Access Log updateGlobalLogger "Happstack.Server.AccessLog.Combined" (setLevel INFO . setHandlers [accessLog]) opts :: [OptDescr (AppConf -> AppConf)] opts = [ Option [] ["http-port"] (ReqArg (\h c -> c { httpConf = (httpConf c) {port = read h} }) "port") "port to bind http server" , Option [] ["data-dir"] (ReqArg (\h c -> c { dataDir = h}) "PATH") "The directory which contains the data files." , Option [] ["doc-dir"] (ReqArg (\h c -> c { docDir = h}) "PATH") "The directory which contains the haddock documentation files." , Option [] ["irc-log-dir"] (ReqArg (\h c -> c { ircLogDir = h}) "PATH") "The directory which contains the irc log files." , Option [] ["log-dir"] (ReqArg (\h c -> c { logDir = h}) "PATH") "The directory to store server log files in." , Option [] ["log-mode"] (ReqArg (\h c -> c { logMode = read h}) (show ([minBound .. maxBound] :: [LogMode]))) "The logging mode to use" , Option [] ["irc-nick"] (ReqArg (\h c -> c { ircNick = h}) "nick") "The nick to use on irc." , Option [] ["irc-chan"] (ReqArg (\h c -> c { ircChan = h}) "#chan") "The channel to log on irc." , Option [] ["irc-bot"] (NoArg (\c -> c { ircBot = True})) "Run the irc logging bot." ] parseConfig :: [String] -> Either [String] (AppConf -> AppConf) parseConfig args = case getOpt Permute opts args of (flags,_,[]) -> Right $ \appConf -> foldr ($) appConf flags (_,_,errs) -> Left errs data PageSection = Home | Download | Docs | Community | Other deriving (Eq, Ord, Show, Read) appTemplate :: ( XMLGenerator m , EmbedAsChild m String , EmbedAsChild m () , EmbedAsChild m headers , EmbedAsChild m body , EmbedAsChild m [HSX.XML m] ) => String -> headers -> PageSection -> body -> XMLGenT m (HSX.XML m) appTemplate title headers pagesection body = <% title %> <% headers %> <% top pagesection %> <% body %> <% footer %> <% analytics (UACCT "UA-7111625-1") %> top :: (XMLGenerator m) => PageSection -> XMLGenT m (HSX.XML m) top pageSection =
footer :: (XMLGenerator m) => XMLGenT m (HSX.XML m) footer = sidebar :: (XMLGenerator m) => XMLGenT m (HSX.XML m) sidebar = twitter :: (XMLGenerator m) => XMLGenT m (HSX.XML m) twitter =
homeContent :: (XMLGenerator m) => XMLGenT m (HSX.XML m) homeContent =

What is Happstack?

Happstack is a Haskell web framework. Happstack is designed so that developers can prototype quickly, deploy painlessly, scale massively, operate reliably, and change easily. It supports GNU/Linux, OS X, FreeBSD, and Windows environments.

The Happstack project focuses on three areas of development:

Happstack leverages many of the existing high quality libraries available on Hackage. Through integration, Happstack has support for many templating libraries, database libraries, and more.
acid-state (a Haskell-based, noSQL RAM cloud), ixset (a Set type which supports multiple indexes), and web-routes (type-safe url routing), all began as Happstack projects. They are available, however, for use with any framework, not just Happstack.
There are three layers of documentation.
  1. API documentation - good haddock documentation with examples for the whole API.
  2. API tutorials - good haddock documentation is essential, but not sufficient. In order to learn a new API, you need a guide that shows you where to get started, explains the big picture, and shows you how to handle specific tasks. The Happstack Crashcourse is a growing tutorial which shows you how to develop web applications using Happstack. It includes many small, self-contained and thoroughly explained examples which you can download and run.
  3. High-level design - Using great libraries does not guarantee success anymore than using great ingredients guarantees a delicious cake. There are many important design decisions that must be made along the way. Each website is grows differently and has different requirements. So, the next level of documentation will discuss various design ideologies, practices, and how to implement them using Happstack. This will include topics like content and presentation layer separation, REST, MVC-style design, data partitioning, staging and deployment, etc.

Some Happstack Technologies

RAM Cloud Database Architecture

Happstack favors the use of acid-state, a RAM cloud database architecture. acid-state provides you the speed and predictability of RAM based queries combined with the durability, replication, and ACID properties of traditional databases. This architecture provides you with fast, predictable query times with out the uncertainly of cache misses. It simplifies your development because it is built around Haskell datatypes and functions. This means you do not need to learn a specialized query language. You also do not have to worry about database denormalization, data marshaling, SQL-injection attacks, etc. Nor do you have to worry about installing, tuning, configuring, and upgrading a caching layer such as memcached or database servers.

Happstack can also be used with existing databases such as MySQL, Postgres, Cassandra, CouchDB, etc. if that better suits your needs.

Integrated HTTP Server

Happstack includes an fast, secure, integrated HTTP server. This means you do not need to install, maintain, and configure a separate HTTP server such as Apache. Because the server is integrated into your application, you also have opportunity for your application to automatic adjust and tune the parameters at run-time.

Flexible Routing and Request Processing DSL

Happstack provides a flexible system for mapping URIs to handlers, processing the QUERY_STRING and request body, and generating responses.

Flexible Templating Options

Happstack does not force you to use any particular templating or HTML generation solution. Each organization and project has different needs and a one size fits all approach can not satisfy everyone. Instead Happstack provides integration with a variety of templating solutions to meet different needs. This includies HSP, HStringTemplate, hamlet, heist, BlazeHTML and more! It is easy to add additional 3rd party or custom options as well. A discussion of options can be found here.


Happstack includes a number of optional features which can increase the type safety of your web application. This means greater assurance that your site is free from broken URLs, SQL and javascript injection attacks, missing form fields, etc. This includes technology such as web-routes for type-safe URL routing and digestive-functors for type-safe form processing.

Getting Started

The fastest way to get started is to install happstack from hackage using cabal.

$ export PATH=~/.cabal/bin:$PATH
$ cabal update
$ cabal install happstack

Simple App

Here is a simple app to test out your installation. The application will run on port 8000 by default. If you are reading this website on the same machine you are running the app on, just click here to see it.

module Main where

import Happstack.Server

main = simpleHTTP nullConf $ ok "Hello, World!"

home :: (XMLGenerator m, EmbedAsChild m [HSX.XML m], EmbedAsChild m ()) => XMLGenT m (HSX.XML m) home = appTemplate "Happstack - A Haskell Web Framework" () Home $ mainContent homeContent download :: (XMLGenerator m, EmbedAsChild m [HSX.XML m], EmbedAsChild m ()) => XMLGenT m (HSX.XML m) download = appTemplate "Happstack - Download" () Download $ mainContent $

How to get Happstack

cabal install happstack

The easiest way to get happstack is to just install it from hackage using the cabal command.

$ export PATH=~/.cabal/bin:$PATH
$ cabal update
$ cabal install happstack

Getting the development version of the source code

You can get and install the latest development source using darcs.

$ cabal update
$ darcs get http://patch-tag.com/r/mae/happstack
$ cd happstack
$ chmod +x bin/build-install-all.sh
$ ./bin/build-install-all.sh

After you have checked out the code, you can get further updates by running:

$ darcs pull

To submit a patch run:

$ darcs record
$ darcs send

Note that darcs send assumes you have a working sendmail installed. Another option is to write the patches to a file and then manually attach the patches to an email message. You should send the patches to our mailing list.

$ darcs record
$ darcs send -o descriptive_name.dpatch

Browse the source code online

You can browse the source code online by visiting our project on patch-tag.com.

docs :: (XMLGenerator m, EmbedAsChild m (), EmbedAsChild m [HSX.XML m]) => XMLGenT m (HSX.XML m) docs = appTemplate "Happstack - Documentation" () Docs $ mainContent $


API Reference

The haddock documentation for Happstack can be found here.


Happstack Crash Course

The Happstack Crash Course is the most complete resource for learning Happstack. New sections are added regularly, so check back often.


Classic Happstack Tutorial

The classic happstack tutorial is also still available. This is currently the best resource to learn about using the MACID state system and HStringTemplate. Soon to be replaced by the Happstack Crash Course.


Short tutorial on Happstack.State / MACID

Happstack.State - the basics by Paul Kuliniewicz

Happstack & web-routes

Crash course section of web-routes

Happstack type-safe routing and URLs using web-routes and the Regular library

Guestbook Demo

The guestbook demo, included with happstack, is a complete, cabalized web application which demonstrates the Happstack MACID database, HSP templating, and HStringTemplate. There is currently no separate tutorial, but the code is heavily commented for instructive purposes.

You can browse the source code for the guestbook demo here.

To get a local copy you can play with do:

$ happstack new project guestbook
$ cd guestbook

NOTE: the command may issue a bunch of errors about getDirectoryContents, but it still works. Those errors are fixed darcs.

Build a pasteboard with Happstack

This tutorial demonstrates building a simple pasteboard application by using Happstack with sqlite and Text.Html.

community :: (XMLGenerator m, EmbedAsChild m (), EmbedAsChild m [HSX.XML m]) => XMLGenT m (HSX.XML m) community = appTemplate "Happstack - Community" () Community $ mainContent $


Happstack is a open community. We encourage you to participate in making Happstack a better project. Right now we are focused on making Happstack more accessible to newcomers. If you think something is confusing, let us know!

There are many ways to interact with the Happstack community.

Mailing List

Join our mailing list to ask questions, suggest changes and improvements, or just keep an eye on things.


Join us on #happs on irc.freenode.net. If someone does not answer your question right away, hang around and someone probably will. You can also browse the irc logs here.

Bug Reports

Found a bug? Got a feature suggestion? In addition to the mailing list and irc channel, you might consider submitting a bug report.

Happstack Wiki

We also have a wiki: Happstack Wiki.

Follow us on Twitter

When the mailing list is quiet, it may sometimes feel like nothing is happening. Get bite sized updates about what is going on with Happstack on a near daily basis by following us on twitter. http://www.twitter.com/happstack

Find us on Facebook

If you haven't deactivated your Facebook account you can also follow us on Facebook http://www.facebook.com/happstack

mainContent :: (XMLGenerator m, EmbedAsChild m c ) => c -> XMLGenT m (HSX.XML m) mainContent c =
<% sidebar %>
<% c %>
ircLogs :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m [HSX.XML m], EmbedAsChild m (), MonadIO m) => FilePath -> XMLGenT m (HSX.XML m) ircLogs ircLogDir = do logFiles <- liftIO $ (reverse . sort . filter ((\ext -> (ext == ".html") || (ext == ".txt")) . takeExtension)) <$> getDirectoryContents ircLogDir appTemplate "Happstack - IRC Logs" () Other $ mainContent $