module Text.Formlets.Form where
import Control.Applicative
import Control.Applicative.State
import Text.XHtml.Strict ((+++))
import Text.XHtml.Strict as X
type Env = [(String, String)]
type FormState = Names
type Names = Integer
type Name = String
type Xml = X.Html
queryParam :: Env -> Name -> String
queryParam env name = case (name `lookup` env) of
Nothing -> error $ "Couldn't find " ++ name
Just x -> x
newtype Form a = Form { deform :: Env -> State FormState (Collector a, X.Html) }
instance Functor Form where
fmap f (Form a) = Form $ \env -> (fmap . fmapFst . fmap) f (a env)
where fmapFst f (a, b) = (f a, b)
type Collector a = Env -> a
instance Applicative Form where
pure = pureF
(<*>) = applyF
pureF :: a -> Form a
pureF v = Form $ \env -> pure (const v, X.noHtml)
applyF :: Form (a -> b) -> Form a -> Form b
(Form f) `applyF` (Form v) = Form $ \env -> pure combine <*> f env <*> v env
where combine (f, x) (v, y) = (\e -> f e (v e), x +++ y)
freshName :: State FormState String
freshName = do n <- get
put $ n + 1
return $ "input_" ++ show n
currentName :: State FormState String
currentName = gets $ (++) "input_" . show
xml :: X.Html -> Form ()
xml x = Form $ \env -> pure (const (), x)
text :: String -> Form ()
text s = Form $ \env -> pure (const (), toHtml s)
plug :: (Xml -> Xml) -> Form a -> Form a
f `plug` (Form m) = Form $ \env -> pure plugin <*> m env
where plugin :: (a, Xml) -> (a, Xml)
plugin (c, x) = (c, f x)