{-# 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 (Int -> Form d -> ShowS
[Form d] -> ShowS
Form d -> String
(Int -> Form d -> ShowS)
-> (Form d -> String) -> ([Form d] -> ShowS) -> Show (Form d)
forall d. Show d => Int -> Form d -> ShowS
forall d. Show d => [Form d] -> ShowS
forall d. Show d => Form d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Form d] -> ShowS
$cshowList :: forall d. Show d => [Form d] -> ShowS
show :: Form d -> String
$cshow :: forall d. Show d => Form d -> String
showsPrec :: Int -> Form d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Form d -> ShowS
Show,Form d -> Form d -> Bool
(Form d -> Form d -> Bool)
-> (Form d -> Form d -> Bool) -> Eq (Form d)
forall d. Eq d => Form d -> Form d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Form d -> Form d -> Bool
$c/= :: forall d. Eq d => Form d -> Form d -> Bool
== :: Form d -> Form d -> Bool
$c== :: forall d. Eq d => Form d -> Form d -> Bool
Eq)
input :: Monad m => Text -> Consumer (Map Text Text) (Form d) m Text
input :: Text -> Consumer (Map Text Text) (Form d) m Text
input name :: Text
name =
StateT (Map Text Text) m (Description (Form d))
-> StateT (Map Text Text) m (Result (Description (Form d)) Text)
-> Consumer (Map Text Text) (Form d) m Text
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Form d)
-> StateT (Map Text Text) m (Description (Form d))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Form d)
forall d. Description (Form d)
d)
(do Map Text Text
s <- StateT (Map Text Text) m (Map Text Text)
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description (Form d)) Text
-> StateT (Map Text Text) m (Result (Description (Form d)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text Text
s of
Nothing -> Description (Form d) -> Result (Description (Form d)) Text
forall e a. e -> Result e a
Continued Description (Form d)
forall d. Description (Form d)
d
Just a :: Text
a -> Text -> Result (Description (Form d)) Text
forall e a. a -> Result e a
Succeeded Text
a))
where d :: Description (Form d)
d = Form d -> Description (Form d)
forall a. a -> Description a
Unit (Text -> Form d
forall d. Text -> Form d
Input Text
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
-> (a -> StateT s m (Maybe b))
-> Consumer s (Form d) m a
-> Consumer s (Form d) m b
validate d' :: d
d' check :: a -> StateT s m (Maybe b)
check =
(StateT s m (Description (Form d))
-> StateT s m (Description (Form d)))
-> (StateT s m (Description (Form d))
-> StateT s m (Result (Description (Form d)) a)
-> StateT s m (Result (Description (Form d)) b))
-> Consumer s (Form d) m a
-> Consumer s (Form d) m b
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap ((Description (Form d) -> Description (Form d))
-> StateT s m (Description (Form d))
-> StateT s m (Description (Form d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Description (Form d) -> Description (Form d)
wrapper)
(\d :: StateT s m (Description (Form d))
d p :: StateT s m (Result (Description (Form d)) a)
p ->
do s
s <- StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description (Form d)) a
r <- StateT s m (Result (Description (Form d)) a)
p
case Result (Description (Form d)) a
r of
(Failed e :: Description (Form d)
e) -> Result (Description (Form d)) b
-> StateT s m (Result (Description (Form d)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Form d) -> Result (Description (Form d)) b
forall e a. e -> Result e a
Failed Description (Form d)
e)
(Continued e :: Description (Form d)
e) ->
Result (Description (Form d)) b
-> StateT s m (Result (Description (Form d)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Form d) -> Result (Description (Form d)) b
forall e a. e -> Result e a
Continued (Description (Form d) -> Description (Form d)
wrapper Description (Form d)
e))
(Succeeded a :: a
a) ->
do Maybe b
r' <- a -> StateT s m (Maybe b)
check a
a
case Maybe b
r' of
Nothing ->
do Description (Form d)
doc <- (s -> s)
-> StateT s m (Description (Form d))
-> StateT s m (Description (Form d))
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT (s -> s -> s
forall a b. a -> b -> a
const s
s) StateT s m (Description (Form d))
d
Result (Description (Form d)) b
-> StateT s m (Result (Description (Form d)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Form d) -> Result (Description (Form d)) b
forall e a. e -> Result e a
Continued (Description (Form d) -> Description (Form d)
wrapper Description (Form d)
doc))
Just a' :: b
a' -> Result (Description (Form d)) b
-> StateT s m (Result (Description (Form d)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result (Description (Form d)) b
forall e a. a -> Result e a
Succeeded b
a'))
where wrapper :: Description (Form d) -> Description (Form d)
wrapper = Form d -> Description (Form d) -> Description (Form d)
forall a. a -> Description a -> Description a
Wrap (d -> Form d
forall d. d -> Form d
Constraint d
d')