{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Validating form with named inputs.

module Descriptive.Form
  (-- * Combinators
   input
  ,validate
  -- * Description
  ,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)

-- | Form descriptor.
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)

-- | Consume any input value.
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 a form input with a description of what's required.
validate :: Monad m
         => d                           -- ^ Description of what it expects.
         -> (a -> StateT s m (Maybe b)) -- ^ Attempt to parse the value.
         -> Consumer s (Form d) m a     -- ^ Consumer to add validation to.
         -> Consumer s (Form d) m b     -- ^ A new validating consumer.
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')