[streamlined guestbook, split view hsp stuff into a separate module Matthew Elder **20090218083220 Ignore-this: 3cc77ba2ba2600e321eb436df616c131 ] hunk ./happstack/templates/project/guestbook.cabal 3 -Author: Jeremy Shaw , Matthew Elder hunk ./happstack/templates/project/src/AppControl.hs 2 -{-# OPTIONS_GHC -F -pgmFtrhsx #-} hunk ./happstack/templates/project/src/AppControl.hs 3 + +import AppState +import AppView hunk ./happstack/templates/project/src/AppControl.hs 14 -import AppState -import HSP -import System.Locale (defaultTimeLocale) -import System.Time (formatCalendarTime, getClockTime, toUTCTime) +import System.Time (getClockTime) hunk ./happstack/templates/project/src/AppControl.hs 16 --- for some reason I don't understand, appHandler --- is forced to be a concrete instance. It really wants --- to be a ServerPartT IO Response. Any attempt to generalize --- it further will fail -appHandler :: [ ServerPartT IO Response ] -appHandler = - [ dir "entries" $ msum [postEntry, getEntries] - , dir "public" $ fileServe ["index.html"] "public" - , seeOther "/entries" (toResponse ()) +appHandler :: ServerPartT IO Response +appHandler = msum + [ methodM GET >> seeOther "/entries" (toResponse ()) -- matches / + , dir "entries" $ msum[postEntry, getEntries] -- RESTful /entries + , fileServe ["index.html"] "public" -- static files hunk ./happstack/templates/project/src/AppControl.hs 23 -getEntries = methodM GET >> webHSP renderGuestBook --- --- only accept a post method for adding a new guestbook entry -postEntry = withData $ \e -> - do - methodM POST - now <- liftIO $ getClockTime - update (AddGuestBookEntry (e { date = now })) - seeOther "/" (toResponse ()) - +getEntries = methodM GET >> do + gb <- query ReadGuestBook + webHSP $ pageFromBody "Happstack Guestbook Example" gb + + +postEntry = methodM POST >> do -- only accept a post method + Just entry <- getData -- get the data + now <- liftIO getClockTime + update $ AddGuestBookEntry entry{date=now} + seeOther "/entries" (toResponse ()) hunk ./happstack/templates/project/src/AppControl.hs 41 --- rendering details for guestbook page -renderGuestBook :: HSP XML -renderGuestBook = do - gb <- liftIO $ query ReadGuestBook - pageFromBody "guestbook" gb - -instance (XMLGenerator m) => (EmbedAsChild m (GuestBookEntry, Bool)) where - asChild ((GuestBookEntry author message date), alt) = - <% -

- <% author %> said:

- <% map p (lines message) %> -
- <% dateStr date %> -

- %> - where - p str =

<% str %>

- dateStr ct = formatCalendarTime defaultTimeLocale "%a, %B %d, %Y at %H:%M:%S (UTC)" (toUTCTime ct) - -instance (XMLGenerator m) => (EmbedAsChild m GuestBook) where - asChild (GuestBook entries) = - <% -

Words of Wisdom

- <% zip entries (cycle [False,True]) %> - -

- %> - -pageFromBody :: (EmbedAsChild (HSPT' IO) xml) => String -> xml -> HSP XML -pageFromBody title body = - withMetaData html4Strict $ - - - <% title %> - - - - - - -

Happstack Guestbook

- Hey congrats! You're using - Happstack 0.1.9. - This is a guestbook example which you can freely change to your - whims and fancies. -

Leave a message for the next visitor here...

- -

- - <% body %> -

- - - - - hunk ./happstack/templates/project/src/AppLogger.hs 2 + hunk ./happstack/templates/project/src/AppLogger.hs 4 - (Priority(..) - ,updateGlobalLogger - ,setLevel - ,setHandlers) -import System.Log.Handler.Simple - (fileHandler) + ( Priority(..) + , updateGlobalLogger + , setLevel + , setHandlers + ) +import System.Log.Handler.Simple (fileHandler) hunk ./happstack/templates/project/src/AppLogger.hs 12 - h <- logHandler progName + h <- fileHandler (progName ++ ".log") DEBUG hunk ./happstack/templates/project/src/AppLogger.hs 16 -logHandler progName = fileHandler (progName ++ ".log") DEBUG - hunk ./happstack/templates/project/src/AppState.hs 8 -import Control.Monad.Reader - (ask) -import Control.Monad.State - (get - ,put) +import Control.Monad.Reader (ask) +import Control.Monad.State (get, put) hunk ./happstack/templates/project/src/AppState.hs 59 + addfile ./happstack/templates/project/src/AppView.hs hunk ./happstack/templates/project/src/AppView.hs 1 +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# OPTIONS_GHC -F -pgmFtrhsx #-} +module AppView where + +import AppState +import HSP +import System.Locale (defaultTimeLocale) +import System.Time (formatCalendarTime, toUTCTime) + +instance (XMLGenerator m) => (EmbedAsChild m (GuestBookEntry, Bool)) where + asChild ((GuestBookEntry author message date), alt) = + <% +

+ <% author %> said:

+ <% map p (lines message) %> +
+ <% dateStr date %> +

+ %> + where + p str =

<% str %>

+ dateStr ct = formatCalendarTime defaultTimeLocale "%a, %B %d, %Y at %H:%M:%S (UTC)" (toUTCTime ct) + +instance (XMLGenerator m) => (EmbedAsChild m GuestBook) where + asChild (GuestBook entries) = + <% +

Words of Wisdom

+ <% zip entries (cycle [False,True]) %> + +

+ %> + +pageFromBody :: (EmbedAsChild (HSPT' IO) xml) => String -> xml -> HSP XML +pageFromBody title body = + withMetaData html4Strict $ + + + <% title %> + + + + + + +

Happstack Guestbook

+ Hey congrats! You're using + Happstack 0.1.9. + This is a guestbook example which you can freely change to your + whims and fancies. +

Leave a message for the next visitor here...

+ +

+ + <% body %> +

+ + + + + hunk ./happstack/templates/project/src/Main.hs 2 -import Control.Concurrent - ( forkIO - , killThread - , MVar - ) -import Control.Monad - (msum) -import Happstack.Util.Cron - (cron) -import Happstack.State - (waitForTermination) + +import Control.Concurrent (MVar(..), forkIO, killThread) +import Happstack.Util.Cron (cron) +import Happstack.State (waitForTermination) hunk ./happstack/templates/project/src/Main.hs 11 - , wdgHTMLValidator) + , wdgHTMLValidator + ) hunk ./happstack/templates/project/src/Main.hs 23 -import System.Environment(getArgs, getProgName) -import System.Log.Logger -import System.Exit -import System.Console.GetOpt -import AppLogger - (setupLogger) -import AppState - (AppState(..)) -import AppControl - (appHandler) +import System.Environment (getArgs, getProgName) +import System.Log.Logger (Priority(..), logM) +import System.Exit (exitFailure) +import System.Console.GetOpt +import AppLogger (setupLogger) +import AppState (AppState(..)) +import AppControl (appHandler) hunk ./happstack/templates/project/src/Main.hs 34 -main :: IO () hunk ./happstack/templates/project/src/Main.hs 35 - progName <- getProgName + -- progname effects where state is stored and what the logfile is named + let progName = "guestbook" + hunk ./happstack/templates/project/src/Main.hs 39 - hunk ./happstack/templates/project/src/Main.hs 44 - (Right f) -> return (f (defaultConf progName)) + (Right f) -> return (f $ defaultConf progName) hunk ./happstack/templates/project/src/Main.hs 50 - httpTid <- forkIO $ simpleHTTP (httpConf appConf) $ msum appHandler + httpTid <- forkIO $ simpleHTTP (httpConf appConf) appHandler hunk ./happstack/templates/project/src/Main.hs 95 +

Words of Wisdom

Links

Happstack Guestbook

Words of Wisdom

Links

Happstack Guestbook