{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans -F -pgmF trhsx #-} module Index where import Control.Applicative import Control.Monad.Writer import Data.Monoid import Control.Monad.Reader import Control.Monad.Trans import Control.Monad.Identity import HSP import HAppS.Template.HSP import HSP.Formlets import Interface import Text.Formlets import qualified HSX.XMLGenerator as HSX dateComponent :: (Applicative m, Monad m) => WebFormT m Date dateComponent = Date <$> inputInteger (Just 1) <*> inputInteger (Just 16) dateFull :: (Applicative m, Monad m) => WebFormT m Date dateFull = dateComponent `check` ensure validDate "This is not a valid date" page :: Web XML page = withMetaData html4Strict $ HAppS + HSP + Formlets <% dateFull :: WebForm Date %> instance (Monad m) => EmbedAsChild (HSPT' (WriterT (Endo XML) (ReaderT WebState IO))) (WebFormT m a) where asChild form = do env <- liftM (map toEnv) $ localRead "formData" prefix <- localRead "prefix" action <- localRead "action" faults <- localRead "faults" :: Web [String] faultsXML <- if null faults then return [] else do x <-

<% show faults %>

return [HSX.xmlToChild x] xml <- createForm env prefix form action return (faultsXML ++ [ HSX.xmlToChild xml]) where toEnv (a,b) = (a, Left b) createForm :: (Monad m) => Env -> String -> WebFormT m a -> String -> Web XML createForm env prefix frm action' =
<% xml %>
where (_extractor, xml, _ct) = runFormState env prefix frm