{-# LANGUAGE OverloadedLists #-}

-- |

-- Module      : JsonLogic.Operation.Data

-- Description : Internal JsonLogic operations on objects and data

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Operation.Data (dataOperations, var, missing, missingSome, preserve) where

import Data.Maybe
import JsonLogic.Json
import JsonLogic.Operation.Primitive
import JsonLogic.Operation.Utils
import JsonLogic.Type

dataOperations :: Monad m => Operations m
dataOperations :: Operations m
dataOperations = [Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
var, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
missing, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
missingSome, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
preserve]

var, missing, missingSome :: Monad m => Operation m
var :: Operation m
var = ([Char]
"var", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateVar)
missing :: Operation m
missing = ([Char]
"missing", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateMissing)
missingSome :: Operation m
missingSome = ([Char]
"missing_some", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateMissingSome)

preserve :: Monad m => Operation m
preserve :: Operation m
preserve = ([Char]
"preserve", \SubEvaluator m
_ Json
rule Json
_ -> Json -> ExceptT Exception m Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
rule)

-- Evaluates a var

evaluateVar :: Monad m => Function m Json
evaluateVar :: Function m Json
evaluateVar SubEvaluator m
evaluator Json
param Json
vars = do
  Json
res <- SubEvaluator m
evaluator Json
param Json
vars
  -- Extracts default value from array if it has one

  let (Json
j, Json
def) = Json -> (Json, Json)
getJsonWithDefault Json
res
  case Json
j of
    -- Indexing using a floored double or index object using a string

    i :: Json
i@(JsonNumber Double
_) -> 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 -> Maybe Json -> Json
forall a. a -> Maybe a -> a
fromMaybe Json
def (Maybe Json -> Json) -> Maybe Json -> Json
forall a b. (a -> b) -> a -> b
$ Json -> Json -> Maybe Json
indexWithJson Json
i Json
vars
    i :: Json
i@(JsonString [Char]
_) -> 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 -> Maybe Json -> Json
forall a. a -> Maybe a -> a
fromMaybe Json
def (Maybe Json -> Json) -> Maybe Json -> Json
forall a b. (a -> b) -> a -> b
$ Json -> Json -> Maybe Json
indexWithJson Json
i Json
vars
    -- null and empty array return the variables directly

    Json
JsonNull -> Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
vars
    JsonArray [] -> Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
vars
    -- Nested array, boolean and object always resort to default value

    Json
_ -> Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
def

-- | When var receives an array, the first item is the initial logic

-- If that logic fails then the second value is defaulted to

-- Any valuie after the second one is ignored

getJsonWithDefault :: Json -> (Json, Json)
getJsonWithDefault :: Json -> (Json, Json)
getJsonWithDefault (JsonArray (Json
x : Json
y : [Json]
_)) = (Json
x, Json
y)
getJsonWithDefault Json
j = (Json
j, Json
JsonNull)

-- | Evaluates which elements are missing from the Json

evaluateMissing :: Monad m => Function m Json
evaluateMissing :: Function m Json
evaluateMissing SubEvaluator m
evaluator Json
keys' Json
vars = do
  Json
keys <- SubEvaluator m
evaluator Json
keys' Json
vars
  -- Only keep the missing values in the json array

  Json -> Result m Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Result m Json)
-> ([Json] -> Json) -> [Json] -> Result m Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Json] -> Json
JsonArray ([Json] -> Result m Json) -> [Json] -> Result m Json
forall a b. (a -> b) -> a -> b
$ Json -> Json -> [Json]
missingKeys Json
keys Json
vars

-- | Evaluates whether more than x items are missing from the original array

-- If so, it returns the entire list of missing items

-- Otherwise it returns an empty list

evaluateMissingSome :: Monad m => Function m Json
evaluateMissingSome :: Function m Json
evaluateMissingSome SubEvaluator m
evaluator (JsonArray [Item [Json]
minKeys', Item [Json]
keys']) Json
vars = do
  Int
minKeys <- Function m Int
forall (m :: * -> *). Monad m => Function m Int
evaluateInt SubEvaluator m
evaluator Item [Json]
Json
minKeys' Json
vars
  Json
keys <- SubEvaluator m
evaluator Item [Json]
Json
keys' Json
vars
  let miss :: [Json]
miss = Json -> Json -> [Json]
missingKeys Json
keys Json
vars
  case Json
keys of
    -- Return result if at least x elements are missing or else an empty array

    JsonArray [Json]
js | [Json] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Json]
js Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Json] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Json]
miss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minKeys -> 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 []
    JsonArray [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 [Json]
miss
    -- If there is only a singleton as parameter, the length is 1

    Json
_ | Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Json] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Json]
miss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minKeys -> 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 -> 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]
miss
-- The parameters are invalid

evaluateMissingSome 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]
"Error: missing_some expects an array of two arguments, instead it got: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Json -> [Char]
forall a. Show a => a -> [Char]
show Json
json

-- | Returns the missing keys from the original array

missingKeys :: Json -> Data -> [Json]
missingKeys :: Json -> Json -> [Json]
missingKeys Json
keys Json
vars = [Json
key | Json
key <- Json -> [Json]
getKeys Json
keys, Maybe Json -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Json -> Bool) -> Maybe Json -> Bool
forall a b. (a -> b) -> a -> b
$ Json -> Json -> Maybe Json
indexWithJson Json
key Json
vars]
  where
    -- The keys used for our search

    getKeys :: Json -> [Json]
    getKeys :: Json -> [Json]
getKeys (JsonArray (arr :: Json
arr@(JsonArray [Json]
_) : [Json]
_)) = Json -> [Json]
getKeys Json
arr
    getKeys (JsonArray [Json]
js) = [Json]
js
    getKeys Json
j = [Item [Json]
Json
j]