{-# OPTIONS_GHC -F -pgmF trhsx #-}
module FormPage where
import Control.Applicative
import Control.Monad.State
import HSPForm
import HSP
import Control.Applicative.Error
import HAppS.Server hiding (Web)
import HAppS.Template.HSP
import HAppS.Template.HSP.Handle
data Date = Date {month :: Integer, day :: Integer} deriving Show
validDate :: Date -> Bool
validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31]
dateComponent :: FailingForm Date
dateComponent = Date <$> inputIntegerF (Just 1) <*> inputIntegerF (Just 16)
dateFull :: FailingForm Date
dateFull = dateComponent `check` ensure validDate "This is not a valid date"
handleDate :: [ServerPartT (StateT HSPState IO) Response]
handleDate = withForm "date" dateFull (showErrorPage "FormPage.hs") (\d -> return (toResponse (show d)))
page :: Web XML
page =
do mErrs <- localRead "errors" :: Web (Maybe [ErrorMsg])
withMetaData html4Strict $
The Date
showErrorPage :: FilePath -> Env -> [ErrorMsg] -> WebT (StateT HSPState IO) Response
showErrorPage fp env errors =
do addParam "env" env
addParam "errors" (Just errors)
ok =<< execTemplate Nothing fp