{-# LANGUAGE RecordWildCards #-}
module Data.Aeson.JSONPath.Query.Filter
  ( filterOrExpr
  , filterOrExprLocated )
  where

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.Vector           as V

import Data.Aeson.JSONPath.Types

import Prelude

filterOrExpr :: LogicalOrExpr Query -> QueryState -> Vector Value
filterOrExpr :: LogicalOrExpr Query -> QueryState -> Vector Value
filterOrExpr LogicalOrExpr Query
expr qS :: QueryState
qS@QueryState{ curVal :: QueryState -> Value
curVal=(JSON.Object Object
obj) } = (Value -> Bool) -> Vector Value -> Vector Value
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\Value
cur -> LogicalOrExpr Query -> QueryState -> Bool
evaluateLogicalOrExpr LogicalOrExpr Query
expr QueryState
qS{ curVal :: Value
curVal=Value
cur}) ([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 Query
expr qS :: QueryState
qS@QueryState{ curVal :: QueryState -> Value
curVal=(JSON.Array Vector Value
arr) } = (Value -> Bool) -> Vector Value -> Vector Value
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\Value
cur -> LogicalOrExpr Query -> QueryState -> Bool
evaluateLogicalOrExpr LogicalOrExpr Query
expr QueryState
qS{ curVal :: Value
curVal=Value
cur }) Vector Value
arr
filterOrExpr LogicalOrExpr Query
_ QueryState
_ = Vector Value
forall a. Vector a
V.empty

filterOrExprLocated :: LogicalOrExpr Query -> QueryState -> String -> Vector (String,Value)
filterOrExprLocated :: LogicalOrExpr Query
-> QueryState -> String -> Vector (String, Value)
filterOrExprLocated LogicalOrExpr Query
expr  qS :: QueryState
qS@QueryState{ curVal :: QueryState -> Value
curVal=(JSON.Object Object
obj) } String
loc = ((String, Value) -> Bool)
-> Vector (String, Value) -> Vector (String, Value)
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(String
_,Value
x) -> LogicalOrExpr Query -> QueryState -> Bool
evaluateLogicalOrExpr LogicalOrExpr Query
expr QueryState
qS{ curVal :: Value
curVal=Value
x}) ([(String, Value)] -> Vector (String, Value)
forall a. [a] -> Vector a
V.fromList ([(String, Value)] -> Vector (String, Value))
-> [(String, Value)] -> Vector (String, Value)
forall a b. (a -> b) -> a -> b
$ [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
locsWithKeys (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
obj))
  where
    locsWithKeys :: [String]
locsWithKeys = (Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Key
x -> String
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"['" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
K.toString Key
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"']") (Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj)
filterOrExprLocated LogicalOrExpr Query
expr qS :: QueryState
qS@QueryState{ curVal :: QueryState -> Value
curVal=(JSON.Array Vector Value
arr) } String
loc = ((String, Value) -> Bool)
-> Vector (String, Value) -> Vector (String, Value)
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(String
_,Value
x) -> LogicalOrExpr Query -> QueryState -> Bool
evaluateLogicalOrExpr LogicalOrExpr Query
expr QueryState
qS{ curVal :: Value
curVal=Value
x}) (Vector String -> Vector Value -> Vector (String, Value)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip ([String] -> Vector String
forall a. [a] -> Vector a
V.fromList [String]
locsWithIdxs) Vector Value
arr)
  where
    locsWithIdxs :: [String]
locsWithIdxs = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> String
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]") [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 Query
_ QueryState
_ String
_ = Vector (String, Value)
forall a. Vector a
V.empty


evaluateLogicalOrExpr :: LogicalOrExpr Query -> QueryState -> Bool
evaluateLogicalOrExpr :: LogicalOrExpr Query -> QueryState -> Bool
evaluateLogicalOrExpr (LogicalOr [LogicalAndExpr Query]
exprs) QueryState
qS = (LogicalAndExpr Query -> Bool) -> [LogicalAndExpr Query] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LogicalAndExpr Query -> QueryState -> Bool
`evaluateLogicalAndExpr` QueryState
qS) [LogicalAndExpr Query]
exprs


evaluateLogicalAndExpr :: LogicalAndExpr Query -> QueryState -> Bool
evaluateLogicalAndExpr :: LogicalAndExpr Query -> QueryState -> Bool
evaluateLogicalAndExpr (LogicalAnd [BasicExpr Query]
exprs) QueryState
qS = (BasicExpr Query -> Bool) -> [BasicExpr Query] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (BasicExpr Query -> QueryState -> Bool
`evaluateBasicExpr` QueryState
qS) [BasicExpr Query]
exprs


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


evaluateTestExpr :: TestExpr Query -> QueryState -> Bool
evaluateTestExpr :: TestExpr Query -> QueryState -> Bool
evaluateTestExpr (FilterQuery Query
expr) qS :: QueryState
qS@QueryState{Value
Query -> QueryState -> Vector Value
curVal :: QueryState -> Value
rootVal :: Value
curVal :: Value
executeQuery :: Query -> QueryState -> Vector Value
rootVal :: QueryState -> Value
executeQuery :: QueryState -> Query -> QueryState -> Vector Value
..} = 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 -> QueryState -> Vector Value
executeQuery Query
expr QueryState
qS


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


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 -> QueryState -> Maybe Value
getComparableVal :: Comparable -> QueryState -> Maybe Value
getComparableVal (CompLit Literal
lit) QueryState
_ = 
  case Literal
lit of
    LitString Text
txt -> 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
    LitNum Scientific
num    -> 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
    LitBool Bool
bool  -> 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
    Literal
LitNull       -> 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]
..}) QueryState{Value
Query -> QueryState -> Vector Value
curVal :: QueryState -> Value
rootVal :: QueryState -> Value
executeQuery :: QueryState -> Query -> QueryState -> Vector Value
rootVal :: Value
curVal :: Value
executeQuery :: Query -> QueryState -> Vector Value
..} = case SingularQueryType
singularQueryType of
  SingularQueryType
RootSQ -> Maybe Value -> [SingularQuerySegment] -> Maybe Value
traverseSingularQSegs (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
rootVal) [SingularQuerySegment]
singularQuerySegments
  SingularQueryType
CurrentSQ -> Maybe Value -> [SingularQuerySegment] -> Maybe Value
traverseSingularQSegs (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
curVal) [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


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