{-# LANGUAGE OverloadedLists #-}

-- |

-- Module      : JsonLogic.Operation.Boolean

-- Description : Internal JsonLogic operations on booleans

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Operation.Boolean (booleanOperations, if', (==), (===), (!=), (!==), (!), (!!), and, or) where

import Control.Monad.Except
import JsonLogic.Json
import JsonLogic.Operation.Primitive
import JsonLogic.Operation.Utils
import JsonLogic.Type
import Prelude hiding (all, and, any, filter, map, max, min, or, sum, (!!), (&&), (==), (||))
import qualified Prelude as P hiding (and, or)

booleanOperations :: Monad m => Operations m
booleanOperations :: Operations m
booleanOperations = [Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
if', 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
(!!), Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
and, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
or]

if' :: Monad m => Operation m
if' :: Operation m
if' = ([Char]
"if", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateIf)

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

(==), (===), (!=), (!==), (!), (!!), and, or :: Monad m => Operation m
== :: Operation m
(==) = ([Char]
"==", Function m Json
forall (m :: * -> *). Monad m => Function m Json
looseEquals)
=== :: Operation m
(===) = ([Char]
"===", (Bool -> Bool -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Function m Json
evaluateLogic Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(P.==))
!= :: Operation m
(!=) = ([Char]
"!=", Function m Json
forall (m :: * -> *). Monad m => Function m Json
looseNotEquals)
!== :: Operation m
(!==) = ([Char]
"!==", (Bool -> Bool -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Function m Json
evaluateLogic Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(P./=))
(!) = ([Char]
"!", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateFalsey)
!! :: Operation m
(!!) = ([Char]
"!!", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateTruthy)
and :: Operation m
and = ([Char]
"and", (Bool -> Bool -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Function m Json
evaluateLogic Bool -> Bool -> Bool
(P.&&))
or :: Operation m
or = ([Char]
"or", (Bool -> Bool -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Function m Json
evaluateLogic Bool -> Bool -> Bool
(P.||))

evaluateIf :: Monad m => Function m Json
evaluateIf :: Function m Json
evaluateIf SubEvaluator m
evaluator (JsonArray [Item [Json]
c, Item [Json]
x, Item [Json]
y]) Json
vars = do
  Bool
res <- Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool SubEvaluator m
evaluator Item [Json]
Json
c Json
vars
  SubEvaluator m
evaluator (if Bool
res then Item [Json]
Json
x else Item [Json]
Json
y) Json
vars
evaluateIf SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Wrong number of arguments for if"

-- Helper functions


evaluateLogic :: Monad m => (Bool -> Bool -> Bool) -> Function m Json
evaluateLogic :: (Bool -> Bool -> Bool) -> Function m Json
evaluateLogic Bool -> Bool -> Bool
operator SubEvaluator m
evaluator (JsonArray [Item [Json]
x, Item [Json]
y]) Json
vars = do
  Bool
x' <- Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool SubEvaluator m
evaluator Item [Json]
Json
x Json
vars
  Bool
y' <- Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool 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
$ Bool
x' Bool -> Bool -> Bool
`operator` Bool
y'
evaluateLogic Bool -> Bool -> 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 logic operator"

evaluateTruthy :: Monad m => Function m Json
evaluateTruthy :: Function m Json
evaluateTruthy SubEvaluator m
evaluator Json
json Json
vars = Bool -> Json
JsonBool (Bool -> Json)
-> ExceptT Exception m Bool -> ExceptT Exception m Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool SubEvaluator m
evaluator (Json -> Json
evaluateUnaryArgument Json
json) Json
vars

evaluateFalsey :: Monad m => Function m Json
evaluateFalsey :: Function m Json
evaluateFalsey SubEvaluator m
evaluator Json
json Json
vars = Bool -> Json
JsonBool (Bool -> Json) -> (Bool -> Bool) -> Bool -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Json)
-> ExceptT Exception m Bool -> ExceptT Exception m Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool SubEvaluator m
evaluator (Json -> Json
evaluateUnaryArgument Json
json) Json
vars

-- | Evaluate loose equals

looseEquals :: Monad m => Function m Json
looseEquals :: Function m Json
looseEquals SubEvaluator m
evaluator (JsonArray [Item [Json]
x, Item [Json]
y]) Json
vars = do
  Json
x' <- SubEvaluator m
evaluator Item [Json]
Json
x Json
vars
  Json
y' <- 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
$ Json -> Json -> Bool
looseEq Json
x' Json
y'
looseEquals SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Wrong number of arguments for loose not equals operator"

looseNotEquals :: Monad m => Function m Json
looseNotEquals :: Function m Json
looseNotEquals SubEvaluator m
evaluator (JsonArray [Item [Json]
x, Item [Json]
y]) Json
vars = do
  Json
x' <- SubEvaluator m
evaluator Item [Json]
Json
x Json
vars
  Json
y' <- 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
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Json -> Json -> Bool
looseEq Json
x' Json
y'
looseNotEquals SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Wrong number of arguments for loose not equals operator"

-- | See: https://github.com/gregsdennis/json-everything/blob/master/JsonLogic/JsonElementExtensions.cs#L117

-- See: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Equality

looseEq :: Json -> Json -> Bool
looseEq :: Json -> Json -> Bool
looseEq (JsonArray [Json]
a) (JsonArray [Json]
b) = [Json]
a [Json] -> [Json] -> Bool
forall a. Eq a => a -> a -> Bool
P.== [Json]
b
looseEq (JsonObject JsonObject
a) (JsonObject JsonObject
b) = JsonObject
a JsonObject -> JsonObject -> Bool
forall a. Eq a => a -> a -> Bool
P.== JsonObject
b
looseEq (JsonNumber Double
a) (JsonNumber Double
b) = Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
P.== Double
b
looseEq (JsonString [Char]
a) (JsonString [Char]
b) = [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
P.== [Char]
b
looseEq (JsonBool Bool
a) (JsonBool Bool
b) = Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
P.== Bool
b
looseEq Json
JsonNull Json
JsonNull = Bool
True
looseEq Json
JsonNull Json
_ = Bool
False
looseEq Json
_ Json
JsonNull = Bool
False
looseEq (JsonObject JsonObject
_) Json
_ = Bool
False
looseEq Json
_ (JsonObject JsonObject
_) = Bool
False
looseEq a :: Json
a@(JsonNumber Double
_) (JsonArray [Json]
b) = Json -> Json -> Bool
looseEq Json
a ([Char] -> Json
JsonString ([Char] -> Json) -> [Char] -> Json
forall a b. (a -> b) -> a -> b
$ [Json] -> [Char]
forall a. Show a => a -> [Char]
show [Json]
b)
looseEq (JsonArray [Json]
a) b :: Json
b@(JsonNumber Double
_) = Json -> Json -> Bool
looseEq ([Char] -> Json
JsonString ([Char] -> Json) -> [Char] -> Json
forall a b. (a -> b) -> a -> b
$ [Json] -> [Char]
forall a. Show a => a -> [Char]
show [Json]
a) Json
b
looseEq a :: Json
a@(JsonNumber Double
_) Json
b = Json
a Json -> Json -> Bool
forall a. Eq a => a -> a -> Bool
P.== Json -> Json
numberify Json
b
looseEq Json
a b :: Json
b@(JsonNumber Double
_) = Json -> Json
numberify Json
a Json -> Json -> Bool
forall a. Eq a => a -> a -> Bool
P.== Json
b
looseEq (JsonArray [Json]
a) (JsonString [Char]
b) = [Json] -> [Char]
forall a. Show a => a -> [Char]
show [Json]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
P.== [Char]
b
looseEq (JsonString [Char]
a) (JsonArray [Json]
b) = [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
P.== [Json] -> [Char]
forall a. Show a => a -> [Char]
show [Json]
b
looseEq Json
_ Json
_ = Bool
False

-- See https://github.com/gregsdennis/json-everything/blob/master/JsonLogic/JsonElementExtensions.cs#L84

numberify :: Json -> Json
numberify :: Json -> Json
numberify (JsonString [Char]
s) = Double -> Json
JsonNumber ([Char] -> Double
forall a. Read a => [Char] -> a
read [Char]
s)
numberify n :: Json
n@(JsonNumber Double
_) = Json
n
numberify (JsonBool Bool
b) = Double -> Json
JsonNumber (Double -> Json) -> Double -> Json
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a. Enum a => Int -> a
toEnum (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
b
numberify Json
_ = Json
JsonNull