hunk ./FormPage.hs 5 +import Control.Monad.State hunk ./FormPage.hs 11 +import HAppS.Template.HSP.Handle hunk ./FormPage.hs 18 - hunk ./FormPage.hs 24 --- handleDate :: Web XML -handleDate = withForm "date" dateFull showErrorsInline (\d -> return (toResponse (show d))) +handleDate :: [ServerPartT (StateT HSPState IO) Response] +handleDate = withForm "date" dateFull (showErrorPage "FormPage.hs") (\d -> return (toResponse (show d))) hunk ./FormPage.hs 28 -page = withMetaData html4Strict $ - - - The Date - - -
-

<% dateFull %> -

-
- - - - --- showErrorsInline :: [XML] -> [ErrorMsg] -> Web Response --- showErrorsInline :: (Monad m) => [XML] -> [ErrorMsg] -> m Response -showErrorsInline renderedForm errors = - do - return (toResponse (Nothing :: Maybe XMLMetaData, element "html" [] renderedForm)) - +page = + do mErrs <- localRead "errors" :: Web (Maybe [ErrorMsg]) + withMetaData html4Strict $ + + + The Date + + +
+ <% maybe (
) (\errs ->

<% errs %>

) mErrs %> +

<% dateFull %> +

+ + + hunk ./FormPage.hs 44 +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 hunk ./HSPForm.hs 24 + hunk ./HSPForm.hs 50 --- newtype MyForm a = MyForm ((Reader Env :+: State FormState) (Collector a, [XML])) - --- type F = Reader :+: State - hunk ./HSPForm.hs 66 --- check that this instance is valid (ie, follows the laws) -instance Monad Form where - return = pure - (Form f) >>= g = Form $ \env -> - do (c1,xml1) <- f env - let (Form g') = g (c1 env) - (c2,xml2) <- g' env - return (c2, xml1 ++ xml2) - hunk ./HSPForm.hs 147 - hunk ./HSPForm.hs 170 -testForm :: Web XML -testForm = -
- <% inputF (Just "1") `check` asInteger %> -
- hunk ./HSPForm.hs 175 - - - -test :: IO () -test = - do (xmd, xml) <- evalHSP (runWebXML (WebState { queryGlobal = undefined, queryLocal = Map.fromList [("env", toJson [("input_0", "bork brok brok")])] }) testForm) Nothing - putStrLn (renderAsHTML xml) - - --- handleDate :: [ServerPart Response] --- handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d) - --- main = simpleHTTP (nullConf {port = 5000}) handleDate - -{- -withForm :: String -> FailingForm a -> ([XML] -> [String] -> Web Response) -> (a -> Web Response) -> [ServerPart Response] - hunk ./HSPForm.hs 176 - -> FailingForm a - -> ([XML] -> [ErrorMsg] -> WebT (StateT HSPState IO) Response) - -> (a -> WebT (StateT HSPState IO) Responsepp) - -> [ServerPartT (StateT HSPState IO) Response] --} -withForm :: (ToMessage a1) => - String - -> FailingForm a - -> ([XML] -> [ErrorMsg] -> WebT (StateT HSPState IO) a1) - -> (a -> WebT (StateT HSPState IO) a1) - -> [ServerPartT (StateT HSPState IO) Response] + -> FailingForm a + -> (Env -> [ErrorMsg] -> WebT (StateT HSPState IO) Response) + -> (a -> WebT (StateT HSPState IO) Response) + -> [ServerPartT (StateT HSPState IO) Response] hunk ./HSPForm.hs 181 - [ dir name + [ dir name hunk ./HSPForm.hs 183 + addParam "errors" (Nothing :: Maybe [ErrorMsg]) hunk ./HSPForm.hs 190 - Failure faults -> ok . toResponse =<< handleErrors (createForm d frm) faults - Success s -> ok . toResponse =<< handleOk s + Failure faults -> handleErrors d faults + Success s -> handleOk s + +-- * + +testForm :: Web XML +testForm = +
+ <% inputF (Just "1") `check` asInteger %> +
+ + +test :: IO () +test = + do (xmd, xml) <- evalHSP (runWebXML (WebState { queryGlobal = undefined, queryLocal = Map.fromList [("env", toJson [("input_0", "bork brok brok")])] }) testForm) Nothing + putStrLn (renderAsHTML xml) hunk ./HSPForm.hs 207 --- okHtml :: (X.HTML a) => a -> Web Response --- okHtml content = ok $ toResponse $ htmlPage $ content + +-- check that this instance is valid (ie, follows the laws) +instance Monad Form where + return = pure + (Form f) >>= g = Form $ \env -> + do (c1,xml1) <- f env + let (Form g') = g (c1 env) + (c2,xml2) <- g' env + return (c2, xml1 ++ xml2)