{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans -F -pgmF trhsx #-} module Index where import Data.Generics.SYB.WithClass.Basics import Control.Applicative import Control.Applicative.Error import Control.Monad.Writer import Data.Monoid import Control.Monad.Reader import Control.Monad.State import Control.Monad.Trans import Control.Monad.Identity import Happstack.Data (Default(..)) import HSP import HSP.Formlets import Interface import Text.Formlets import qualified HSX.XMLGenerator as HSX import HSP.IdentityT import HSP.Identity data FormState = FormState { env :: Env , prefix :: String , action :: String , faults :: [String] } deriving (Read, Show) createForm :: (HSX.XMLGenerator x, Monad m) => Env -> String -> String -> [String] -> Form [XMLGenT x (HSX.XML x)] m a -> XMLGenT x (HSX.XML x) createForm env prefix action' faults frm = do let (_extractor, xml, _ct) = runFormState env frm let faultsXML = if null faults then [] else [

<% show faults %>

]
<% faultsXML %> <% xml %>
-- * demo dateComponent :: (HSX.XMLGenerator x, Applicative m, Monad m) => Form [XMLGenT x (HSX.XML x)] m Date dateComponent = Date <$> input (Just "1") `check` asInteger <*> input (Just "16") `check` asInteger <* submit "hit it!" dateFull :: (HSX.XMLGenerator x, Applicative m, Monad m) => Form [XMLGenT x (HSX.XML x)] m Date dateFull = dateComponent `check` ensure validDate "This is not a valid date" page :: (EmbedAsChild x String, EmbedAsChild x c) => c -> XMLGenT x (HSX.XML x) page xml = HAppS + HSP + Formlets <% xml %> inputFrm :: Form [XMLGenT Identity XML] IO String inputFrm = input Nothing <* (submit "go!") dateForm :: (HSX.XMLGenerator x, Monad v, Applicative v) => Form [XMLGenT x (HSX.XML x)] v Date dateForm = (\x -> [

<% x %>

]) `plug` dateFull selectForm :: Form [XMLGenT Identity XML] IO (Maybe String) selectForm = let fruit = ["apple", "banana", "coconut" ] in (\x -> [

<% x %>

]) `plug` (select Nothing (zip fruit fruit) <* submit "Drink Up!") selectMultiForm :: Form [XMLGenT Identity XML] IO [String] selectMultiForm = let fruit = ["apple", "banana", "coconut" ] in (\x -> [

<% x %>

]) `plug` (selectMulti (zip fruit fruit) <* submit "Drink Up!") checkboxesForm :: Form [XMLGenT Identity XML] IO [String] checkboxesForm = let fruit = ["apple", "banana", "coconut" ] in (\x -> [
<% x %>
]) `plug` (checkboxes (zip fruit fruit) [] <* submit "Drink Up!") radiosForm :: Form [XMLGenT Identity XML] IO (Maybe String) radiosForm = let fruit = ["apple", "banana", "coconut" ] in (\x -> [
<% x %>
]) `plug` (radio (zip fruit fruit) Nothing <* submit "Drink Up!") {- sampleForm :: Sample3 -> Form [XMLGenT Identity XML] IO Sample3 sampleForm x = -- Put the whole form inside a paragraph (\ xml -> [

<% xml %>

]) `plug` (formletOf x <* go) where -- Put a break in front of the submit button go = (\x -> [
<% x %>]) `plug` (submit "Go") -}