module Network.Spata.DSL where
import Data.DList (singleton, toList, fromList)
import "mtl" Control.Monad.Writer
import "mtl" Control.Monad.Error ()
import MPS.Env
import Prelude ()
import Data.Maybe
import Network.Spata.Type
import MPS (empty, match)
guard :: Assoc -> Guardians -> Either String Assoc
guard inputs m = execWriter m .toList .inject (Right inputs) (>>=)
validate :: Guard -> [String]-> Guardians
validate f inputs =
tell fromList inputs.map f
train :: Task -> Guardians
train f = tell singleton f
inclusion_of :: Guard
inclusion_of = predicate (const True) ""
presence_of :: Guard
presence_of = predicate (empty > not) "should not be empty"
length_of :: (Integer -> Bool) -> Guard
length_of f = predicate (length > from_i > f) "should satisfy length properties"
int_of :: Guard
int_of = predicate (match "^\\d+$" > isJust) "should be integer"
predicate :: (String -> Bool) -> String -> Guard
predicate f s x inputs =
case inputs.lookup x of
Nothing -> Left x + " should exist"
Just y ->
if f y
then Right inputs
else Left x + " " + s
validate_m :: (Monad m) => GuardM m -> [String] -> GuardiansM m
validate_m f inputs =
tell fromList inputs.map f
predicate_m :: (Monad m) => (String -> m Bool) -> String -> GuardM m
predicate_m f s x inputs =
case inputs.lookup x of
Nothing -> return Left x + " should exist"
Just y -> do
r <- f y
if r
then return Right inputs
else return Left x + " " + s
guard_m :: (Monad m) => Assoc -> GuardiansM m -> m (Either String Assoc)
guard_m inputs m = do
let tasks = execWriter m .toList
lazy_eval tasks Right inputs
where
lazy_eval [] last_validation_result = return last_validation_result
lazy_eval _ (Left r) = return Left r
lazy_eval (p':ps) (Right xs) = do
validation_result <- p' xs
lazy_eval ps validation_result
p :: (String -> Bool) -> String -> Guard
p = predicate
validateM :: (Monad m) => GuardM m -> [String] -> GuardiansM m
validateM = validate_m
predicateM :: (Monad m) => (String -> m Bool) -> String -> GuardM m
predicateM = predicate_m
guardM :: (Monad m) => Assoc -> GuardiansM m -> m (Either String Assoc)
guardM = guard_m