-- |

-- Module      : JsonLogic.Type

-- Description : Internal JsonLogic types

-- Copyright   : (c) Marien Matser, Gerard van Schie, Jelle Teeuwissen, 2022

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Type where

import Control.Monad.Except
import qualified Data.Map as M
import JsonLogic.Json

-- | An evaluation exception thrown by the evaluator or operations.

-- Is used in the result type.

data Exception
  = -- | Exception thrown when an unknown operation is applied.

    UnrecognizedOperation {Exception -> String
operationName :: String}
  | -- | Exception thrown when a rule does not contain exactly one operation.

    InvalidRule {Exception -> [String]
operationNames :: [String]}
  | -- | Exception thrown for any other error.

    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)

-- | The result of a function can be an error or another Json value.

type Result m r = ExceptT Exception m r

-- | Subevaluator, with rule, its context and resulting Json.

type SubEvaluator m = Rule -> Data -> Result m Json

-- | A function takes a subevaluator, a rule and data and returns a result.

type Function m r = SubEvaluator m -> Rule -> Data -> Result m r

-- | Operation is a function with a name.

type Operation m = (String, Function m Json)

-- | Operations is a Map from the operation name to the operation function.

type Operations m = M.Map String (Function m Json)

-- | The environment contains the functions and variables our environment has currently

data JsonLogicEnv m = JLEnv
  { JsonLogicEnv m -> Operations m
operations :: Operations m, -- All the operations (plus custom ones)

    JsonLogicEnv m -> Json
variables :: Json -- Variables defined in rules

  }

-- | Show the current environment.

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 an evaluation exception.

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