-- |

-- Module      : JsonLogic.Operation.Primitive

-- Description : Internal JsonLogic functions to evaluate to primitive types

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Operation.Primitive (evaluateDouble, evaluateInt, evaluateBool, evaluateArray, evaluateObject, evaluateString) where

import JsonLogic.Json
import JsonLogic.Type

-- Primitive evaluators

evaluateDouble :: Monad m => Function m Double
evaluateDouble :: Function m Double
evaluateDouble SubEvaluator m
evaluator Rule
param Rule
vars = do
  Rule
res <- SubEvaluator m
evaluator Rule
param Rule
vars
  Double -> Result m Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Result m Double) -> Double -> Result m Double
forall a b. (a -> b) -> a -> b
$ Rule -> Double
parseFloat Rule
res

evaluateInt :: Monad m => Function m Int
evaluateInt :: Function m Int
evaluateInt SubEvaluator m
evaluator Rule
param Rule
vars = do
  Double
res <- Function m Double
forall (m :: * -> *). Monad m => Function m Double
evaluateDouble SubEvaluator m
evaluator Rule
param Rule
vars
  if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
res
    then String -> Result m Int
forall (m :: * -> *) a. Monad m => String -> Result m a
throw String
"NotImplemented: NaN to int evaluation"
    else Int -> Result m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result m Int) -> Int -> Result m Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
res

evaluateBool :: Monad m => Function m Bool
evaluateBool :: Function m Bool
evaluateBool SubEvaluator m
evaluator Rule
param Rule
vars = do
  Rule
res <- SubEvaluator m
evaluator Rule
param Rule
vars
  Bool -> Result m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Result m Bool) -> Bool -> Result m Bool
forall a b. (a -> b) -> a -> b
$ Rule -> Bool
isTruthy Rule
res

evaluateArray :: Monad m => Function m [Json]
evaluateArray :: Function m [Rule]
evaluateArray SubEvaluator m
evaluator Rule
param Rule
vars = do
  Rule
res <- SubEvaluator m
evaluator Rule
param Rule
vars
  case Rule
res of
    JsonArray [Rule]
xs -> [Rule] -> Result m [Rule]
forall (m :: * -> *) a. Monad m => a -> m a
return [Rule]
xs
    Rule
j -> String -> Result m [Rule]
forall (m :: * -> *) a. Monad m => String -> Result m a
throw (String -> Result m [Rule]) -> String -> Result m [Rule]
forall a b. (a -> b) -> a -> b
$ String
"Invalid parameter type, was expecting array. Got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rule -> String
forall a. Show a => a -> String
show Rule
j

evaluateObject :: Monad m => Function m JsonObject
evaluateObject :: Function m JsonObject
evaluateObject SubEvaluator m
evaluator Rule
param Rule
vars = do
  Rule
res <- SubEvaluator m
evaluator Rule
param Rule
vars
  case Rule
res of
    JsonObject JsonObject
v -> JsonObject -> Result m JsonObject
forall (m :: * -> *) a. Monad m => a -> m a
return JsonObject
v
    Rule
j -> String -> Result m JsonObject
forall (m :: * -> *) a. Monad m => String -> Result m a
throw (String -> Result m JsonObject) -> String -> Result m JsonObject
forall a b. (a -> b) -> a -> b
$ String
"Invalid parameter type, was expecting object. Got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rule -> String
forall a. Show a => a -> String
show Rule
j

evaluateString :: Monad m => Function m String
evaluateString :: Function m String
evaluateString SubEvaluator m
evaluator Rule
param Rule
vars = do
  Rule
res <- SubEvaluator m
evaluator Rule
param Rule
vars
  String -> Result m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Result m String) -> String -> Result m String
forall a b. (a -> b) -> a -> b
$ Rule -> String
stringify Rule
res