{-# OPTIONS_GHC -Wno-unused-imports #-}

-- |

-- Module      : JsonLogic.Operation.Utils

-- Description : Internal JsonLogic operations utilities

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Operation.Utils where

-- IMPORTANT!! Needs singleton import for doctests

import qualified Data.Map as M
import JsonLogic.Json
import JsonLogic.Type
import Text.Read

-- | Index a json object using a string seperated by periods.

--

-- >>> indexWithJson (JsonString "x.y") (JsonObject $ M.singleton "x" $ JsonObject $ M.singleton "y" JsonNull)

-- Just null

--

-- >>> indexWithJson (JsonString "x.y") (JsonObject $ M.singleton "x" JsonNull)

-- Nothing

--

-- >>> indexWithJson (JsonString "") (JsonNumber 1)

-- Just 1.0

--

-- >>> indexWithJson (JsonString "1") (JsonArray [JsonString "abc", JsonString "def"])

-- Just "def"

--

-- >>> indexWithJson (JsonString "1.0") (JsonArray [JsonString "abc", JsonString "def"])

-- Just "d"

--

-- >>> indexWithJson (JsonString "abs") (JsonArray [JsonString "abc", JsonString "def"])

-- Nothing

indexWithJson :: Rule -> Data -> Maybe Json
indexWithJson :: Rule -> Rule -> Maybe Rule
indexWithJson (JsonString String
indexString) = [String] -> Rule -> Maybe Rule
indexWithString (String -> [String]
splitOnPeriod String
indexString)
indexWithJson (JsonNumber Double
indexNumber) = [String] -> Rule -> Maybe Rule
indexWithString [Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
indexNumber :: Int)]
indexWithJson Rule
_ = Maybe Rule -> Rule -> Maybe Rule
forall a b. a -> b -> a
const Maybe Rule
forall a. Maybe a
Nothing

indexWithString :: [String] -> Data -> Maybe Json
indexWithString :: [String] -> Rule -> Maybe Rule
indexWithString [] Rule
vars = Rule -> Maybe Rule
forall a. a -> Maybe a
Just Rule
vars
indexWithString [String
x] (JsonString String
s) =
  String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
x Maybe Int -> (Int -> Maybe Char) -> Maybe Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Maybe Char
forall a. [a] -> Int -> Maybe a
(!?) String
s Maybe Char -> (Char -> Maybe Rule) -> Maybe Rule
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rule -> Maybe Rule
forall a. a -> Maybe a
Just (Rule -> Maybe Rule) -> (Char -> Rule) -> Char -> Maybe Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rule
JsonString (String -> Rule) -> (Char -> String) -> Char -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
singleton
indexWithString (String
x : [String]
xs) (JsonArray [Rule]
js) =
  String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
x Maybe Int -> (Int -> Maybe Rule) -> Maybe Rule
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Rule] -> Int -> Maybe Rule
forall a. [a] -> Int -> Maybe a
(!?) [Rule]
js Maybe Rule -> (Rule -> Maybe Rule) -> Maybe Rule
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> Rule -> Maybe Rule
indexWithString [String]
xs
indexWithString (String
x : [String]
xs) (JsonObject JsonObject
o) = String -> JsonObject -> Maybe Rule
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
x JsonObject
o Maybe Rule -> (Rule -> Maybe Rule) -> Maybe Rule
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> Rule -> Maybe Rule
indexWithString [String]
xs
indexWithString [String]
_ Rule
_ = Maybe Rule
forall a. Maybe a
Nothing

-- | Splits string on periods

-- Same definition as words at: https://github.com/ghc/ghc/blob/master/libraries/base/Data/OldList.hs

--

-- >>> splitOnPeriod "foo.bar.tea"

-- ["foo","bar","tea"]

splitOnPeriod :: String -> [String]
splitOnPeriod :: String -> [String]
splitOnPeriod String
"" = []
splitOnPeriod String
s = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'.' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.==) String
s of
  String
"." -> []
  String
s' -> String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitOnPeriod String
s''
    where
      (String
w, String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
'.' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.==) String
s'

-- Safe indexing of a list

(!?) :: [a] -> Int -> Maybe a
[a]
_ !? :: [a] -> Int -> Maybe a
!? Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe a
forall a. Maybe a
Nothing
[] !? Int
_ = Maybe a
forall a. Maybe a
Nothing
(a
x : [a]
_) !? Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
(a
_ : [a]
xs) !? Int
n = [a]
xs [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
!? (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Returns the single item in a list if the argument is an array, otherwise returns the argument

-- If you like, we support syntactic sugar to skip the array around single arguments

-- Should only be used for unary operations.

--

-- >>> evaluateUnaryArgument $ JsonArray [JsonString "abc"]

-- "abc"

--

-- >>> evaluateUnaryArgument $ JsonString "abc"

-- "abc"

evaluateUnaryArgument :: Data -> Data
evaluateUnaryArgument :: Rule -> Rule
evaluateUnaryArgument (JsonArray [Rule
json]) = Rule
json
evaluateUnaryArgument Rule
json = Rule
json

-- | Put a single item in a list

-- Included in base since: base-4.15.0.0

-- But currently on older version.

--

-- >>> singleton "single value"

-- ["single value"]

singleton :: a -> [a]
singleton :: a -> [a]
singleton a
x = [a
x]