PostEntry.hs

module Pages.PostEntry (postEntryPage) where

import Control.Monad.Trans (liftIO)
import Happstack.Server    (Method(POST), ServerPart, Response, look, methodM, seeOther, toResponse)
import Happstack.State     (update)
import State.GuestBook     (AddGuestBookEntry(..))
import System.Time         (getClockTime)
import Types.GuestBook     (GuestBookEntry(..))

postEntryPage :: ServerPart Response
postEntryPage =
    do methodM POST -- only accept a post method
       author  <- look "author"  -- `mplus` (error "GuestBookEntry, need author")
       message <- look "message" --  `mplus` (error "GuesBookEntry, need message")
       email   <- look "email"   -- `mplus` (error "GuestBookEntry: need email")
       now <- liftIO getClockTime
       let entry = GuestBookEntry { author  = (if null author then "Anonymous" else author) 
                                  , message = message 
                                  , date    = now 
                                  , email   = email
                                  }
       update $ AddGuestBookEntry entry
       seeOther "/guestbook" (toResponse "/guestbook")