Boolean.hs

{-# 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 = [if', (==), (===), (!=), (!==), (!), (!!), and, or]

if' :: Monad m => Operation m
if' = ("if", evaluateIf)

-- Implementation for bool -> bool -> bool operators
(==), (===), (!=), (!==), (!), (!!), and, or :: Monad m => Operation m
(==) = ("==", looseEquals)
(===) = ("===", evaluateLogic (P.==))
(!=) = ("!=", looseNotEquals)
(!==) = ("!==", evaluateLogic (P./=))
(!) = ("!", evaluateFalsey)
(!!) = ("!!", evaluateTruthy)
and = ("and", evaluateLogic (P.&&))
or = ("or", evaluateLogic (P.||))

evaluateIf :: Monad m => Function m Json
evaluateIf evaluator (JsonArray [c, x, y]) vars = do
  res <- evaluateBool evaluator c vars
  evaluator (if res then x else y) vars
evaluateIf _ _ _ = throw "Wrong number of arguments for if"

-- Helper functions

evaluateLogic :: Monad m => (Bool -> Bool -> Bool) -> Function m Json
evaluateLogic operator evaluator (JsonArray [x, y]) vars = do
  x' <- evaluateBool evaluator x vars
  y' <- evaluateBool evaluator y vars
  return $ JsonBool $ x' `operator` y'
evaluateLogic _ _ _ _ = throw "Wrong number of arguments for logic operator"

evaluateTruthy :: Monad m => Function m Json
evaluateTruthy evaluator json vars = JsonBool <$> evaluateBool evaluator (evaluateUnaryArgument json) vars

evaluateFalsey :: Monad m => Function m Json
evaluateFalsey evaluator json vars = JsonBool . not <$> evaluateBool evaluator (evaluateUnaryArgument json) vars

-- | Evaluate loose equals
looseEquals :: Monad m => Function m Json
looseEquals evaluator (JsonArray [x, y]) vars = do
  x' <- evaluator x vars
  y' <- evaluator y vars
  return $ JsonBool $ looseEq x' y'
looseEquals _ _ _ = throw "Wrong number of arguments for loose not equals operator"

looseNotEquals :: Monad m => Function m Json
looseNotEquals evaluator (JsonArray [x, y]) vars = do
  x' <- evaluator x vars
  y' <- evaluator y vars
  return $ JsonBool $ not $ looseEq x' y'
looseNotEquals _ _ _ = throw "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 (JsonArray a) (JsonArray b) = a P.== b
looseEq (JsonObject a) (JsonObject b) = a P.== b
looseEq (JsonNumber a) (JsonNumber b) = a P.== b
looseEq (JsonString a) (JsonString b) = a P.== b
looseEq (JsonBool a) (JsonBool b) = a P.== b
looseEq JsonNull JsonNull = True
looseEq JsonNull _ = False
looseEq _ JsonNull = False
looseEq (JsonObject _) _ = False
looseEq _ (JsonObject _) = False
looseEq a@(JsonNumber _) (JsonArray b) = looseEq a (JsonString $ show b)
looseEq (JsonArray a) b@(JsonNumber _) = looseEq (JsonString $ show a) b
looseEq a@(JsonNumber _) b = a P.== numberify b
looseEq a b@(JsonNumber _) = numberify a P.== b
looseEq (JsonArray a) (JsonString b) = show a P.== b
looseEq (JsonString a) (JsonArray b) = a P.== show b
looseEq _ _ = False

-- See https://github.com/gregsdennis/json-everything/blob/master/JsonLogic/JsonElementExtensions.cs#L84
numberify :: Json -> Json
numberify (JsonString s) = JsonNumber (read s)
numberify n@(JsonNumber _) = n
numberify (JsonBool b) = JsonNumber $ toEnum $ fromEnum b
numberify _ = JsonNull