module JsonLogic.Type where
import Control.Monad.Except
import qualified Data.Map as M
import JsonLogic.Json
data Exception
=
UnrecognizedOperation {Exception -> String
operationName :: String}
|
InvalidRule {Exception -> [String]
operationNames :: [String]}
|
EvalException {Exception -> String
message :: String}
deriving (Int -> Exception -> ShowS
[Exception] -> ShowS
Exception -> String
(Int -> Exception -> ShowS)
-> (Exception -> String)
-> ([Exception] -> ShowS)
-> Show Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception] -> ShowS
$cshowList :: [Exception] -> ShowS
show :: Exception -> String
$cshow :: Exception -> String
showsPrec :: Int -> Exception -> ShowS
$cshowsPrec :: Int -> Exception -> ShowS
Show, Exception -> Exception -> Bool
(Exception -> Exception -> Bool)
-> (Exception -> Exception -> Bool) -> Eq Exception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exception -> Exception -> Bool
$c/= :: Exception -> Exception -> Bool
== :: Exception -> Exception -> Bool
$c== :: Exception -> Exception -> Bool
Eq)
type Result m r = ExceptT Exception m r
type SubEvaluator m = Rule -> Data -> Result m Json
type Function m r = SubEvaluator m -> Rule -> Data -> Result m r
type Operation m = (String, Function m Json)
type Operations m = M.Map String (Function m Json)
data JsonLogicEnv m = JLEnv
{ JsonLogicEnv m -> Operations m
operations :: Operations m,
JsonLogicEnv m -> Json
variables :: Json
}
instance Show (JsonLogicEnv m) where
show :: JsonLogicEnv m -> String
show (JLEnv Operations m
os Json
vs) = String
"Operations: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (Operations m -> [String]
forall k a. Map k a -> [k]
M.keys Operations m
os) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nVariables: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Json -> String
forall a. Show a => a -> String
show Json
vs
throw :: Monad m => String -> Result m a
throw :: String -> Result m a
throw = Exception -> Result m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Exception -> Result m a)
-> (String -> Exception) -> String -> Result m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
EvalException