Data.hs

{-# 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 = [var, missing, missingSome, preserve]

var, missing, missingSome :: Monad m => Operation m
var = ("var", evaluateVar)
missing = ("missing", evaluateMissing)
missingSome = ("missing_some", evaluateMissingSome)

preserve :: Monad m => Operation m
preserve = ("preserve", \_ rule _ -> return rule)

-- Evaluates a var
evaluateVar :: Monad m => Function m Json
evaluateVar evaluator param vars = do
  res <- evaluator param vars
  -- Extracts default value from array if it has one
  let (j, def) = getJsonWithDefault res
  case j of
    -- Indexing using a floored double or index object using a string
    i@(JsonNumber _) -> return $ fromMaybe def $ indexWithJson i vars
    i@(JsonString _) -> return $ fromMaybe def $ indexWithJson i vars
    -- null and empty array return the variables directly
    JsonNull -> return vars
    JsonArray [] -> return vars
    -- Nested array, boolean and object always resort to default value
    _ -> return 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 (JsonArray (x : y : _)) = (x, y)
getJsonWithDefault j = (j, JsonNull)

-- | Evaluates which elements are missing from the Json
evaluateMissing :: Monad m => Function m Json
evaluateMissing evaluator keys' vars = do
  keys <- evaluator keys' vars
  -- Only keep the missing values in the json array
  return . JsonArray $ missingKeys keys 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 evaluator (JsonArray [minKeys', keys']) vars = do
  minKeys <- evaluateInt evaluator minKeys' vars
  keys <- evaluator keys' vars
  let miss = missingKeys keys vars
  case keys of
    -- Return result if at least x elements are missing or else an empty array
    JsonArray js | length js - length miss >= minKeys -> return $ JsonArray []
    JsonArray _ -> return $ JsonArray miss
    -- If there is only a singleton as parameter, the length is 1
    _ | 1 - length miss >= minKeys -> return $ JsonArray []
    _ -> return $ JsonArray miss
-- The parameters are invalid
evaluateMissingSome _ json _ = throw $ "Error: missing_some expects an array of two arguments, instead it got: " ++ show json

-- | Returns the missing keys from the original array
missingKeys :: Json -> Data -> [Json]
missingKeys keys vars = [key | key <- getKeys keys, isNothing $ indexWithJson key vars]
  where
    -- The keys used for our search
    getKeys :: Json -> [Json]
    getKeys (JsonArray (arr@(JsonArray _) : _)) = getKeys arr
    getKeys (JsonArray js) = js
    getKeys j = [j]