{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} module GuestBook.Control where import Control.Applicative((<$>)) import Control.Monad(msum) import Control.Monad.Trans(liftIO) import Data.ByteString.Lazy.UTF8 (toString) import GuestBook.State2 (GuestBookEntry(..),AddGuestBookEntry(..),ReadGuestBook(..)) import GuestBook.View import Happstack.Server import Happstack.Data(defaultValue) import Happstack.State(query,update) import HSP import System.Time(getClockTime) import Control.Monad guestBookHandler :: ServerPartT IO (HSP XML) guestBookHandler = dir "entries" $ msum [postEntry, getEntries] -- RESTful /entries postEntry :: ServerPartT IO (HSP XML) postEntry = methodM POST >> do -- only accept a post method mbEntry <- getData -- get the data case mbEntry of Nothing -> error $ "error: postEntry" Just entry -> do now <- liftIO getClockTime update $ AddGuestBookEntry entry{date=now} seeOther "/entries" (seeOtherXML "/entries") -- |show all the entries in the guestbook -- argument is a callback function getEntries :: ServerPartT IO (HSP XML) getEntries = methodM GET >> do gb <- query ReadGuestBook ok $