{-# 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 :: Operations m
numericOperations = [Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(>), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(>=), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(<), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(<=), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
max, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
min, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
sum, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(+), (-), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(*), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(/), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
(%)]

-- Implementation for double -> double -> bool operators

(>), (>=), (<), (<=) :: Monad m => Operation m
> :: Operation m
(>) = ([Char]
">", (Double -> Double -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Bool) -> Function m Json
evaluateComparison Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(P.>))
>= :: Operation m
(>=) = ([Char]
">=", (Double -> Double -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Bool) -> Function m Json
evaluateComparison Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(P.>=))
< :: Operation m
(<) = ([Char]
"<", (Double -> Double -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Bool) -> Function m Json
evaluateBetween Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(P.<))
<= :: Operation m
(<=) = ([Char]
"<=", (Double -> Double -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Bool) -> Function m Json
evaluateBetween Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(P.<=))

max, min, sum :: Monad m => Operation m
max :: Operation m
max = ([Char]
"max", ([Double] -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
([Double] -> Double) -> Function m Json
evaluateDoubleArray [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
P.maximum)
min :: Operation m
min = ([Char]
"min", ([Double] -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
([Double] -> Double) -> Function m Json
evaluateDoubleArray [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
P.minimum)
sum :: Operation m
sum = ([Char]
"sum", ([Double] -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
([Double] -> Double) -> Function m Json
evaluateDoubleArray [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
P.sum)

(+), (-), (*), (/), (%) :: Monad m => Operation m
+ :: Operation m
(+) = ([Char]
"+", (Double -> Double -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Double) -> Function m Json
evaluateMath Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.+))
(-) = ([Char]
"-", (Double -> Double -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Double) -> Function m Json
evaluateMath Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.-))
* :: Operation m
(*) = ([Char]
"*", (Double -> Double -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Double) -> Function m Json
evaluateMath Double -> Double -> Double
forall a. Num a => a -> a -> a
(P.*))
/ :: Operation m
(/) = ([Char]
"/", (Double -> Double -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Double) -> Function m Json
evaluateMath Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(P./))
% :: Operation m
(%) = ([Char]
"%", (Double -> Double -> Double) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Double) -> Function m Json
evaluateMath Double -> Double -> Double
forall a. Real a => a -> a -> a
F.mod')

evaluateComparison :: Monad m => (Double -> Double -> Bool) -> Function m Json
evaluateComparison :: (Double -> Double -> Bool) -> Function m Json
evaluateComparison Double -> Double -> Bool
operator SubEvaluator m
evaluator (JsonArray [Item [Json]
x, Item [Json]
y]) Json
vars = do
  Double
x' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
x Json
vars
  Double
y' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
y Json
vars
  Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Result m Json) -> Json -> Result m Json
forall a b. (a -> b) -> a -> b
$ Bool -> Json
JsonBool (Bool -> Json) -> Bool -> Json
forall a b. (a -> b) -> a -> b
$ Double
x' Double -> Double -> Bool
`operator` Double
y'
evaluateComparison Double -> Double -> Bool
_ SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"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 :: (Double -> Double -> Bool) -> Function m Json
evaluateBetween Double -> Double -> Bool
operator SubEvaluator m
evaluator (JsonArray [Item [Json]
x, Item [Json]
y, Item [Json]
z]) Json
vars = do
  Double
x' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
x Json
vars
  Double
y' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
y Json
vars
  Double
z' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
z Json
vars
  Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Result m Json) -> Json -> Result m Json
forall a b. (a -> b) -> a -> b
$ Bool -> Json
JsonBool (Bool -> Json) -> Bool -> Json
forall a b. (a -> b) -> a -> b
$ (Double
x' Double -> Double -> Bool
`operator` Double
y') Bool -> Bool -> Bool
P.&& (Double
y' Double -> Double -> Bool
`operator` Double
z')
-- The regular two value case of the operator

evaluateBetween Double -> Double -> Bool
operator SubEvaluator m
evaluator Json
json Json
vars = (Double -> Double -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Bool) -> Function m Json
evaluateComparison Double -> Double -> Bool
operator SubEvaluator m
evaluator Json
json Json
vars

-- Function evaluators

evaluateMath :: Monad m => (Double -> Double -> Double) -> Function m Json
evaluateMath :: (Double -> Double -> Double) -> Function m Json
evaluateMath Double -> Double -> Double
operator SubEvaluator m
evaluator (JsonArray [Item [Json]
x, Item [Json]
y]) Json
vars = do
  Double
x' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
x Json
vars
  Double
y' <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Item [Json]
Json
y Json
vars
  Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Result m Json) -> Json -> Result m Json
forall a b. (a -> b) -> a -> b
$ Double -> Json
JsonNumber (Double -> Json) -> Double -> Json
forall a b. (a -> b) -> a -> b
$ Double
x' Double -> Double -> Double
`operator` Double
y'
evaluateMath Double -> Double -> Double
_ SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Wrong number of arguments for math operator"

-- Evaluation for max/min

evaluateDoubleArray :: Monad m => ([Double] -> Double) -> Function m Json
evaluateDoubleArray :: ([Double] -> Double) -> Function m Json
evaluateDoubleArray [Double] -> Double
_ SubEvaluator m
_ (JsonArray []) Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Can't evaluate array action an empty list"
evaluateDoubleArray [Double] -> Double
operator SubEvaluator m
evaluator (JsonArray [Json]
arr) Json
vars = do
  [Double]
arr' <- (Json -> ExceptT Exception m Double)
-> [Json] -> ExceptT Exception m [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Json
x -> Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Json
x Json
vars) [Json]
arr
  Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Result m Json) -> Json -> Result m Json
forall a b. (a -> b) -> a -> b
$ Double -> Json
JsonNumber (Double -> Json) -> Double -> Json
forall a b. (a -> b) -> a -> b
$ [Double] -> Double
operator [Double]
arr'
evaluateDoubleArray [Double] -> Double
_ SubEvaluator m
_ Json
json Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw ([Char] -> Result m Json) -> [Char] -> Result m Json
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't evaluate array action on non array, namely: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Json -> [Char]
forall a. Show a => a -> [Char]
show Json
json