{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}

-- |

-- Module      : JsonLogic.Operation.Array

-- Description : Internal JsonLogic operations on arrays

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Operation.Array (arrayOperations, map, reduce, filter, all, none, some, merge, in') where

import Control.Monad
import qualified Data.List as L
import JsonLogic.Json
import JsonLogic.Operation.Primitive
import JsonLogic.Type
import Prelude hiding (all, filter, map)

arrayOperations :: Monad m => Operations m
arrayOperations :: Operations m
arrayOperations = [Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
map, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
reduce, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
filter, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
all, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
none, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
some, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
merge, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
in']

map, reduce, filter :: Monad m => Operation m
map :: Operation m
map = ([Char]
"map", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateMap)
reduce :: Operation m
reduce = ([Char]
"reduce", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateReduce)
filter :: Operation m
filter = ([Char]
"filter", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateFilter)

all, none, some :: Monad m => Operation m
all :: Operation m
all = ([Char]
"all", ([Bool] -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
([Bool] -> Bool) -> Function m Json
evaluateArrayToBool (\case [] -> Bool
False; [Bool]
bools -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bools))
none :: Operation m
none = ([Char]
"none", ([Bool] -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
([Bool] -> Bool) -> Function m Json
evaluateArrayToBool (Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or))
some :: Operation m
some = ([Char]
"some", ([Bool] -> Bool) -> Function m Json
forall (m :: * -> *).
Monad m =>
([Bool] -> Bool) -> Function m Json
evaluateArrayToBool [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or)

merge, in' :: Monad m => Operation m
merge :: Operation m
merge = ([Char]
"merge", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateMerge)
in' :: Operation m
in' = ([Char]
"in", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateIn)

-- Evaluation for map

evaluateMap :: Monad m => Function m Json
evaluateMap :: Function m Json
evaluateMap SubEvaluator m
evaluator (JsonArray [Item [Json]
xs, Item [Json]
f]) Json
vars = do
  [Json]
xs' <- Function m [Json]
forall (m :: * -> *). Monad m => Function m [Json]
evaluateArray SubEvaluator m
evaluator Item [Json]
Json
xs Json
vars -- This is our data we evaluate

  [Json] -> Json
JsonArray ([Json] -> Json) -> ExceptT Exception m [Json] -> Result m Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Json -> Result m Json) -> [Json] -> ExceptT Exception m [Json]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SubEvaluator m
evaluator Item [Json]
Json
f) [Json]
xs'
evaluateMap SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Map received the wrong arguments"

evaluateReduce :: Monad m => Function m Json
evaluateReduce :: Function m Json
evaluateReduce SubEvaluator m
evaluator (JsonArray [Item [Json]
arrayExp, Item [Json]
reduceFunction, Item [Json]
initalExp]) Json
vars = do
  [Json]
array <- Function m [Json]
forall (m :: * -> *). Monad m => Function m [Json]
evaluateArray SubEvaluator m
evaluator Item [Json]
Json
arrayExp Json
vars
  Json
initial <- SubEvaluator m
evaluator Item [Json]
Json
initalExp Json
vars
  SubEvaluator m -> Json -> [Json] -> Result m Json
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Json
acc Json
cur -> SubEvaluator m
evaluator Item [Json]
Json
reduceFunction (JsonObject -> Json
JsonObject [([Char]
"current", Json
cur), ([Char]
"accumulator", Json
acc)])) Json
initial [Json]
array
evaluateReduce SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Wrong number of arguments for reduce"

evaluateFilter :: Monad m => Function m Json
evaluateFilter :: Function m Json
evaluateFilter SubEvaluator m
evaluator (JsonArray [Item [Json]
xs, Item [Json]
f]) Json
vars = do
  [Json]
array <- Function m [Json]
forall (m :: * -> *). Monad m => Function m [Json]
evaluateArray SubEvaluator m
evaluator Item [Json]
Json
xs Json
vars
  [Json]
filtered <- (Json -> ExceptT Exception m Bool)
-> [Json] -> ExceptT Exception m [Json]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool SubEvaluator m
evaluator Item [Json]
Json
f) [Json]
array
  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
$ [Json] -> Json
JsonArray [Json]
filtered
evaluateFilter SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Wrong number of arguments for filter"

evaluateArrayToBool :: Monad m => ([Bool] -> Bool) -> Function m Json
evaluateArrayToBool :: ([Bool] -> Bool) -> Function m Json
evaluateArrayToBool [Bool] -> Bool
operator SubEvaluator m
evaluator (JsonArray [Item [Json]
xs, Item [Json]
f]) Json
vars = do
  [Json]
xs' <- Function m [Json]
forall (m :: * -> *). Monad m => Function m [Json]
evaluateArray SubEvaluator m
evaluator Item [Json]
Json
xs Json
vars -- This is our data we evaluate

  [Bool]
bools <- (Json -> ExceptT Exception m Bool)
-> [Json] -> ExceptT Exception m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Function m Bool
forall (m :: * -> *). Monad m => Function m Bool
evaluateBool SubEvaluator m
evaluator Item [Json]
Json
f) [Json]
xs'
  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
operator [Bool]
bools
evaluateArrayToBool [Bool] -> Bool
_ SubEvaluator m
_ Json
_ Json
_ = [Char] -> Result m Json
forall (m :: * -> *) a. Monad m => [Char] -> Result m a
throw [Char]
"Map received the wrong arguments"

-- | Merge operations flattens the array in the top level

evaluateMerge :: Monad m => Function m Json
evaluateMerge :: Function m Json
evaluateMerge SubEvaluator m
evaluator Json
params Json
vars = do
  Json
res <- SubEvaluator m
evaluator Json
params Json
vars
  case Json
res of
    (JsonArray [Json]
js) -> 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
$ [Json] -> Json
JsonArray ([Json] -> Json) -> [Json] -> Json
forall a b. (a -> b) -> a -> b
$ (Json -> [Json] -> [Json]) -> [Json] -> [Json] -> [Json]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Json -> [Json] -> [Json]
merge' [] [Json]
js
    -- If we get a single item, it gets put in an array

    Json
json -> 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
$ [Json] -> Json
JsonArray [Item [Json]
Json
json]
  where
    merge' :: Json -> [Json] -> [Json]
merge' (JsonArray [Json]
as) [Json]
acc = [Json]
as [Json] -> [Json] -> [Json]
forall a. [a] -> [a] -> [a]
++ [Json]
acc
    merge' Json
j [Json]
acc = Json
j Json -> [Json] -> [Json]
forall a. a -> [a] -> [a]
: [Json]
acc

evaluateIn :: Monad m => Function m Json
evaluateIn :: Function m Json
evaluateIn SubEvaluator m
evaluator (JsonArray (Json
sub : Json
arr : [Json]
_)) Json
vars = do
  Json
sub' <- SubEvaluator m
evaluator Json
sub Json
vars
  Json
arr' <- SubEvaluator m
evaluator Json
arr 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
$ case (Json
sub', Json
arr') of
      (Json
el, JsonArray [Json]
xs) -> Json
el Json -> [Json] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Json]
xs
      (JsonString [Char]
substr, JsonString [Char]
s) -> [Char]
substr [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` [Char]
s
      (Json, Json)
_ -> Bool
False
evaluateIn SubEvaluator m
_ Json
_ Json
_ = 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
False