{-# LANGUAGE PackageImports #-} 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 -- monad, mostly used in IO 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 -- alias 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