{-# LANGUAGE NoImplicitPrelude #-}

-- |

-- Module      : JsonLogic.IO.Operation

-- Description : JsonLogic IO operations

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental


{- ORMOLU_DISABLE -}
module JsonLogic.IO.Operation
  ( defaultOperations,
    arrayOperations, map, reduce, filter, all, none, some, merge, in',
    booleanOperations, if', (==), (===), (!=), (!==), (!), (!!), and, or,
    dataOperations, var, missing, missingSome, preserve,
    miscOperations, trace, log,
    numericOperations, (>), (>=), (<), (<=), max, min, sum, (+), (-), (*), (/), (%),
    stringOperations, cat, substr,
    evaluateDouble, evaluateInt, evaluateBool, evaluateArray, evaluateObject, evaluateString
  )
where
{- ORMOLU_ENABLE -}
import qualified Data.Map as M
import JsonLogic.IO.Mapping
import JsonLogic.IO.Operation.Misc (log, miscOperations, trace)
import JsonLogic.IO.Type
import JsonLogic.Json
import qualified JsonLogic.Operation as O
import qualified Prelude as P

-- | A map of all the default operations.

defaultOperations :: Operations
defaultOperations :: Operations
defaultOperations = [Operations] -> Operations
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [Operations
arrayOperations, Operations
booleanOperations, Operations
dataOperations, Operations
miscOperations, Operations
numericOperations, Operations
stringOperations]

-- | Groups of operations on similar data.

arrayOperations, booleanOperations, dataOperations, numericOperations, stringOperations :: Operations
arrayOperations :: Operations
arrayOperations = Operations IO -> Operations
toOperations Operations IO
forall (m :: * -> *). Monad m => Operations m
O.arrayOperations
booleanOperations :: Operations
booleanOperations = Operations IO -> Operations
toOperations Operations IO
forall (m :: * -> *). Monad m => Operations m
O.booleanOperations
dataOperations :: Operations
dataOperations = Operations IO -> Operations
toOperations Operations IO
forall (m :: * -> *). Monad m => Operations m
O.dataOperations
numericOperations :: Operations
numericOperations = Operations IO -> Operations
toOperations Operations IO
forall (m :: * -> *). Monad m => Operations m
O.numericOperations
stringOperations :: Operations
stringOperations = Operations IO -> Operations
toOperations Operations IO
forall (m :: * -> *). Monad m => Operations m
O.stringOperations

-- | Array operations.

map, reduce, filter, all, none, some, merge, in' :: Operation
map :: Operation
map = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.map
reduce :: Operation
reduce = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.reduce
filter :: Operation
filter = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.filter
all :: Operation
all = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.all
none :: Operation
none = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.none
some :: Operation
some = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.some
merge :: Operation
merge = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.merge
in' :: Operation
in' = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.in'

-- | Boolean operations.

if', (==), (===), (!=), (!==), (!), (!!), and, or :: Operation
if' :: Operation
if' = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.if'
== :: Operation
(==) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.==)
=== :: Operation
(===) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.===)
!= :: Operation
(!=) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.!=)
!== :: Operation
(!==) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.!==)
(!) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.!)
!! :: Operation
(!!) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.!!)
and :: Operation
and = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.and
or :: Operation
or = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.or

-- | Data operations.

var, missing, missingSome, preserve :: Operation
var :: Operation
var = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.var
missing :: Operation
missing = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.missing
missingSome :: Operation
missingSome = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.missingSome
preserve :: Operation
preserve = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.preserve

-- | Numeric operations.

(>), (>=), (<), (<=), max, min, sum, (+), (-), (*), (/), (%) :: Operation
> :: Operation
(>) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.>)
>= :: Operation
(>=) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.>=)
< :: Operation
(<) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.<)
<= :: Operation
(<=) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.<=)
max :: Operation
max = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.max
min :: Operation
min = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.min
sum :: Operation
sum = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.sum
+ :: Operation
(+) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.+)
(-) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.-)
* :: Operation
(*) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.*)
/ :: Operation
(/) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O./)
% :: Operation
(%) = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
(O.%)

-- | String operations.

cat, substr :: Operation
cat :: Operation
cat = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.cat
substr :: Operation
substr = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.substr

-- Primitive Evaluators


-- | Evaluate to a double.

evaluateDouble :: Function P.Double
evaluateDouble :: Function Double
evaluateDouble = Function IO Double -> Function Double
forall r. Function IO r -> Function r
toFunction Function IO Double
forall (m :: * -> *). Monad m => Function m Double
O.evaluateDouble

-- | Evaluate to an int.

evaluateInt :: Function P.Int
evaluateInt :: Function Int
evaluateInt = Function IO Int -> Function Int
forall r. Function IO r -> Function r
toFunction Function IO Int
forall (m :: * -> *). Monad m => Function m Int
O.evaluateInt

-- | Evaluate to a bool.

evaluateBool :: Function P.Bool
evaluateBool :: Function Bool
evaluateBool = Function IO Bool -> Function Bool
forall r. Function IO r -> Function r
toFunction Function IO Bool
forall (m :: * -> *). Monad m => Function m Bool
O.evaluateBool

-- | Evaluate to an array.

evaluateArray :: Function [Json]
evaluateArray :: Function [Json]
evaluateArray = Function IO [Json] -> Function [Json]
forall r. Function IO r -> Function r
toFunction Function IO [Json]
forall (m :: * -> *). Monad m => Function m [Json]
O.evaluateArray

-- | Evaluate to an object.

evaluateObject :: Function JsonObject
evaluateObject :: Function JsonObject
evaluateObject = Function IO JsonObject -> Function JsonObject
forall r. Function IO r -> Function r
toFunction Function IO JsonObject
forall (m :: * -> *). Monad m => Function m JsonObject
O.evaluateObject

-- | Evaluate to a string.

evaluateString :: Function P.String
evaluateString :: Function String
evaluateString = Function IO String -> Function String
forall r. Function IO r -> Function r
toFunction Function IO String
forall (m :: * -> *). Monad m => Function m String
O.evaluateString