{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
module Descriptive.Form
(
input
,validate
,Form (..)
)
where
import Descriptive
import Control.Monad.State.Strict
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text)
data Form d
= Input !Text
| Constraint !d
deriving (Show,Eq)
input :: Monad m => Text -> Consumer (Map Text Text) (Form d) m Text
input name =
consumer (return d)
(do s <- get
return (case M.lookup name s of
Nothing -> Continued d
Just a -> Succeeded a))
where d = Unit (Input name)
validate :: Monad m
=> d
-> (a -> StateT s m (Maybe b))
-> Consumer s (Form d) m a
-> Consumer s (Form d) m b
validate d' check =
wrap (liftM wrapper)
(\d p ->
do s <- get
r <- p
case r of
(Failed e) -> return (Failed e)
(Continued e) ->
return (Continued (wrapper e))
(Succeeded a) ->
do r' <- check a
case r' of
Nothing ->
do doc <- withStateT (const s) d
return (Continued (wrapper doc))
Just a' -> return (Succeeded a'))
where wrapper = Wrap (Constraint d')