{-# LANGUAGE OverloadedLists #-} -- | -- Module : JsonLogic.Operation.Numeric -- Description : Internal JsonLogic operations on numbers -- Copyright : (c) Marien Matser, Gerard van Schie, Jelle Teeuwissen, 2022 -- License : MIT -- Maintainer : jelleteeuwissen@hotmail.nl -- Stability : experimental module JsonLogic.Operation.Numeric (numericOperations, (>), (>=), (<), (<=), max, min, sum, (+), (-), (*), (/), (%)) where import Control.Monad.Except import qualified Data.Fixed as F import JsonLogic.Json import JsonLogic.Operation.Primitive import JsonLogic.Type import Prelude hiding (max, min, sum, (*), (+), (-), (/), (<), (<=), (>), (>=)) import qualified Prelude hiding (max, min, sum) import qualified Prelude as P numericOperations :: Monad m => Operations m numericOperations = [(>), (>=), (<), (<=), max, min, sum, (+), (-), (*), (/), (%)] -- Implementation for double -> double -> bool operators (>), (>=), (<), (<=) :: Monad m => Operation m (>) = (">", evaluateComparison (P.>)) (>=) = (">=", evaluateComparison (P.>=)) (<) = ("<", evaluateBetween (P.<)) (<=) = ("<=", evaluateBetween (P.<=)) max, min, sum :: Monad m => Operation m max = ("max", evaluateDoubleArray P.maximum) min = ("min", evaluateDoubleArray P.minimum) sum = ("sum", evaluateDoubleArray P.sum) (+), (-), (*), (/), (%) :: Monad m => Operation m (+) = ("+", evaluateMath (P.+)) (-) = ("-", evaluateMath (P.-)) (*) = ("*", evaluateMath (P.*)) (/) = ("/", evaluateMath (P./)) (%) = ("%", evaluateMath F.mod') evaluateComparison :: Monad m => (Double -> Double -> Bool) -> Function m Json evaluateComparison operator evaluator (JsonArray [x, y]) vars = do x' <- evaluateDouble evaluator x vars y' <- evaluateDouble evaluator y vars return $ JsonBool $ x' `operator` y' evaluateComparison _ _ _ _ = throw "Wrong number of arguments for comparison operator" -- Adds the between operator to check whether a number is between two other numbers evaluateBetween :: Monad m => (Double -> Double -> Bool) -> Function m Json evaluateBetween operator evaluator (JsonArray [x, y, z]) vars = do x' <- evaluateDouble evaluator x vars y' <- evaluateDouble evaluator y vars z' <- evaluateDouble evaluator z vars return $ JsonBool $ (x' `operator` y') P.&& (y' `operator` z') -- The regular two value case of the operator evaluateBetween operator evaluator json vars = evaluateComparison operator evaluator json vars -- Function evaluators evaluateMath :: Monad m => (Double -> Double -> Double) -> Function m Json evaluateMath operator evaluator (JsonArray [x, y]) vars = do x' <- evaluateDouble evaluator x vars y' <- evaluateDouble evaluator y vars return $ JsonNumber $ x' `operator` y' evaluateMath _ _ _ _ = throw "Wrong number of arguments for math operator" -- Evaluation for max/min evaluateDoubleArray :: Monad m => ([Double] -> Double) -> Function m Json evaluateDoubleArray _ _ (JsonArray []) _ = throw "Can't evaluate array action an empty list" evaluateDoubleArray operator evaluator (JsonArray arr) vars = do arr' <- mapM (\x -> evaluateDouble evaluator x vars) arr return $ JsonNumber $ operator arr' evaluateDoubleArray _ _ json _ = throw $ "Can't evaluate array action on non array, namely: " ++ show json