{-# 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.Reader (MonadReader(..), ReaderT(..)) import Control.Monad.Trans(MonadIO(liftIO)) import Data.List (sort) import Data.Set (Set, fromList, insert) import Happstack.Server as H (Browsing(DisableBrowsing), Conf(port), Method(GET), Response, ServerPartT, asContentType, dir, serveDirectory, mapServerPartT, methodM, nullConf, ok, nullDir, seeOther, serveFile, simpleHTTP, toResponse) import Happstack.Server.SimpleHTTP (waitForTermination) import Happstack.Server.HSP.HTML () import HSP.Google.Analytics(UACCT(UACCT), analytics) import HSP import HSP.ServerPartT () import Network.IRC () import Network.IRC.Bot (BotMonad) import Network.IRC.Bot.Core as B (User(..), BotConf(..), simpleBot, nullBotConf) import Network.IRC.Bot.Part.Channels ( initChannelsPart ) import Network.IRC.Bot.Part.Dice ( dicePart ) import Network.IRC.Bot.Part.Hello ( helloPart ) import Network.IRC.Bot.Part.NickUser ( nickUserPart ) import Network.IRC.Bot.Part.Ping ( pingPart ) import Network.IRC.Bot.Log ( nullLogger ) import Network.IRC.Bot.PosixLogger ( posixLogger ) 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 progName <- getProgName #ifdef __CABAL__ dd <- getDataDir let defaultConf' = (defaultConf progName) { dataDir = dd } #else let defaultConf' = defaultConf progName #endif -- parse the command-line options 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 do let botConf = nullBotConf { channelLogger = Just $ posixLogger (Just $ ircLogDir appConf) "#happs" , B.logger = nullLogger , host = "irc.freenode.net" , B.port = (PortNumber 6667) , nick = ircNick appConf , user = User { username = ircNick appConf , hostname = "happstack.com" , servername = "irc.freenode.net" , realname = "happstack.com bot" } , channels = ircChans appConf } ircParts <- initIrcParts (channels botConf) simpleBot botConf ircParts else return [] let themeDir = (dataDir appConf) "theme" httpTid <- forkIO $ simpleHTTP (httpConf appConf) (impl appConf themeDir (docDir appConf) (ircLogDir appConf)) waitForTermination killThread httpTid mapM_ killThread ircTids impl :: AppConf -> FilePath -> FilePath -> FilePath -> ServerPartT IO Response impl appConf themeDir docDir ircLogDir = mapServerPartT (flip runReaderT appConf) $ 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 , baseURI :: String , store :: FilePath , dataDir :: FilePath , docDir :: FilePath , ircLogDir :: FilePath , logDir :: FilePath , logMode :: LogMode , ircBot :: Bool , ircNick :: String , ircChans :: Set String , uacct :: Maybe UACCT } defaultConf :: String -> AppConf defaultConf progName = AppConf { httpConf = nullConf , baseURI = "/" , store = "_local/" ++ progName ++ "_state" , dataDir = "" , docDir = "docs" , ircLogDir = "irc-logs" , logDir = "logs" , logMode = Development , ircBot = False , ircNick = "synthea" , ircChans = fromList ["#happs"] , uacct = Nothing } 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) {H.port = read h} }) "port") "port to bind http server" , Option [] ["base-uri"] (ReqArg (\h c -> c {baseURI = h}) "uri") "http://servername:/" , Option [] ["store"] (ReqArg (\h c -> c {store = h}) "PATH") "The directory used for database storage." , Option [] ["static"] (ReqArg (\h c -> c { dataDir = h}) "PATH") "The directory which contains the data files." , Option [] ["data-dir"] (ReqArg (\h c -> c { dataDir = h}) "PATH") "Alias for --static." , 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") "Alias for --logs" , Option [] ["logs"] (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 { ircChans = insert h (ircChans c) }) "#chan") "The channel to log on irc." , Option [] ["irc-bot"] (NoArg (\c -> c { ircBot = True})) "Run the irc logging bot." , Option [] ["enable-analytics"] (NoArg (\c -> c { uacct = Just (UACCT "UA-7111625-1") })) "Enable google analytics tracking." ] 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] , MonadReader AppConf m ) => String -> headers -> PageSection -> body -> XMLGenT m (HSX.XML m) appTemplate title headers pagesection body = <% title %> <% headers %> <% top pagesection %> <% body %> <% footer %> <% do appConf <- ask case (uacct appConf) of Nothing -> return [] (Just u) -> analytics u %> 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 =
{- oldHomeContent :: (XMLGenerator m) => XMLGenT m (HSX.XML m) oldHomeContent =

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:

Integration
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.
Innovation
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.
Documentation
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.

Type-Safety

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

-} homeContent :: (XMLGenerator m) => XMLGenT m (HSX.XML m) homeContent =

News (via Twitter)

<% twitter %>

Follow us on Twitter

What is Happstack?

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

happstack-server

At the core of Happstack is happstack-server. happstack-server is a fast and simple HTTP server with built-in support for templating (via blaze-html), request routing, form-decoding, cookies, file-uploads, etc. happstack-server is all you need to create a simple website.

happstack-server is database agnostic and can be used with any of your favorite database libraries from hackage. happstack-server is extensively documented in The Happstack Crashcourse.

happstack-lite

happstack-lite is a streamlined version of Happstack designed to make it quick and easy to start developing web applications. For more information check out the happstack-lite tutorial.

Extensions

Happstack provides a wide range of extensions including:

acid-state
acid-state is a native Haskell, in-memory, transactional ACID, noSQL database. acid-state is a cleaner, faster, and more robust rewrite of the classic happstack-state system. It can easily store complex Haskell datatypes, queries are written in Haskell, and it uses safecopy for automatic version migration.
ixset
ixset is a set-like datatype with support for multiple indexes. It is similar to a table in a traditional SQL database. ixset is often used with the acid-state library.
happstack-plugins
happstack-plugins provides on-the-fly recompilation and dynamic loading of code into running servers. This is especially useful for reloading compiled HTML templates (such as blaze-html). Check out a demonstration here.
jmacro
jmacro is a Javascript templating library. It supports splicing Haskell values into Javascript, static syntax checking, hygienic naming, and more. Documentation on using it with Happstack can be found here.
happstack-hsp
happstack-hsp leverages the HSX and HSP libraries to provide powerful XML and HTML templates. HSX allows literal XML markup to be embedded in Haskell code. This means that you have the full power of Haskell at your disposal in your templates, not some weak, limited templating language.
happstack-heist
happstack-heist brings the power of heist templates to Happstack. heist aims to keep the presentation and business logic well separated. Because heist uses external .xml files for the templates, the templates can be easily edited by non-programmers and modifications do not require the server to be recompiled or restarted. Using heist with Happstack is documented here.
happstack-hamlet
happstack-hamlet brings hamlet templates to Happstack.
happstack-hstringtemplate
happstack-hstringtemplate allows the use of templates which are similar to the Java StringTemplate engine.
web-routes
web-routes is a family of libraries which provide type-safe URL routing. URLs can be mapped to types and back via a number of methods including invertible-syntax descriptions, parsec, template-haskell, quasi-quotation, and more. Documenation can be found here.
digestive-functors
The digestive-functors library provides type-safe, composable HTML form generation and processing. The digestive-functors-happstack library provides Happstack support. The digestive-functors-hsp library includes combinators for using digestive-functors with HSP templates.
happstack-authenticate
happstack-authenticate is a high-level authentication library for Happstack built on top of the authenticate library. It provides support for authentication via OpenId, Facebook, or a username/password. It includes support for multiple authentication methods per account, as well as multiple personalities per account. It includes themeable templates that can easily be integrated into your site.
Other
Happstack can also be used with a wide variety of packages on hackage with no special support. You can use database libraries like, HDBC, Takusen, CouchDB, etc. You can use libraries like aeson for JSON support. Happstack is designed to be open and flexible.

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-server

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

Next, head over to the Happstack Crash Course and start hacking!

home :: (XMLGenerator m, EmbedAsChild m [HSX.XML m], EmbedAsChild m (), MonadReader AppConf 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 (), MonadReader AppConf 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], MonadReader AppConf m) => XMLGenT m (HSX.XML m) docs = appTemplate "Happstack - Documentation" () Docs $ mainContent $

Documentation

Official Documentation & Tutorials

Happstack Lite Tutorial
happstack-lite is a great starting point for new Happstack developers. Check out this short tutorial.
Happstack Crash Course
The Happstack Crash Course is the most complete resource for learning Happstack. New sections are added regularly, so check back often.
Haddock API Reference
The haddock API documentation for Happstack can be found here.

Examples

Guestbook Demo

The guestbook demo, included with Happstack, is a complete, cabalized web application which demonstrates using 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:

$ export PATH=~/.cabal/bin:$PATH
$ cabal update
$ cabal install happstack
$ happstack new project guestbook
$ cd guestbook
happstack-imageboard

happstack-imageboard implements a simple 4chan-like imageboard. It demonstrates acid-state, ixset, digestive-functors, HSX, jmacro, web-routes, cookies, AJAX, uploads, image resizing, and more. It is available via:

darcs get http://src.seereason.com/examples/happstack-imageboard/

3rd Party Tutorials & Examples

Short tutorial on Happstack.State / MACID
Happstack.State - the basics by Paul Kuliniewicz
Tutorialpedia web-routes
Happstack type-safe routing and URLs using web-routes and the Regular library
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], MonadReader AppConf m) => XMLGenT m (HSX.XML m) community = appTemplate "Happstack - Community" () Community $ mainContent $

Community

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.

stackoverflow

You can also post questions on stackoverflow with the happstack tag.

IRC

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, MonadReader AppConf 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 $ initIrcParts :: (BotMonad m) => Set String -- ^ set of channels to join -> IO [m ()] initIrcParts chans = do (_, channelsPart) <- initChannelsPart chans return [ pingPart , nickUserPart , channelsPart , dicePart , helloPart ]