{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.JSONPath.Execute (executeJSONPath, executeJSONPathElement) where
import Data.Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as Map
import qualified Data.Foldable as Foldable
import Data.JSONPath.Types
import Data.Maybe (fromMaybe, isJust, maybeToList)
import Data.Text (Text)
import qualified Data.Vector as V
executeJSONPath :: [JSONPathElement] -> Value -> [Value]
executeJSONPath :: [JSONPathElement] -> Value -> [Value]
executeJSONPath [JSONPathElement]
path Value
rootVal = [JSONPathElement] -> Value -> [Value]
go [JSONPathElement]
path Value
rootVal
where
go :: [JSONPathElement] -> Value -> [Value]
go :: [JSONPathElement] -> Value -> [Value]
go [] Value
v = [Value
v]
go (JSONPathElement
j : [JSONPathElement]
js) Value
v =
[JSONPathElement] -> Value -> [Value]
go [JSONPathElement]
js (Value -> [Value]) -> [Value] -> [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSONPathElement -> Value -> Value -> [Value]
executeJSONPathElement JSONPathElement
j Value
rootVal Value
v
executeJSONPathElement :: JSONPathElement -> Value -> Value -> [Value]
executeJSONPathElement :: JSONPathElement -> Value -> Value -> [Value]
executeJSONPathElement (KeyChild Text
key) Value
_ Value
val =
Text -> Value -> [Value]
executeKeyChildOnValue Text
key Value
val
executeJSONPathElement JSONPathElement
AnyChild Value
_ Value
val =
case Value
val of
Object Object
o -> ((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)] -> [Value]) -> [(Key, Value)] -> [Value]
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
Map.toList Object
o
Array Array
a -> Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a
Value
_ -> []
executeJSONPathElement (IndexChild Int
i) Value
_ Value
val =
Int -> Value -> [Value]
executeIndexChildOnValue Int
i Value
val
executeJSONPathElement (Slice Maybe Int
start Maybe Int
end Maybe Int
step) Value
_ Value
val =
Maybe Int -> Maybe Int -> Maybe Int -> Value -> [Value]
executeSliceOnValue Maybe Int
start Maybe Int
end Maybe Int
step Value
val
executeJSONPathElement (Union [UnionElement]
elements) Value
_ Value
val =
(UnionElement -> [Value]) -> [UnionElement] -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((UnionElement -> Value -> [Value])
-> Value -> UnionElement -> [Value]
forall a b c. (a -> b -> c) -> b -> a -> c
flip UnionElement -> Value -> [Value]
executeUnionElement Value
val) [UnionElement]
elements
executeJSONPathElement (Filter FilterExpr
expr) Value
rootVal Value
val =
case Value
val of
Array Array
a -> FilterExpr -> Value -> [Value] -> [Value]
executeFilter FilterExpr
expr Value
rootVal (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a)
Object Object
o -> FilterExpr -> Value -> [Value] -> [Value]
executeFilter FilterExpr
expr Value
rootVal (Object -> [Value]
forall v. KeyMap v -> [v]
Map.elems Object
o)
Value
_ -> []
executeJSONPathElement s :: JSONPathElement
s@(Search [JSONPathElement]
js) Value
origVal Value
val =
let x :: [Value]
x = [JSONPathElement] -> Value -> [Value]
executeJSONPath [JSONPathElement]
js Value
val
y :: [Value]
y = [[Value]] -> [Value]
forall a. Monoid a => [a] -> a
mconcat ([[Value]] -> [Value]) -> [[Value]] -> [Value]
forall a b. (a -> b) -> a -> b
$ (Value -> [Value]) -> Value -> [[Value]]
forall b. ToJSON b => (Value -> [b]) -> Value -> [[b]]
valMap (JSONPathElement -> Value -> Value -> [Value]
executeJSONPathElement JSONPathElement
s Value
origVal) Value
val
in [Value]
x [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
y
valMap :: ToJSON b => (Value -> [b]) -> Value -> [[b]]
valMap :: (Value -> [b]) -> Value -> [[b]]
valMap Value -> [b]
f (Object Object
o) = ((Key, [b]) -> [b]) -> [(Key, [b])] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (Key, [b]) -> [b]
forall a b. (a, b) -> b
snd ([(Key, [b])] -> [[b]])
-> (KeyMap [b] -> [(Key, [b])]) -> KeyMap [b] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap [b] -> [(Key, [b])]
forall v. KeyMap v -> [(Key, v)]
Map.toList (KeyMap [b] -> [[b]]) -> KeyMap [b] -> [[b]]
forall a b. (a -> b) -> a -> b
$ (Value -> [b]) -> Object -> KeyMap [b]
forall a b. (a -> b) -> KeyMap a -> KeyMap b
Map.map Value -> [b]
f Object
o
valMap Value -> [b]
f (Array Array
a) = Vector [b] -> [[b]]
forall a. Vector a -> [a]
V.toList (Vector [b] -> [[b]]) -> Vector [b] -> [[b]]
forall a b. (a -> b) -> a -> b
$ (Value -> [b]) -> Array -> Vector [b]
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> [b]
f Array
a
valMap Value -> [b]
_ Value
_ = []
executeConditionOnMaybes :: Maybe Value -> Condition -> Maybe Value -> Bool
executeConditionOnMaybes :: Maybe Value -> Condition -> Maybe Value -> Bool
executeConditionOnMaybes (Just Value
val1) Condition
c (Just Value
val2) = Value -> Condition -> Value -> Bool
executeCondition Value
val1 Condition
c Value
val2
executeConditionOnMaybes Maybe Value
Nothing Condition
Equal Maybe Value
Nothing = Bool
True
executeConditionOnMaybes Maybe Value
Nothing Condition
GreaterThanOrEqual Maybe Value
Nothing = Bool
True
executeConditionOnMaybes Maybe Value
Nothing Condition
SmallerThanOrEqual Maybe Value
Nothing = Bool
True
executeConditionOnMaybes Maybe Value
Nothing Condition
NotEqual (Just Value
_) = Bool
True
executeConditionOnMaybes (Just Value
_) Condition
NotEqual Maybe Value
Nothing = Bool
True
executeConditionOnMaybes Maybe Value
_ Condition
_ Maybe Value
_ = Bool
False
isEqualTo :: Value -> Value -> Bool
(Object Object
_) isEqualTo :: Value -> Value -> Bool
`isEqualTo` Value
_ = Bool
False
Value
_ `isEqualTo` (Object Object
_) = Bool
False
(Array Array
_) `isEqualTo` Value
_ = Bool
False
Value
_ `isEqualTo` (Array Array
_) = Bool
False
Value
val1 `isEqualTo` Value
val2 = Value
val1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
val2
isSmallerThan :: Value -> Value -> Bool
(Number Scientific
n1) isSmallerThan :: Value -> Value -> Bool
`isSmallerThan` (Number Scientific
n2) = Scientific
n1 Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
n2
(String Text
s1) `isSmallerThan` (String Text
s2) = Text
s1 Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
< Text
s2
Value
_ `isSmallerThan` Value
_ = Bool
False
executeCondition :: Value -> Condition -> Value -> Bool
executeCondition :: Value -> Condition -> Value -> Bool
executeCondition Value
val1 Condition
NotEqual Value
val2 = Bool -> Bool
not (Value -> Condition -> Value -> Bool
executeCondition Value
val1 Condition
Equal Value
val2)
executeCondition Value
val1 Condition
Equal Value
val2 = Value
val1 Value -> Value -> Bool
`isEqualTo` Value
val2
executeCondition Value
val1 Condition
SmallerThan Value
val2 = Value
val1 Value -> Value -> Bool
`isSmallerThan` Value
val2
executeCondition Value
val1 Condition
GreaterThan Value
val2 =
Value -> Value -> Bool
canCompare Value
val1 Value
val2
Bool -> Bool -> Bool
&& Bool -> Bool
not (Value -> Condition -> Value -> Bool
executeCondition Value
val1 Condition
SmallerThan Value
val2)
Bool -> Bool -> Bool
&& Bool -> Bool
not (Value -> Condition -> Value -> Bool
executeCondition Value
val1 Condition
Equal Value
val2)
executeCondition Value
val Condition
GreaterThanOrEqual Value
lit =
Value -> Value -> Bool
canCompare Value
val Value
lit
Bool -> Bool -> Bool
&& Bool -> Bool
not (Value -> Condition -> Value -> Bool
executeCondition Value
val Condition
SmallerThan Value
lit)
executeCondition Value
val1 Condition
SmallerThanOrEqual Value
val2 =
Value -> Value -> Bool
canCompare Value
val1 Value
val2
Bool -> Bool -> Bool
&& Bool -> Bool
not (Value -> Condition -> Value -> Bool
executeCondition Value
val1 Condition
GreaterThan Value
val2)
canCompare :: Value -> Value -> Bool
canCompare :: Value -> Value -> Bool
canCompare (Number Scientific
_) (Number Scientific
_) = Bool
True
canCompare (String Text
_) (String Text
_) = Bool
True
canCompare Value
_ Value
_ = Bool
False
executeSliceOnValue :: Maybe Int -> Maybe Int -> Maybe Int -> Value -> [Value]
executeSliceOnValue :: Maybe Int -> Maybe Int -> Maybe Int -> Value -> [Value]
executeSliceOnValue Maybe Int
start Maybe Int
end Maybe Int
step Value
val =
case Value
val of
Array Array
a -> Maybe Int -> Maybe Int -> Maybe Int -> Array -> [Value]
forall a. Maybe Int -> Maybe Int -> Maybe Int -> Vector a -> [a]
executeSlice Maybe Int
start Maybe Int
end Maybe Int
step Array
a
Value
_ -> []
executeSlice :: forall a. Maybe Int -> Maybe Int -> Maybe Int -> V.Vector a -> [a]
executeSlice :: Maybe Int -> Maybe Int -> Maybe Int -> Vector a -> [a]
executeSlice Maybe Int
mStart Maybe Int
mEnd Maybe Int
mStep Vector a
v
| Int
step Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
| Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> [a]
postitiveStepLoop Int
lowerBound
| Bool
otherwise = Int -> [a]
negativeStepLoop Int
upperBound
where
postitiveStepLoop :: Int -> [a]
postitiveStepLoop :: Int -> [a]
postitiveStepLoop Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upperBound = Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
postitiveStepLoop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step)
| Bool
otherwise = []
negativeStepLoop :: Int -> [a]
negativeStepLoop :: Int -> [a]
negativeStepLoop Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lowerBound = Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
negativeStepLoop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step)
| Bool
otherwise = []
len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v
step :: Int
step = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mStep
normalizeIndex :: Int -> Int
normalizeIndex :: Int -> Int
normalizeIndex Int
i =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
i else Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
defaultStart :: Int
defaultStart
| Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int
0
| Bool
otherwise = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultStart Maybe Int
mStart
normalizedStart :: Int
normalizedStart = Int -> Int
normalizeIndex Int
start
defaultEnd :: Int
defaultEnd
| Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int
len
| Bool
otherwise = Int -> Int
forall a. Num a => a -> a
negate Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultEnd Maybe Int
mEnd
normalizedEnd :: Int
normalizedEnd = Int -> Int
normalizeIndex Int
end
lowerBound :: Int
lowerBound
| Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
normalizedStart Int
0) Int
len
| Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
normalizedEnd (-Int
1)) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
upperBound :: Int
upperBound
| Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
normalizedEnd Int
0) Int
len
| Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
normalizedStart (-Int
1)) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
executeIndexChild :: Int -> V.Vector a -> Maybe a
executeIndexChild :: Int -> Vector a -> Maybe a
executeIndexChild Int
i Vector a
v =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector a
v (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
else Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector a
v Int
i
executeUnionElement :: UnionElement -> Value -> [Value]
executeUnionElement :: UnionElement -> Value -> [Value]
executeUnionElement (UEIndexChild Int
i) Value
v = Int -> Value -> [Value]
executeIndexChildOnValue Int
i Value
v
executeUnionElement (UESlice Maybe Int
start Maybe Int
end Maybe Int
step) Value
v = Maybe Int -> Maybe Int -> Maybe Int -> Value -> [Value]
executeSliceOnValue Maybe Int
start Maybe Int
end Maybe Int
step Value
v
executeUnionElement (UEKeyChild Text
child) Value
v = Text -> Value -> [Value]
executeKeyChildOnValue Text
child Value
v
executeKeyChildOnValue :: Text -> Value -> [Value]
executeKeyChildOnValue :: Text -> Value -> [Value]
executeKeyChildOnValue Text
key Value
val =
Maybe Value -> [Value]
forall a. Maybe a -> [a]
maybeToList (Maybe Value -> [Value]) -> Maybe Value -> [Value]
forall a b. (a -> b) -> a -> b
$ SingularPathElement -> Value -> Maybe Value
executeSingularPathElement (Text -> SingularPathElement
Key Text
key) Value
val
executeIndexChildOnValue :: Int -> Value -> [Value]
executeIndexChildOnValue :: Int -> Value -> [Value]
executeIndexChildOnValue Int
i Value
val =
Maybe Value -> [Value]
forall a. Maybe a -> [a]
maybeToList (Maybe Value -> [Value]) -> Maybe Value -> [Value]
forall a b. (a -> b) -> a -> b
$ SingularPathElement -> Value -> Maybe Value
executeSingularPathElement (Int -> SingularPathElement
Index Int
i) Value
val
executeSingularPathElement :: SingularPathElement -> Value -> Maybe Value
executeSingularPathElement :: SingularPathElement -> Value -> Maybe Value
executeSingularPathElement (Key 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
Value
_ -> Maybe Value
forall a. Maybe a
Nothing
executeSingularPathElement (Index Int
i) Value
val =
case Value
val of
Array Array
a -> Int -> Array -> Maybe Value
forall a. Int -> Vector a -> Maybe a
executeIndexChild Int
i Array
a
Value
_ -> Maybe Value
forall a. Maybe a
Nothing
executeSingularPath :: SingularPath -> Value -> Value -> Maybe Value
executeSingularPath :: SingularPath -> Value -> Value -> Maybe Value
executeSingularPath (SingularPath BeginningPoint
beginnigPoint [SingularPathElement]
ps) Value
rootVal Value
currentVal =
let val :: Value
val = case BeginningPoint
beginnigPoint of
BeginningPoint
Root -> Value
rootVal
BeginningPoint
CurrentObject -> Value
currentVal
in (Maybe Value -> SingularPathElement -> Maybe Value)
-> Maybe Value -> [SingularPathElement] -> Maybe Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
( \case
Maybe Value
Nothing -> Maybe Value -> SingularPathElement -> Maybe Value
forall a b. a -> b -> a
const Maybe Value
forall a. Maybe a
Nothing
Just Value
v -> (SingularPathElement -> Value -> Maybe Value)
-> Value -> SingularPathElement -> Maybe Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip SingularPathElement -> Value -> Maybe Value
executeSingularPathElement Value
v
)
(Value -> Maybe Value
forall a. a -> Maybe a
Just Value
val)
[SingularPathElement]
ps
executeFilter :: FilterExpr -> Value -> [Value] -> [Value]
executeFilter :: FilterExpr -> Value -> [Value] -> [Value]
executeFilter FilterExpr
expr Value
rootVal = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
expr Value
rootVal)
comparableToValue :: Comparable -> Value -> Value -> Maybe Value
comparableToValue :: Comparable -> Value -> Value -> Maybe Value
comparableToValue (CmpNumber Scientific
n) Value
_ Value
_ = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
n
comparableToValue (CmpString Text
s) Value
_ Value
_ = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
s
comparableToValue (CmpBool Bool
b) Value
_ Value
_ = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Bool Bool
b
comparableToValue Comparable
CmpNull Value
_ Value
_ = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Null
comparableToValue (CmpPath SingularPath
p) Value
rootVal Value
val =
SingularPath -> Value -> Value -> Maybe Value
executeSingularPath SingularPath
p Value
rootVal Value
val
filterExprPred :: FilterExpr -> Value -> Value -> Bool
filterExprPred :: FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
expr Value
rootVal Value
val =
case FilterExpr
expr of
ComparisonExpr Comparable
cmp1 Condition
cond Comparable
cmp2 ->
let val1 :: Maybe Value
val1 = Comparable -> Value -> Value -> Maybe Value
comparableToValue Comparable
cmp1 Value
rootVal Value
val
val2 :: Maybe Value
val2 = Comparable -> Value -> Value -> Maybe Value
comparableToValue Comparable
cmp2 Value
rootVal Value
val
in Maybe Value -> Condition -> Maybe Value -> Bool
executeConditionOnMaybes Maybe Value
val1 Condition
cond Maybe Value
val2
ExistsExpr SingularPath
path ->
Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ SingularPath -> Value -> Value -> Maybe Value
executeSingularPath SingularPath
path Value
rootVal Value
val
Or FilterExpr
e1 FilterExpr
e2 ->
FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
e1 Value
rootVal Value
val Bool -> Bool -> Bool
|| FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
e2 Value
rootVal Value
val
And FilterExpr
e1 FilterExpr
e2 ->
FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
e1 Value
rootVal Value
val Bool -> Bool -> Bool
&& FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
e2 Value
rootVal Value
val
Not FilterExpr
e ->
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilterExpr -> Value -> Value -> Bool
filterExprPred FilterExpr
e Value
rootVal Value
val