-- |

-- Module      : JsonLogic.IO.Evaluator

-- Description : JsonLogic IO evaluator

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.IO.Evaluator (apply, applyEmpty) where

import qualified Data.Map as M
import qualified JsonLogic.Evaluator as E
import JsonLogic.IO.Mapping
import JsonLogic.IO.Operation (defaultOperations)
import JsonLogic.IO.Type
import JsonLogic.Json

-- | Apply takes a list of operations, a rule and data.

-- And together with the default operations evaluates it.

--

-- >>> apply [] (read "{\"cat\":[\"Hello, \", \"World!\"]}":: Json) JsonNull

-- Right "Hello, World!"

apply :: [Operation] -> Rule -> Data -> Result Json
apply :: [Operation] -> Rule -> Rule -> Result Rule
apply [Operation]
ops = [Operation] -> Rule -> Rule -> Result Rule
applyEmpty ([Operation]
ops [Operation] -> [Operation] -> [Operation]
forall a. [a] -> [a] -> [a]
++ Map String (Function Rule) -> [Operation]
forall k a. Map k a -> [(k, a)]
M.toList Map String (Function Rule)
defaultOperations)

-- | applyEmpty takes a list of operations, a rule and data.

-- And without the default operations evaluates it.

--

-- >>> applyEmpty [] (read "{\"cat\":[\"Hello, \", \"World!\"]}":: Json) JsonNull

-- Left (UnrecognizedOperation {operationName = "cat"})

applyEmpty :: [Operation] -> Rule -> Data -> Result Json
applyEmpty :: [Operation] -> Rule -> Rule -> Result Rule
applyEmpty [Operation]
ops Rule
rule Rule
dat = Result IO Rule -> Result Rule
forall r. Result IO r -> Result r
toResult (Result IO Rule -> Result Rule) -> Result IO Rule -> Result Rule
forall a b. (a -> b) -> a -> b
$ Operations IO -> Rule -> Rule -> Result IO Rule
forall (m :: * -> *).
Monad m =>
Operations m -> Rule -> Rule -> Result m Rule
E.apply ((Function Rule -> Function IO Rule)
-> Map String (Function Rule) -> Operations IO
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Function Rule -> Function IO Rule
forall r. Function r -> Function IO r
fromFunction (Map String (Function Rule) -> Operations IO)
-> Map String (Function Rule) -> Operations IO
forall a b. (a -> b) -> a -> b
$ [Operation] -> Map String (Function Rule)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [Operation]
ops) Rule
rule Rule
dat