module Text.Formlets ( module Text.Formlets.Form
, input , password , inputF , passwordF,ensure
, FailingForm, validate, runFormState, inputIntegerF
, check, liftForm
)
where
import Text.Formlets.Form
import Control.Applicative
import Control.Applicative.Compose
import Control.Applicative.Error
import Control.Applicative.State
import Text.XHtml.Strict ((!))
import qualified Text.XHtml.Strict as X
ensure :: Show a
=> (a -> Bool)
-> String
-> a
-> Failing a
ensure p msg x | p x = Success x
| otherwise = Failure [msg]
input' :: (String -> String -> X.Html) -> Maybe String -> Form String
input' i defaultValue = Form $ \env -> mkInput env <$> freshName
where mkInput :: Env -> String -> (Collector String, Xml)
mkInput env name = (`queryParam` name,
i name (value name env))
value name env = maybe (maybe "" id defaultValue) id (lookup name env)
type FailingForm a = (Form :+: Failing) a
runFormState :: Env
-> FailingForm a
-> FormState
-> ((Collector (Failing a), Xml), FormState)
runFormState e f s = (runState (deform (decompose f) e) s)
liftForm :: (Form (f a) -> Form (f a)) -> (Form :+: f) a -> (Form :+: f) a
liftForm f = Compose . f . decompose
validate :: Form a -> FailingForm a
validate f = Compose $ pure Success <*> f
check :: FailingForm a -> (a -> Failing b) -> FailingForm b
check form f = decompose form `chk` checker f
where chk :: Form a -> (a -> Failing b) -> FailingForm b
chk form validator = Compose $ pure validator <*> form
checker :: (a -> Failing b) -> (Failing a -> Failing b)
checker f (Failure x) = Failure x
checker f (Success x) = f x
input :: Maybe String -> Form String
input = input' (\n v -> X.textfield n ! [X.value v])
password :: Maybe String -> Form String
password = input' (\n v -> X.password n ! [X.value v])
inputF :: Maybe String -> FailingForm String
inputF = validate . input
passwordF :: Maybe String -> FailingForm String
passwordF = validate . password
inputIntegerF :: Maybe Integer -> FailingForm Integer
inputIntegerF x = validate (input $ fmap show x) `check` asInteger