{-# LANGUAGE RecordWildCards #-}
{- |
Module      : Data.Aeson.JSONPath.Query
Description : Algorithm for query runner
Copyright   : (c) 2024-2025 Taimoor Zaeem
License     : MIT
Maintainer  : Taimoor Zaeem <mtaimoorzaeem@gmail.com>
Stability   : Experimental
Portability : Portable

This module contains core functions that runs the query on 'Value'.
-}
module Data.Aeson.JSONPath.Query
  ( Queryable (..) )
  where

import Control.Monad                   (join)
import Data.Aeson                      (Value)
import Data.Vector                     (Vector)

import qualified Data.Aeson            as JSON
import qualified Data.Aeson.KeyMap     as KM
import qualified Data.Aeson.Key        as K
import qualified Data.Text             as T
import qualified Data.Vector           as V

import Data.Aeson.JSONPath.Query.Types

import Prelude

-- |
class Queryable a where
  query'        :: a -> Value -> Value -> Vector Value
  queryLocated' :: a -> Value -> Value -> String -> Vector (String,Value)

instance Queryable Query where
  query' :: Query -> Value -> Value -> Vector Value
query'        = Query -> Value -> Value -> Vector Value
qQuery
  queryLocated' :: Query -> Value -> Value -> [Char] -> Vector ([Char], Value)
queryLocated' = Query -> Value -> Value -> [Char] -> Vector ([Char], Value)
qQueryLocated

instance Queryable QuerySegment where
  query' :: QuerySegment -> Value -> Value -> Vector Value
query'        = QuerySegment -> Value -> Value -> Vector Value
qQuerySegment
  queryLocated' :: QuerySegment -> Value -> Value -> [Char] -> Vector ([Char], Value)
queryLocated' = QuerySegment -> Value -> Value -> [Char] -> Vector ([Char], Value)
qQuerySegmentLocated

instance Queryable Segment where
  query' :: Segment -> Value -> Value -> Vector Value
query'        = Segment -> Value -> Value -> Vector Value
qSegment
  queryLocated' :: Segment -> Value -> Value -> [Char] -> Vector ([Char], Value)
queryLocated' = Segment -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSegmentLocated

instance Queryable Selector where
  query' :: Selector -> Value -> Value -> Vector Value
query'        = Selector -> Value -> Value -> Vector Value
qSelector
  queryLocated' :: Selector -> Value -> Value -> [Char] -> Vector ([Char], Value)
queryLocated' = Selector -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSelectorLocated

-- TODO: the whole module is kinda bloated, refactor
--    Blockers with refactoring: qQuery is used recursively

qQuery :: Query -> Value -> Value -> Vector Value
qQuery :: Query -> Value -> Value -> Vector Value
qQuery Query{[QuerySegment]
QueryType
queryType :: QueryType
querySegments :: [QuerySegment]
queryType :: Query -> QueryType
querySegments :: Query -> [QuerySegment]
..} Value
root Value
current = case QueryType
queryType of
  QueryType
Root    -> (Vector Value -> QuerySegment -> Vector Value)
-> Vector Value -> [QuerySegment] -> Vector Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Vector Value -> QuerySegment -> Vector Value
applySegment (Value -> Vector Value
forall a. a -> Vector a
V.singleton Value
root)    [QuerySegment]
querySegments
  QueryType
Current -> (Vector Value -> QuerySegment -> Vector Value)
-> Vector Value -> [QuerySegment] -> Vector Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Vector Value -> QuerySegment -> Vector Value
applySegment (Value -> Vector Value
forall a. a -> Vector a
V.singleton Value
current) [QuerySegment]
querySegments
  where
    applySegment :: Vector Value -> QuerySegment -> Vector Value
    applySegment :: Vector Value -> QuerySegment -> Vector Value
applySegment Vector Value
vec QuerySegment
seg = Vector (Vector Value) -> Vector Value
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Vector (Vector Value) -> Vector Value)
-> Vector (Vector Value) -> Vector Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Value) -> Vector Value -> Vector (Vector Value)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (QuerySegment -> Value -> Value -> Vector Value
qQuerySegment QuerySegment
seg Value
root) Vector Value
vec

qQueryLocated :: Query -> Value -> Value -> String -> Vector (String,Value)
qQueryLocated :: Query -> Value -> Value -> [Char] -> Vector ([Char], Value)
qQueryLocated Query{[QuerySegment]
QueryType
queryType :: Query -> QueryType
querySegments :: Query -> [QuerySegment]
queryType :: QueryType
querySegments :: [QuerySegment]
..} Value
root Value
current [Char]
loc = case QueryType
queryType of
  QueryType
Root    -> (Vector ([Char], Value) -> QuerySegment -> Vector ([Char], Value))
-> Vector ([Char], Value)
-> [QuerySegment]
-> Vector ([Char], Value)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Vector ([Char], Value) -> QuerySegment -> Vector ([Char], Value)
applySegment (([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
loc,Value
root))    [QuerySegment]
querySegments
  QueryType
Current -> (Vector ([Char], Value) -> QuerySegment -> Vector ([Char], Value))
-> Vector ([Char], Value)
-> [QuerySegment]
-> Vector ([Char], Value)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Vector ([Char], Value) -> QuerySegment -> Vector ([Char], Value)
applySegment (([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
loc,Value
current)) [QuerySegment]
querySegments
  where
    applySegment :: Vector (String,Value) -> QuerySegment -> Vector (String,Value)
    applySegment :: Vector ([Char], Value) -> QuerySegment -> Vector ([Char], Value)
applySegment Vector ([Char], Value)
vec QuerySegment
seg = Vector (Vector ([Char], Value)) -> Vector ([Char], Value)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Vector (Vector ([Char], Value)) -> Vector ([Char], Value))
-> Vector (Vector ([Char], Value)) -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ (([Char], Value) -> Vector ([Char], Value))
-> Vector ([Char], Value) -> Vector (Vector ([Char], Value))
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\([Char]
location,Value
cur) -> QuerySegment -> Value -> Value -> [Char] -> Vector ([Char], Value)
qQuerySegmentLocated QuerySegment
seg Value
root Value
cur [Char]
location) Vector ([Char], Value)
vec

qQuerySegment :: QuerySegment -> Value -> Value -> Vector Value
qQuerySegment :: QuerySegment -> Value -> Value -> Vector Value
qQuerySegment QuerySegment{Segment
SegmentType
segmentType :: SegmentType
segment :: Segment
segmentType :: QuerySegment -> SegmentType
segment :: QuerySegment -> Segment
..} Value
root Value
current = case SegmentType
segmentType of
  SegmentType
Child      -> Vector Value -> Vector Value
joinAfterMap (Vector Value -> Vector Value) -> Vector Value -> Vector Value
forall a b. (a -> b) -> a -> b
$ Value -> Vector Value
forall a. a -> Vector a
V.singleton Value
current
  SegmentType
Descendant -> Vector Value -> Vector Value
joinAfterMap (Vector Value -> Vector Value) -> Vector Value -> Vector Value
forall a b. (a -> b) -> a -> b
$ Value -> Vector Value
allElemsRecursive Value
current
  where
    joinAfterMap :: Vector Value -> Vector Value
joinAfterMap Vector Value
x = Vector (Vector Value) -> Vector Value
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Vector (Vector Value) -> Vector Value)
-> Vector (Vector Value) -> Vector Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Value) -> Vector Value -> Vector (Vector Value)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Segment -> Value -> Value -> Vector Value
qSegment Segment
segment Value
root) Vector Value
x

qQuerySegmentLocated :: QuerySegment -> Value -> Value -> String -> Vector (String, Value)
qQuerySegmentLocated :: QuerySegment -> Value -> Value -> [Char] -> Vector ([Char], Value)
qQuerySegmentLocated QuerySegment{Segment
SegmentType
segmentType :: QuerySegment -> SegmentType
segment :: QuerySegment -> Segment
segmentType :: SegmentType
segment :: Segment
..} Value
root Value
current [Char]
loc = case SegmentType
segmentType of
  SegmentType
Child      -> Vector ([Char], Value) -> Vector ([Char], Value)
joinAfterMap (Vector ([Char], Value) -> Vector ([Char], Value))
-> Vector ([Char], Value) -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ ([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
loc,Value
current)
  SegmentType
Descendant -> Vector ([Char], Value) -> Vector ([Char], Value)
joinAfterMap (Vector ([Char], Value) -> Vector ([Char], Value))
-> Vector ([Char], Value) -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ ([Char], Value) -> Vector ([Char], Value)
allElemsRecursiveLocated ([Char]
loc,Value
current)
  where
    joinAfterMap :: Vector ([Char], Value) -> Vector ([Char], Value)
joinAfterMap Vector ([Char], Value)
x = Vector (Vector ([Char], Value)) -> Vector ([Char], Value)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Vector (Vector ([Char], Value)) -> Vector ([Char], Value))
-> Vector (Vector ([Char], Value)) -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ (([Char], Value) -> Vector ([Char], Value))
-> Vector ([Char], Value) -> Vector (Vector ([Char], Value))
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\([Char]
location,Value
cur) -> Segment -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSegmentLocated Segment
segment Value
root Value
cur [Char]
location) Vector ([Char], Value)
x

qSegment :: Segment -> Value -> Value -> Vector Value
qSegment :: Segment -> Value -> Value -> Vector Value
qSegment (Bracketed [Selector]
sels) Value
root Value
current = [Vector Value] -> Vector Value
forall a. [Vector a] -> Vector a
V.concat ([Vector Value] -> Vector Value) -> [Vector Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ (Selector -> Vector Value) -> [Selector] -> [Vector Value]
forall a b. (a -> b) -> [a] -> [b]
map (\Selector
sel -> Selector -> Value -> Value -> Vector Value
qSelector Selector
sel Value
root Value
current) [Selector]
sels
qSegment (Dotted Text
key) Value
root Value
current = Selector -> Value -> Value -> Vector Value
qSelector (Text -> Selector
Name Text
key) Value
root Value
current
qSegment Segment
WildcardSegment Value
root Value
current = Selector -> Value -> Value -> Vector Value
qSelector Selector
WildcardSelector Value
root Value
current

qSegmentLocated :: Segment -> Value -> Value -> String -> Vector (String,Value)
qSegmentLocated :: Segment -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSegmentLocated (Bracketed [Selector]
sels) Value
root Value
current [Char]
loc = [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a. [Vector a] -> Vector a
V.concat ([Vector ([Char], Value)] -> Vector ([Char], Value))
-> [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ (Selector -> Vector ([Char], Value))
-> [Selector] -> [Vector ([Char], Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\Selector
sel -> Selector -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSelectorLocated Selector
sel Value
root Value
current [Char]
loc) [Selector]
sels
qSegmentLocated (Dotted Text
key) Value
root Value
current [Char]
loc = Selector -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSelectorLocated (Text -> Selector
Name Text
key) Value
root Value
current [Char]
loc
qSegmentLocated Segment
WildcardSegment Value
root Value
current [Char]
loc = Selector -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSelectorLocated Selector
WildcardSelector Value
root Value
current [Char]
loc


-- TODO: Looks kinda ugly, make it pretty <3
allElemsRecursive :: Value -> Vector Value
allElemsRecursive :: Value -> Vector Value
allElemsRecursive o :: Value
o@(JSON.Object Object
obj) = [Vector Value] -> Vector Value
forall a. [Vector a] -> Vector a
V.concat [
    Value -> Vector Value
forall a. a -> Vector a
V.singleton Value
o,
    [Vector Value] -> Vector Value
forall a. [Vector a] -> Vector a
V.concat ([Vector Value] -> Vector Value) -> [Vector Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Value) -> [Value] -> [Vector Value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Vector Value
allElemsRecursive (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj)
  ]
allElemsRecursive a :: Value
a@(JSON.Array Vector Value
arr) = [Vector Value] -> Vector Value
forall a. [Vector a] -> Vector a
V.concat [
    Value -> Vector Value
forall a. a -> Vector a
V.singleton Value
a,
    [Vector Value] -> Vector Value
forall a. [Vector a] -> Vector a
V.concat ([Vector Value] -> Vector Value) -> [Vector Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Value) -> [Value] -> [Vector Value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Vector Value
allElemsRecursive (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
arr)
  ]
allElemsRecursive Value
_ = Vector Value
forall a. Vector a
V.empty

-- TODO: Looks kinda ugly, make it pretty <3
allElemsRecursiveLocated :: (String,Value) -> Vector (String,Value)
allElemsRecursiveLocated :: ([Char], Value) -> Vector ([Char], Value)
allElemsRecursiveLocated ([Char]
loc, o :: Value
o@(JSON.Object Object
obj)) = [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a. [Vector a] -> Vector a
V.concat [
    ([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
loc,Value
o),
    [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a. [Vector a] -> Vector a
V.concat ([Vector ([Char], Value)] -> Vector ([Char], Value))
-> [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ ([Char] -> Value -> Vector ([Char], Value))
-> [[Char]] -> [Value] -> [Vector ([Char], Value)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((([Char], Value) -> Vector ([Char], Value))
-> [Char] -> Value -> Vector ([Char], Value)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ([Char], Value) -> Vector ([Char], Value)
allElemsRecursiveLocated) (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj)) [Char]
loc) (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj)
  ]
allElemsRecursiveLocated ([Char]
loc, a :: Value
a@(JSON.Array Vector Value
arr)) = [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a. [Vector a] -> Vector a
V.concat [
    ([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
loc,Value
a),
    [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a. [Vector a] -> Vector a
V.concat ([Vector ([Char], Value)] -> Vector ([Char], Value))
-> [Vector ([Char], Value)] -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ ([Char] -> Value -> Vector ([Char], Value))
-> [[Char]] -> [Value] -> [Vector ([Char], Value)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((([Char], Value) -> Vector ([Char], Value))
-> [Char] -> Value -> Vector ([Char], Value)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ([Char], Value) -> Vector ([Char], Value)
allElemsRecursiveLocated) (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
arr) [Char]
loc) (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
arr)
  ]
allElemsRecursiveLocated ([Char], Value)
_ = Vector ([Char], Value)
forall a. Vector a
V.empty


qSelector :: Selector -> Value -> Value -> Vector Value
qSelector :: Selector -> Value -> Value -> Vector Value
qSelector (Name Text
key) Value
_ (JSON.Object Object
obj) = Vector Value
-> (Value -> Vector Value) -> Maybe Value -> Vector Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector Value
forall a. Vector a
V.empty  Value -> Vector Value
forall a. a -> Vector a
V.singleton (Maybe Value -> Vector Value) -> Maybe Value -> Vector Value
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
K.fromText Text
key) Object
obj
qSelector (Name Text
_) Value
_ Value
_ = Vector Value
forall a. Vector a
V.empty
qSelector (Index Int
idx) Value
_ (JSON.Array Vector Value
arr) = Vector Value
-> (Value -> Vector Value) -> Maybe Value -> Vector Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector Value
forall a. Vector a
V.empty Value -> Vector Value
forall a. a -> Vector a
V.singleton (Maybe Value -> Vector Value) -> Maybe Value -> Vector Value
forall a b. (a -> b) -> a -> b
$ if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector Value
arr Int
idx else Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector Value
arr (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
arr)
qSelector (Index Int
_) Value
_ Value
_ = Vector Value
forall a. Vector a
V.empty
qSelector (ArraySlice (Maybe Int, Maybe Int, Int)
startEndStep) Value
_ (JSON.Array Vector Value
arr) = (Maybe Int, Maybe Int, Int) -> Vector Value -> Vector Value
sliceArray (Maybe Int, Maybe Int, Int)
startEndStep Vector Value
arr
qSelector (ArraySlice (Maybe Int, Maybe Int, Int)
_) Value
_ Value
_ = Vector Value
forall a. Vector a
V.empty
qSelector (Filter LogicalOrExpr
orExpr) Value
root Value
current = LogicalOrExpr -> Value -> Value -> Vector Value
filterOrExpr LogicalOrExpr
orExpr Value
root Value
current
qSelector Selector
WildcardSelector Value
_ Value
cur = case Value
cur of
    (JSON.Object Object
obj) -> [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value) -> [Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj
    (JSON.Array Vector Value
arr)  -> Vector Value
arr
    Value
_                 -> Vector Value
forall a. Vector a
V.empty

qSelectorLocated :: Selector -> Value -> Value -> String -> Vector (String,Value)
qSelectorLocated :: Selector -> Value -> Value -> [Char] -> Vector ([Char], Value)
qSelectorLocated (Name Text
key) Value
_ (JSON.Object Object
obj) [Char]
loc = Vector ([Char], Value)
-> (Value -> Vector ([Char], Value))
-> Maybe Value
-> Vector ([Char], Value)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector ([Char], Value)
forall a. Vector a
V.empty (\Value
x-> ([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"['" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"']", Value
x)) (Maybe Value -> Vector ([Char], Value))
-> Maybe Value -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
K.fromText Text
key) Object
obj
qSelectorLocated (Name Text
_) Value
_ Value
_ [Char]
_ = Vector ([Char], Value)
forall a. Vector a
V.empty
qSelectorLocated (Index Int
idx) Value
_ (JSON.Array Vector Value
arr) [Char]
loc = Vector ([Char], Value)
-> (Value -> Vector ([Char], Value))
-> Maybe Value
-> Vector ([Char], Value)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vector ([Char], Value)
forall a. Vector a
V.empty (\Value
x-> ([Char], Value) -> Vector ([Char], Value)
forall a. a -> Vector a
V.singleton ([Char]
newLocation, Value
x)) (Maybe Value -> Vector ([Char], Value))
-> Maybe Value -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector Value
arr (Int -> Int
getIndex Int
idx)
  where
    newLocation :: [Char]
newLocation = [Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
getIndex Int
idx) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
    getIndex :: Int -> Int
getIndex Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
i else Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
arr
qSelectorLocated (Index Int
_) Value
_ Value
_ [Char]
_ = Vector ([Char], Value)
forall a. Vector a
V.empty
qSelectorLocated (ArraySlice (Maybe Int
start,Maybe Int
end,Int
step)) Value
_ (JSON.Array Vector Value
arr) [Char]
loc = (Maybe Int, Maybe Int, Int)
-> Vector ([Char], Value) -> Vector ([Char], Value)
sliceArrayLocated (Maybe Int
start,Maybe Int
end,Int
step) (Vector ([Char], Value) -> Vector ([Char], Value))
-> Vector ([Char], Value) -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ Vector [Char] -> Vector Value -> Vector ([Char], Value)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip ([[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList [[Char]]
locs) Vector Value
arr
  where
    locs :: [[Char]]
locs = [ [Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]" | Int
i <- [Int]
indices ]
    indices :: [Int]
indices = [Int
0..(Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
qSelectorLocated (ArraySlice (Maybe Int, Maybe Int, Int)
_) Value
_ Value
_ [Char]
_ = Vector ([Char], Value)
forall a. Vector a
V.empty
qSelectorLocated (Filter LogicalOrExpr
orExpr) Value
root Value
cur [Char]
loc = LogicalOrExpr -> Value -> Value -> [Char] -> Vector ([Char], Value)
filterOrExprLocated LogicalOrExpr
orExpr Value
root Value
cur [Char]
loc
qSelectorLocated Selector
WildcardSelector Value
_ Value
cur [Char]
loc = case Value
cur of
    (JSON.Object Object
obj) -> [([Char], Value)] -> Vector ([Char], Value)
forall a. [a] -> Vector a
V.fromList ([([Char], Value)] -> Vector ([Char], Value))
-> [([Char], Value)] -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Value] -> [([Char], Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Object -> [[Char]]
forall {v}. KeyMap v -> [[Char]]
locsWithKeys Object
obj) (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj)
    (JSON.Array Vector Value
arr)  -> Vector [Char] -> Vector Value -> Vector ([Char], Value)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip ([[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList (Vector Value -> [[Char]]
forall {a}. Vector a -> [[Char]]
locsWithIdxs Vector Value
arr)) Vector Value
arr
    Value
_                 -> Vector ([Char], Value)
forall a. Vector a
V.empty
    where
      locsWithKeys :: KeyMap v -> [[Char]]
locsWithKeys KeyMap v
obj = (Key -> [Char]) -> [Key] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Key
x -> [Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"['" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Key -> [Char]
K.toString Key
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"']") (KeyMap v -> [Key]
forall v. KeyMap v -> [Key]
KM.keys KeyMap v
obj)
      locsWithIdxs :: Vector a -> [[Char]]
locsWithIdxs Vector a
arr = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> [Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]") [Int
0..(Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
arr)]


sliceArray :: (Maybe Int, Maybe Int, Int) -> Vector Value -> Vector Value
sliceArray :: (Maybe Int, Maybe Int, Int) -> Vector Value -> Vector Value
sliceArray (Maybe Int
start,Maybe Int
end,Int
step) Vector Value
vec =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
step Int
0 of
    Ordering
GT -> Int -> Int -> Int -> Vector Value -> Vector Value
forall {a}. Int -> Int -> Int -> Vector a -> Vector a
getSliceForward (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
normalize Maybe Int
start) (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
len Int -> Int
normalize Maybe Int
end) Int
step Vector Value
vec
    Ordering
LT -> Int -> Int -> Int -> Vector Value -> Vector Value
forall {a}. Int -> Int -> Int -> Vector a -> Vector a
getSliceReverse (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int
normalize Maybe Int
start) (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) Int -> Int
normalize Maybe Int
end) Int
step Vector Value
vec
    Ordering
EQ -> Vector Value
forall a. Vector a
V.empty
    where
      -- TODO: Looks kinda ugly, make it pretty <3
      len :: Int
len = Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vec
      normalize :: Int -> Int
normalize 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

      getSliceForward :: Int -> Int -> Int -> Vector a -> Vector a
getSliceForward Int
st Int
en Int
stp Vector a
arr = Int -> Vector a -> Vector a
loop Int
lower Vector a
forall a. Vector a
V.empty
        where
          (Int
lower,Int
upper) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
st Int
0) Int
len, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
en Int
0) Int
len)

          loop :: Int -> Vector a -> Vector a
loop Int
i Vector a
acc =
            if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upper
              then Int -> Vector a -> Vector a
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
stp) (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc Vector a
acc (a -> Vector a) -> a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> Int -> a
forall a. Vector a -> Int -> a
(V.!) Vector a
arr (Int -> Int
normalize Int
i)
            else
              Vector a
acc

      getSliceReverse :: Int -> Int -> Int -> Vector a -> Vector a
getSliceReverse Int
st Int
en Int
stp Vector a
arr = Int -> Vector a -> Vector a
loop Int
upper Vector a
forall a. Vector a
V.empty
        where
          (Int
lower,Int
upper) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
en (-Int
1)) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
st (-Int
1)) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

          loop :: Int -> Vector a -> Vector a
loop Int
i Vector a
acc =
            if Int
lower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i
              then Int -> Vector a -> Vector a
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
stp) (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc Vector a
acc (a -> Vector a) -> a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> Int -> a
forall a. Vector a -> Int -> a
(V.!) Vector a
arr (Int -> Int
normalize Int
i)
            else
              Vector a
acc


sliceArrayLocated :: (Maybe Int, Maybe Int, Int) -> Vector (String,Value) -> Vector (String,Value)
sliceArrayLocated :: (Maybe Int, Maybe Int, Int)
-> Vector ([Char], Value) -> Vector ([Char], Value)
sliceArrayLocated (Maybe Int
start,Maybe Int
end,Int
step) Vector ([Char], Value)
vec =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
step Int
0 of
    Ordering
GT -> Int
-> Int -> Int -> Vector ([Char], Value) -> Vector ([Char], Value)
forall {a}. Int -> Int -> Int -> Vector a -> Vector a
getSliceForward (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
normalize Maybe Int
start) (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
len Int -> Int
normalize Maybe Int
end) Int
step Vector ([Char], Value)
vec
    Ordering
LT -> Int
-> Int -> Int -> Vector ([Char], Value) -> Vector ([Char], Value)
forall {a}. Int -> Int -> Int -> Vector a -> Vector a
getSliceReverse (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int
normalize Maybe Int
start) (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) Int -> Int
normalize Maybe Int
end) Int
step Vector ([Char], Value)
vec
    Ordering
EQ -> Vector ([Char], Value)
forall a. Vector a
V.empty
    where
      -- TODO: Looks kinda ugly, make it pretty <3
      len :: Int
len = Vector ([Char], Value) -> Int
forall a. Vector a -> Int
V.length Vector ([Char], Value)
vec
      normalize :: Int -> Int
normalize 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

      getSliceForward :: Int -> Int -> Int -> Vector a -> Vector a
getSliceForward Int
st Int
en Int
stp Vector a
arr = Int -> Vector a -> Vector a
loop Int
lower Vector a
forall a. Vector a
V.empty
        where
          (Int
lower,Int
upper) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
st Int
0) Int
len, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
en Int
0) Int
len)

          loop :: Int -> Vector a -> Vector a
loop Int
i Vector a
acc =
            if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upper
              then Int -> Vector a -> Vector a
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
stp) (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc Vector a
acc (a -> Vector a) -> a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> Int -> a
forall a. Vector a -> Int -> a
(V.!) Vector a
arr (Int -> Int
normalize Int
i)
            else
              Vector a
acc

      getSliceReverse :: Int -> Int -> Int -> Vector a -> Vector a
getSliceReverse Int
st Int
en Int
stp Vector a
arr = Int -> Vector a -> Vector a
loop Int
upper Vector a
forall a. Vector a
V.empty
        where
          (Int
lower,Int
upper) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
en (-Int
1)) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
st (-Int
1)) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

          loop :: Int -> Vector a -> Vector a
loop Int
i Vector a
acc =
            if Int
lower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i
              then Int -> Vector a -> Vector a
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
stp) (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc Vector a
acc (a -> Vector a) -> a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a -> Int -> a
forall a. Vector a -> Int -> a
(V.!) Vector a
arr (Int -> Int
normalize Int
i)
            else
              Vector a
acc

filterOrExpr :: LogicalOrExpr -> Value -> Value -> Vector Value
filterOrExpr :: LogicalOrExpr -> Value -> Value -> Vector Value
filterOrExpr LogicalOrExpr
expr Value
root (JSON.Object Object
obj) = (Value -> Bool) -> Vector Value -> Vector Value
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr LogicalOrExpr
expr Value
root) ([Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value) -> [Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj)
filterOrExpr LogicalOrExpr
expr Value
root (JSON.Array Vector Value
arr) = (Value -> Bool) -> Vector Value -> Vector Value
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr LogicalOrExpr
expr Value
root) Vector Value
arr
filterOrExpr LogicalOrExpr
_ Value
_ Value
_ = Vector Value
forall a. Vector a
V.empty

filterOrExprLocated :: LogicalOrExpr -> Value -> Value -> String -> Vector (String,Value)
filterOrExprLocated :: LogicalOrExpr -> Value -> Value -> [Char] -> Vector ([Char], Value)
filterOrExprLocated LogicalOrExpr
expr Value
root (JSON.Object Object
obj) [Char]
loc = (([Char], Value) -> Bool)
-> Vector ([Char], Value) -> Vector ([Char], Value)
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\([Char]
_,Value
x) -> LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr LogicalOrExpr
expr Value
root Value
x) ([([Char], Value)] -> Vector ([Char], Value)
forall a. [a] -> Vector a
V.fromList ([([Char], Value)] -> Vector ([Char], Value))
-> [([Char], Value)] -> Vector ([Char], Value)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Value] -> [([Char], Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
locsWithKeys (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj))
  where
    locsWithKeys :: [[Char]]
locsWithKeys = (Key -> [Char]) -> [Key] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Key
x -> [Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"['" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Key -> [Char]
K.toString Key
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"']") (Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj)
filterOrExprLocated LogicalOrExpr
expr Value
root (JSON.Array Vector Value
arr) [Char]
loc = (([Char], Value) -> Bool)
-> Vector ([Char], Value) -> Vector ([Char], Value)
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\([Char]
_,Value
x) -> LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr LogicalOrExpr
expr Value
root Value
x) (Vector [Char] -> Vector Value -> Vector ([Char], Value)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip ([[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList [[Char]]
locsWithIdxs) Vector Value
arr)
  where
    locsWithIdxs :: [[Char]]
locsWithIdxs = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> [Char]
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]") [Int
0..(Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
filterOrExprLocated LogicalOrExpr
_ Value
_ Value
_ [Char]
_ = Vector ([Char], Value)
forall a. Vector a
V.empty


evaluateLogicalOrExpr :: LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr :: LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr (LogicalOr [LogicalAndExpr]
exprs) Value
root Value
cur = (LogicalAndExpr -> Bool) -> [LogicalAndExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\LogicalAndExpr
x -> LogicalAndExpr -> Value -> Value -> Bool
evaluateLogicalAndExpr LogicalAndExpr
x Value
root Value
cur) [LogicalAndExpr]
exprs


evaluateLogicalAndExpr :: LogicalAndExpr -> Value -> Value -> Bool
evaluateLogicalAndExpr :: LogicalAndExpr -> Value -> Value -> Bool
evaluateLogicalAndExpr (LogicalAnd [BasicExpr]
exprs) Value
root Value
cur = (BasicExpr -> Bool) -> [BasicExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\BasicExpr
x -> BasicExpr -> Value -> Value -> Bool
evaluateBasicExpr BasicExpr
x Value
root Value
cur) [BasicExpr]
exprs


evaluateBasicExpr :: BasicExpr -> Value -> Value -> Bool
evaluateBasicExpr :: BasicExpr -> Value -> Value -> Bool
evaluateBasicExpr (Paren LogicalOrExpr
expr) Value
root Value
cur = LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr LogicalOrExpr
expr Value
root Value
cur
evaluateBasicExpr (NotParen LogicalOrExpr
expr) Value
root Value
cur = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalOrExpr -> Value -> Value -> Bool
evaluateLogicalOrExpr LogicalOrExpr
expr Value
root Value
cur
evaluateBasicExpr (Test Query
expr) Value
root Value
cur = Query -> Value -> Value -> Bool
evaluateTestExpr Query
expr Value
root Value
cur
evaluateBasicExpr (NotTest Query
expr) Value
root Value
cur = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Query -> Value -> Value -> Bool
evaluateTestExpr Query
expr Value
root Value
cur
evaluateBasicExpr (Comparison ComparisonExpr
expr) Value
root Value
cur = ComparisonExpr -> Value -> Value -> Bool
evaluateCompExpr ComparisonExpr
expr Value
root Value
cur


evaluateTestExpr :: TestExpr -> Value -> Value -> Bool
evaluateTestExpr :: Query -> Value -> Value -> Bool
evaluateTestExpr Query
expr Value
root Value
cur = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vector Value -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Vector Value -> Bool) -> Vector Value -> Bool
forall a b. (a -> b) -> a -> b
$ Query -> Value -> Value -> Vector Value
qQuery Query
expr Value
root Value
cur


evaluateCompExpr :: ComparisonExpr -> Value -> Value -> Bool
evaluateCompExpr :: ComparisonExpr -> Value -> Value -> Bool
evaluateCompExpr (Comp Comparable
leftC ComparisonOp
op Comparable
rightC) Value
root Value
cur  = ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
op (Comparable -> Value -> Value -> Maybe Value
getComparableVal Comparable
leftC Value
root Value
cur) (Comparable -> Value -> Value -> Maybe Value
getComparableVal Comparable
rightC Value
root Value
cur)


compareVals :: ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals :: ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
Less (Just (JSON.String Text
s1)) (Just (JSON.String Text
s2)) = Text
s1 Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
< Text
s2
compareVals ComparisonOp
Less (Just (JSON.Number Scientific
n1)) (Just (JSON.Number Scientific
n2)) = Scientific
n1 Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
n2
compareVals ComparisonOp
Less Maybe Value
_  Maybe Value
_ = Bool
False

compareVals ComparisonOp
LessOrEqual    Maybe Value
o1 Maybe Value
o2 = ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
Less Maybe Value
o1 Maybe Value
o2 Bool -> Bool -> Bool
|| ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
Equal Maybe Value
o1 Maybe Value
o2
compareVals ComparisonOp
Greater        Maybe Value
o1 Maybe Value
o2 = ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
Less Maybe Value
o2 Maybe Value
o1
compareVals ComparisonOp
GreaterOrEqual Maybe Value
o1 Maybe Value
o2 = ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
Less Maybe Value
o2 Maybe Value
o1 Bool -> Bool -> Bool
|| ComparisonOp -> Maybe Value -> Maybe Value -> Bool
compareVals ComparisonOp
Equal Maybe Value
o1 Maybe Value
o2
compareVals ComparisonOp
Equal          Maybe Value
o1 Maybe Value
o2 = Maybe Value
o1 Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Value
o2
compareVals ComparisonOp
NotEqual       Maybe Value
o1 Maybe Value
o2 = Maybe Value
o1 Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Value
o2


getComparableVal :: Comparable -> Value -> Value -> Maybe Value
getComparableVal :: Comparable -> Value -> Value -> Maybe Value
getComparableVal (CompLitNum Scientific
num) 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
JSON.Number Scientific
num
getComparableVal (CompLitString Text
txt) 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
JSON.String Text
txt
getComparableVal (CompLitBool Bool
bool) 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
JSON.Bool Bool
bool
getComparableVal Comparable
CompLitNull Value
_ Value
_ = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
JSON.Null
getComparableVal (CompSQ SingularQuery{[SingularQuerySegment]
SingularQueryType
singularQueryType :: SingularQueryType
singularQuerySegments :: [SingularQuerySegment]
singularQueryType :: SingularQuery -> SingularQueryType
singularQuerySegments :: SingularQuery -> [SingularQuerySegment]
..}) Value
root Value
cur = case SingularQueryType
singularQueryType of
  SingularQueryType
RootSQ -> Maybe Value -> [SingularQuerySegment] -> Maybe Value
traverseSingularQSegs (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
root) [SingularQuerySegment]
singularQuerySegments
  SingularQueryType
CurrentSQ -> Maybe Value -> [SingularQuerySegment] -> Maybe Value
traverseSingularQSegs (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
cur) [SingularQuerySegment]
singularQuerySegments


traverseSingularQSegs :: Maybe Value -> [SingularQuerySegment] -> Maybe Value
traverseSingularQSegs :: Maybe Value -> [SingularQuerySegment] -> Maybe Value
traverseSingularQSegs = (Maybe Value -> SingularQuerySegment -> Maybe Value)
-> Maybe Value -> [SingularQuerySegment] -> Maybe Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Maybe Value -> SingularQuerySegment -> Maybe Value
lookupSingleQSeg


-- TODO: There is a bug here, not existing shouldn't give null
-- See: https://www.rfc-editor.org/rfc/rfc9535#name-examples-6
lookupSingleQSeg :: Maybe Value -> SingularQuerySegment -> Maybe Value
lookupSingleQSeg :: Maybe Value -> SingularQuerySegment -> Maybe Value
lookupSingleQSeg (Just (JSON.Object Object
obj)) (NameSQSeg Text
txt) = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
K.fromText Text
txt) Object
obj
lookupSingleQSeg (Just (JSON.Array Vector Value
arr)) (IndexSQSeg Int
idx) = Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
(V.!?) Vector Value
arr Int
idx
lookupSingleQSeg Maybe Value
_ SingularQuerySegment
_ = Maybe Value
forall a. Maybe a
Nothing