{-# 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
<% maybe (
) (\errs ->

<% errs %>

) mErrs %>

<% dateFull %>

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