{-# LANGUAGE CPP #-}
module Data.JSONPath.Execute
  (executeJSONPath, executeJSONPathEither, executeJSONPathElement)
where

import Data.Aeson
import Data.Aeson.Text
import Data.Function       ((&))
import qualified Data.Aeson.KeyMap as Map
import qualified Data.Aeson.Key as Key
import Data.JSONPath.Types
import Data.Text           (unpack)

#if !MIN_VERSION_base (4,11,0)
import Data.Semigroup ((<>))
#endif

import qualified Data.Text.Lazy as LazyText
import qualified Data.Vector    as V

executeJSONPath :: [JSONPathElement] -> Value -> ExecutionResult Value
executeJSONPath :: [JSONPathElement] -> Value -> ExecutionResult Value
executeJSONPath [] Value
val = String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError String
"empty json path"
executeJSONPath (JSONPathElement
j:[]) Value
val = JSONPathElement -> Value -> ExecutionResult Value
executeJSONPathElement JSONPathElement
j Value
val
executeJSONPath (JSONPathElement
j:[JSONPathElement]
js) Value
val = [JSONPathElement] -> Value -> ExecutionResult Value
executeJSONPath [JSONPathElement]
js (Value -> ExecutionResult Value)
-> ExecutionResult Value -> ExecutionResult Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSONPathElement -> Value -> ExecutionResult Value
executeJSONPathElement JSONPathElement
j Value
val

executeJSONPathEither :: [JSONPathElement] -> Value -> Either String [Value]
executeJSONPathEither :: [JSONPathElement] -> Value -> Either String [Value]
executeJSONPathEither [JSONPathElement]
js Value
val = ExecutionResult Value -> Either String [Value]
forall a. ExecutionResult a -> Either String [a]
resultToEither (ExecutionResult Value -> Either String [Value])
-> ExecutionResult Value -> Either String [Value]
forall a b. (a -> b) -> a -> b
$ [JSONPathElement] -> Value -> ExecutionResult Value
executeJSONPath [JSONPathElement]
js Value
val

executeJSONPathElement :: JSONPathElement -> Value -> ExecutionResult Value
executeJSONPathElement :: JSONPathElement -> Value -> ExecutionResult Value
executeJSONPathElement (KeyChild Text
key) Value
val =
  case Value
val of
    Object Object
o -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Map.lookup (Text -> Key
Key.fromText Text
key) Object
o
                Maybe Value
-> (Maybe Value -> ExecutionResult Value) -> ExecutionResult Value
forall a b. a -> (a -> b) -> b
& String -> Maybe Value -> ExecutionResult Value
forall a. String -> Maybe a -> ExecutionResult a
maybeToResult (Text -> Object -> String
forall a. ToJSON a => Text -> a -> String
notFoundErr Text
key Object
o)
    Value
_ -> String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError (String -> ExecutionResult Value)
-> String -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. ToJSON a => a -> String
expectedObjectErr Value
val
executeJSONPathElement JSONPathElement
AnyChild Value
val =
  case Value
val of
    Object Object
o -> [Value] -> ExecutionResult Value
forall a. [a] -> ExecutionResult a
ResultList ([Value] -> ExecutionResult Value)
-> ([(Key, Value)] -> [Value])
-> [(Key, Value)]
-> ExecutionResult Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Value) -> Value) -> [(Key, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Key, Value) -> Value
forall a b. (a, b) -> b
snd ([(Key, Value)] -> ExecutionResult Value)
-> [(Key, Value)] -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
Map.toList Object
o
    Array Array
a  -> [Value] -> ExecutionResult Value
forall a. [a] -> ExecutionResult a
ResultList ([Value] -> ExecutionResult Value)
-> [Value] -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a
    Value
_        -> String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError (String -> ExecutionResult Value)
-> String -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. ToJSON a => a -> String
expectedObjectErr Value
val
executeJSONPathElement (Slice SliceElement
slice) Value
val =
  case Value
val of
    Array Array
a -> SliceElement -> Array -> ExecutionResult Value
executeSliceElement SliceElement
slice Array
a
    Value
_       -> String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError (String -> ExecutionResult Value)
-> String -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. ToJSON a => a -> String
expectedArrayErr Value
val
executeJSONPathElement (SliceUnion SliceElement
first SliceElement
second) Value
val =
  case Value
val of
    Array Array
a -> ExecutionResult Value
-> ExecutionResult Value -> ExecutionResult Value
forall a.
ExecutionResult a -> ExecutionResult a -> ExecutionResult a
appendResults (SliceElement -> Array -> ExecutionResult Value
executeSliceElement SliceElement
first Array
a) (SliceElement -> Array -> ExecutionResult Value
executeSliceElement SliceElement
second Array
a)
    Value
_ -> String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError (String -> ExecutionResult Value)
-> String -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. ToJSON a => a -> String
expectedArrayErr Value
val
executeJSONPathElement (Filter BeginningPoint
_ [JSONPathElement]
jsonPath Condition
cond Literal
lit) Value
val =
  case Value
val of
    Array Array
a -> do
      let l :: [Value]
l = Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a
      [Value] -> ExecutionResult Value
forall a. [a] -> ExecutionResult a
ResultList ([Value] -> ExecutionResult Value)
-> [Value] -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ (Value -> ExecutionResult Value)
-> [Value] -> [ExecutionResult Value]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ([JSONPathElement] -> Value -> ExecutionResult Value
executeJSONPath [JSONPathElement]
jsonPath) [Value]
l
        [ExecutionResult Value]
-> ([ExecutionResult Value] -> [(Value, ExecutionResult Value)])
-> [(Value, ExecutionResult Value)]
forall a b. a -> (a -> b) -> b
& [Value]
-> [ExecutionResult Value] -> [(Value, ExecutionResult Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Value]
l
        [(Value, ExecutionResult Value)]
-> ([(Value, ExecutionResult Value)] -> [(Value, [Value])])
-> [(Value, [Value])]
forall a b. a -> (a -> b) -> b
& [(Value, ExecutionResult Value)] -> [(Value, [Value])]
forall c a. [(c, ExecutionResult a)] -> [(c, [a])]
excludeSndErrors
        [(Value, [Value])]
-> ([(Value, [Value])] -> [(Value, Value)]) -> [(Value, Value)]
forall a b. a -> (a -> b) -> b
& ((Value, [Value]) -> [(Value, Value)] -> [(Value, Value)])
-> [(Value, Value)] -> [(Value, [Value])] -> [(Value, Value)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (\(Value
x,[Value]
ys) [(Value, Value)]
acc -> if [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
ys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then (Value
x, [Value] -> Value
forall a. [a] -> a
head [Value]
ys)(Value, Value) -> [(Value, Value)] -> [(Value, Value)]
forall a. a -> [a] -> [a]
:[(Value, Value)]
acc else [(Value, Value)]
acc) []
        [(Value, Value)]
-> ([(Value, Value)] -> [(Value, Value)]) -> [(Value, Value)]
forall a b. a -> (a -> b) -> b
& ((Value, Value) -> Bool) -> [(Value, Value)] -> [(Value, Value)]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (\(Value
origVal, Value
exprVal) -> Value -> Condition -> Literal -> Bool
executeCondition Value
exprVal Condition
cond Literal
lit)
        [(Value, Value)] -> ([(Value, Value)] -> [Value]) -> [Value]
forall a b. a -> (a -> b) -> b
& ((Value, Value) -> Value) -> [(Value, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Value, Value) -> Value
forall a b. (a, b) -> a
fst
    Value
_ -> String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError (String -> ExecutionResult Value)
-> String -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. ToJSON a => a -> String
expectedArrayErr Value
val
executeJSONPathElement s :: JSONPathElement
s@(Search [JSONPathElement]
js) Value
val =
  let x :: [Value]
x = (String -> [Value])
-> ([Value] -> [Value]) -> Either String [Value] -> [Value]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Value] -> String -> [Value]
forall a b. a -> b -> a
const []) [Value] -> [Value]
forall a. a -> a
id (Either String [Value] -> [Value])
-> Either String [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ [JSONPathElement] -> Value -> Either String [Value]
executeJSONPathEither [JSONPathElement]
js Value
val
      y :: [Value]
y = [ExecutionResult Value] -> [Value]
forall a. [ExecutionResult a] -> [a]
excludeErrors ([ExecutionResult Value] -> [Value])
-> [ExecutionResult Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ (Value -> ExecutionResult Value)
-> Value -> [ExecutionResult Value]
forall b.
ToJSON b =>
(Value -> ExecutionResult b) -> Value -> [ExecutionResult b]
valMap (JSONPathElement -> Value -> ExecutionResult Value
executeJSONPathElement JSONPathElement
s) Value
val
  in if [Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Value]
x Bool -> Bool -> Bool
&& [Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Value]
y
     then String -> ExecutionResult Value
forall a. String -> ExecutionResult a
ResultError String
"Search failed"
     else [Value] -> ExecutionResult Value
forall a. [a] -> ExecutionResult a
ResultList ([Value] -> ExecutionResult Value)
-> [Value] -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ [Value]
x [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
y

valMap :: ToJSON b => (Value -> ExecutionResult b) -> Value -> [ExecutionResult b]
valMap :: (Value -> ExecutionResult b) -> Value -> [ExecutionResult b]
valMap Value -> ExecutionResult b
f v :: Value
v@(Object Object
o) = ((Key, ExecutionResult b) -> ExecutionResult b)
-> [(Key, ExecutionResult b)] -> [ExecutionResult b]
forall a b. (a -> b) -> [a] -> [b]
map (Key, ExecutionResult b) -> ExecutionResult b
forall a b. (a, b) -> b
snd ([(Key, ExecutionResult b)] -> [ExecutionResult b])
-> (KeyMap (ExecutionResult b) -> [(Key, ExecutionResult b)])
-> KeyMap (ExecutionResult b)
-> [ExecutionResult b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap (ExecutionResult b) -> [(Key, ExecutionResult b)]
forall v. KeyMap v -> [(Key, v)]
Map.toList (KeyMap (ExecutionResult b) -> [ExecutionResult b])
-> KeyMap (ExecutionResult b) -> [ExecutionResult b]
forall a b. (a -> b) -> a -> b
$ (Value -> ExecutionResult b)
-> Object -> KeyMap (ExecutionResult b)
forall a b. (a -> b) -> KeyMap a -> KeyMap b
Map.map Value -> ExecutionResult b
f Object
o
valMap Value -> ExecutionResult b
f (Array Array
a) = Vector (ExecutionResult b) -> [ExecutionResult b]
forall a. Vector a -> [a]
V.toList (Vector (ExecutionResult b) -> [ExecutionResult b])
-> Vector (ExecutionResult b) -> [ExecutionResult b]
forall a b. (a -> b) -> a -> b
$ (Value -> ExecutionResult b) -> Array -> Vector (ExecutionResult b)
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> ExecutionResult b
f Array
a
valMap Value -> ExecutionResult b
_ Value
v = ExecutionResult b -> [ExecutionResult b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutionResult b -> [ExecutionResult b])
-> ExecutionResult b -> [ExecutionResult b]
forall a b. (a -> b) -> a -> b
$ String -> ExecutionResult b
forall a. String -> ExecutionResult a
ResultError (String -> ExecutionResult b) -> String -> ExecutionResult b
forall a b. (a -> b) -> a -> b
$ String
"Expected object or array, found " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Value -> String
forall a. ToJSON a => a -> String
encodeJSONToString Value
v)

executeCondition :: Value -> Condition -> Literal -> Bool
executeCondition :: Value -> Condition -> Literal -> Bool
executeCondition (Number Scientific
n1) Condition
Equal (LitNumber Int
n2) = Scientific
n1 Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Integer -> Scientific
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n2)
executeCondition (String Text
s1) Condition
Equal (LitString Text
s2) = Text
s1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s2

executeSliceElement :: SliceElement -> V.Vector Value -> ExecutionResult Value
executeSliceElement :: SliceElement -> Array -> ExecutionResult Value
executeSliceElement (SingleIndex Int
i) Array
v                = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                                                          then String -> Maybe Value -> ExecutionResult Value
forall a. String -> Maybe a -> ExecutionResult a
maybeToResult (Int -> Array -> String
forall a a. (Show a, ToJSON a) => a -> a -> String
invalidIndexErr Int
i Array
v) (Maybe Value -> ExecutionResult Value)
-> Maybe Value -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
v (Array -> Int
forall a. Vector a -> Int
V.length Array
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
                                                          else String -> Maybe Value -> ExecutionResult Value
forall a. String -> Maybe a -> ExecutionResult a
maybeToResult (Int -> Array -> String
forall a a. (Show a, ToJSON a) => a -> a -> String
invalidIndexErr Int
i Array
v) (Maybe Value -> ExecutionResult Value)
-> Maybe Value -> ExecutionResult Value
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Array
v Int
i
executeSliceElement (SimpleSlice Int
start Int
end) Array
v        = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
start Int
end Int
1
executeSliceElement (SliceWithStep Int
start Int
end Int
step) Array
v = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
start Int
end Int
step
executeSliceElement (SliceTo Int
end) Array
v                  = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
0 Int
end Int
1
executeSliceElement (SliceToWithStep Int
end Int
step) Array
v     = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
0 Int
end Int
step
executeSliceElement (SliceFrom Int
start) Array
v              = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
start (-Int
1) Int
1
executeSliceElement (SliceFromWithStep Int
start Int
step) Array
v = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
start (-Int
1) Int
step
executeSliceElement (SliceWithOnlyStep Int
step) Array
v       = Array -> Int -> Int -> Int -> ExecutionResult Value
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Array
v Int
0 (-Int
1) Int
step

sliceEither :: ToJSON a
    => V.Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither :: Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Vector a
v Int
start Int
end Int
step = let len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v
                                   realStart :: Int
realStart = if Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start else Int
start
                                   realEnd :: Int
realEnd = if Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
end
                               in if Int
realStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
realEnd
                                  then ExecutionResult a -> ExecutionResult a -> ExecutionResult a
forall a.
ExecutionResult a -> ExecutionResult a -> ExecutionResult a
appendResults (Vector a -> Int -> ExecutionResult a
forall a. ToJSON a => Vector a -> Int -> ExecutionResult a
indexEither Vector a
v Int
realStart) (Vector a -> Int -> Int -> Int -> ExecutionResult a
forall a.
ToJSON a =>
Vector a -> Int -> Int -> Int -> ExecutionResult a
sliceEither Vector a
v (Int
realStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step) Int
realEnd Int
step)
                                  else [a] -> ExecutionResult a
forall a. [a] -> ExecutionResult a
ResultList []

indexEither :: ToJSON a => V.Vector a -> Int -> ExecutionResult a
indexEither :: Vector a -> Int -> ExecutionResult a
indexEither Vector a
v Int
i = Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector a
v Int
i
                  Maybe a -> (Maybe a -> ExecutionResult a) -> ExecutionResult a
forall a b. a -> (a -> b) -> b
& String -> Maybe a -> ExecutionResult a
forall a. String -> Maybe a -> ExecutionResult a
maybeToResult (Int -> Vector a -> String
forall a a. (Show a, ToJSON a) => a -> a -> String
invalidIndexErr Int
i Vector a
v)

excludeSndErrors :: [(c, ExecutionResult a)] -> [(c, [a])]
excludeSndErrors :: [(c, ExecutionResult a)] -> [(c, [a])]
excludeSndErrors [(c, ExecutionResult a)]
xs = ((c, ExecutionResult a) -> [(c, [a])] -> [(c, [a])])
-> [(c, [a])] -> [(c, ExecutionResult a)] -> [(c, [a])]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (c, ExecutionResult a) -> [(c, [a])] -> [(c, [a])]
forall a a. (a, ExecutionResult a) -> [(a, [a])] -> [(a, [a])]
accumulateFn ([] :: [(c, b)]) [(c, ExecutionResult a)]
xs where
  accumulateFn :: (a, ExecutionResult a) -> [(a, [a])] -> [(a, [a])]
accumulateFn (a
x, ResultList [a]
ys) [(a, [a])]
acc = (a
x, [a]
ys)(a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
:[(a, [a])]
acc
  accumulateFn (a
x, ResultValue a
y) [(a, [a])]
acc = (a
x, [a
y])(a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
:[(a, [a])]
acc
  accumulateFn (a
x, ExecutionResult a
_) [(a, [a])]
acc             = [(a, [a])]
acc

encodeJSONToString :: ToJSON a => a -> String
encodeJSONToString :: a -> String
encodeJSONToString a
x = Text -> String
LazyText.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText a
x

notFoundErr :: Text -> a -> String
notFoundErr Text
key a
o = String
"expected key " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in object " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (a -> String
forall a. ToJSON a => a -> String
encodeJSONToString a
o)
invalidIndexErr :: a -> a -> String
invalidIndexErr a
i a
a = String
"index " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" invalid for array " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (a -> String
forall a. ToJSON a => a -> String
encodeJSONToString a
a)
expectedObjectErr :: a -> String
expectedObjectErr a
val = String
"expected object, found " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (a -> String
forall a. ToJSON a => a -> String
encodeJSONToString a
val)
expectedArrayErr :: a -> String
expectedArrayErr a
val = String
"expected array, found " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (a -> String
forall a. ToJSON a => a -> String
encodeJSONToString a
val)