{-# LANGUAGE OverloadedLists #-}
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]
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
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
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
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
Json
json -> Function m [Char]
forall (m :: * -> *). Monad m => Function m [Char]
evaluateString SubEvaluator m
evaluator Json
json Json
vars
where
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