{-# 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

{- ORMOLU_DISABLE -}
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
{- ORMOLU_ENABLE -}

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
_ -> []

-- | Implementation is based on
-- https://ietf-wg-jsonpath.github.io/draft-ietf-jsonpath-base/draft-ietf-jsonpath-base.html#name-array-slice-selector
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