{-# LANGUAGE OverloadedLists #-}

-- |

-- Module      : JsonLogic.Operation.String

-- Description : Internal JsonLogic operations on strings

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

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.Operation.String (stringOperations, cat, substr) where

import JsonLogic.Json
import JsonLogic.Operation.Primitive
import JsonLogic.Type

stringOperations :: Monad m => Operations m
stringOperations :: Operations m
stringOperations = [Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
cat, Item (Operations m)
forall (m :: * -> *). Monad m => Operation m
substr]

-- String Operations

cat, substr :: Monad m => Operation m
cat :: Operation m
cat = ([Char]
"cat", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateCat)
substr :: Operation m
substr = ([Char]
"substr", Function m Json
forall (m :: * -> *). Monad m => Function m Json
evaluateSubstr)

evaluateCat :: Monad m => Function m Json
evaluateCat :: Function m Json
evaluateCat SubEvaluator m
evaluator Json
args Json
vars = do
  Json
res <- SubEvaluator m
evaluator Json
args 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
$ [Char] -> Json
JsonString ([Char] -> Json) -> [Char] -> Json
forall a b. (a -> b) -> a -> b
$ (Json -> [Char]) -> [Json] -> [Char]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Json -> [Char]
stringify [Json]
js
    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
$ [Char] -> Json
JsonString ([Char] -> Json) -> [Char] -> Json
forall a b. (a -> b) -> a -> b
$ Json -> [Char]
stringify Json
json

-- | Evaluate substr operation

evaluateSubstr :: Monad m => Function m Json
evaluateSubstr :: Function m Json
evaluateSubstr SubEvaluator m
evaluator Json
param Json
vars = do
  Json
res <- SubEvaluator m
evaluator Json
param Json
vars
  [Char] -> Json
JsonString ([Char] -> Json) -> ExceptT Exception m [Char] -> Result m Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Json
res of
    -- Take everything from the index (can be negative)

    JsonArray [Item [Json]
s, Item [Json]
i] -> do
      [Char]
str <- Function m [Char]
forall (m :: * -> *). Monad m => Function m [Char]
evaluateString SubEvaluator m
evaluator Item [Json]
Json
s Json
vars
      Int
index <- Function m Int
forall (m :: * -> *). Monad m => Function m Int
evaluateInt SubEvaluator m
evaluator Item [Json]
Json
i Json
vars
      [Char] -> ExceptT Exception m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExceptT Exception m [Char])
-> [Char] -> ExceptT Exception m [Char]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> [Char]) -> Int -> [Char] -> [Char]
alterSubstr Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
index [Char]
str
    -- Take a part of the substring between the two indexes

    JsonArray (Json
s : Json
startI : Json
endI : [Json]
_) -> do
      [Char]
str <- Function m [Char]
forall (m :: * -> *). Monad m => Function m [Char]
evaluateString SubEvaluator m
evaluator Json
s Json
vars
      Int
startIndex <- Function m Int
forall (m :: * -> *). Monad m => Function m Int
evaluateInt SubEvaluator m
evaluator Json
startI Json
vars
      Int
endIndex <- Function m Int
forall (m :: * -> *). Monad m => Function m Int
evaluateInt SubEvaluator m
evaluator Json
endI Json
vars
      [Char] -> ExceptT Exception m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExceptT Exception m [Char])
-> [Char] -> ExceptT Exception m [Char]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> [Char]) -> Int -> [Char] -> [Char]
alterSubstr Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
endIndex ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> [Char]) -> Int -> [Char] -> [Char]
alterSubstr Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
startIndex [Char]
str
    -- No proper indexing arguments given, return the full json string

    Json
json -> Function m [Char]
forall (m :: * -> *). Monad m => Function m [Char]
evaluateString SubEvaluator m
evaluator Json
json Json
vars
  where
    -- Takes part of the substring given a positive or negative index

    alterSubstr :: (Int -> String -> String) -> Int -> String -> String
    alterSubstr :: (Int -> [Char] -> [Char]) -> Int -> [Char] -> [Char]
alterSubstr Int -> [Char] -> [Char]
f Int
index [Char]
str
      | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> [Char] -> [Char]
f Int
index [Char]
str
      | Bool
otherwise = Int -> [Char] -> [Char]
f ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index) [Char]
str