aeson-jsonpath 0.2.0.0 → 0.3.0.0

raw patch · 13 files changed

+1790/−316 lines, 13 filesdep +scientificPVP ok

version bump matches the API change (PVP)

Dependencies added: scientific

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• LICENSE +1/−1
• README.md +150/−0
• aeson-jsonpath.cabal +12/−3
• src/Data/Aeson/JSONPath.hs +99/−119
• src/Data/Aeson/JSONPath/Parser.hs +321/−122
• src/Data/Aeson/JSONPath/Query.hs +290/−0
• src/Data/Aeson/JSONPath/Query/Types.hs +139/−0
• test/ComplianceSpec.hs +85/−0
• test/LocatedSpec.hs +143/−0
• test/Main.hs +26/−7
• test/ParserSpec.hs +403/−28
• test/QuerySpec.hs +110/−36

@@ -1,3 +1,14 @@+# Change Log++All notable changes to this package are documented in this file. This project adheres to [Haskell PVP](https://pvp.haskell.org/) versioning.++## 0.3.0.0++- Always return `Vector Value`+- Implement Filter Selector+- Introduce JSONPath Standard Compliance Testing, See: [test-suite](https://github.com/jsonpath-standard/jsonpath-compliance-test-suite)+- Add function `queryLocated` which also returns node locations+ ## 0.2.0.0  - Remove dependency on `protolude`

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2024 Taimoor Zaeem+Copyright (c) 2024-2025 Taimoor Zaeem  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -0,0 +1,150 @@+# aeson-jsonpath++![ci-badge](https://github.com/taimoorzaeem/aeson-jsonpath/actions/workflows/build.yml/badge.svg?event=push) [![hackage-docs](https://img.shields.io/badge/hackage-v0.2.0.0-blue)](https://hackage.haskell.org/package/aeson-jsonpath)++Run [RFC 9535](https://www.rfc-editor.org/rfc/rfc9535) compliant JSONPath queries on [Data.Aeson](https://hackage.haskell.org/package/aeson).++## Roadmap++- [x] Selectors+  - [x] Name Selector+  - [x] Index Selector+  - [x] Slice Selector+  - [x] Wildcard Selector+  - [x] Filter Selector+- [x] Segments+  - [x] Child Segment+  - [x] Descendant Segment+- [x] Node Locations (Normalized Path)+- [ ] Function Extensions+- [ ] Setting Values (Non-RFC)++## Quick Start++```haskell+{-# LANGUAGE QuasiQuotes #-}+import Data.Aeson           (Value (..))+import Data.Aeson.QQ.Simple (aesonQQ)+import Data.Aeson.JSONPath  (query, queryLocated, jsonPath)++track = [aesonQQ| { "artist": "Duster", "title": "Earth Moon Transit" } |]++ghci> query "$.artist" track -- child member shorthand+Right [String "Duster"]++ghci> queryLocated "$.*" track -- child wildcard segment+Right [+  ("$['artist']", String "Duster"),+  ("$['title']", String "Earth Moon Transit")+]+```++## More Examples++```haskell+{-# LANGUAGE QuasiQuotes #-}+import Data.Aeson           (Value (..))+import Data.Aeson.QQ.Simple (aesonQQ)+import Data.Aeson.JSONPath  (query, queryLocated, jsonPath)++json = [aesonQQ| {+  "shop": {+    "movies": [+      {+        "title": "Mandy",+        "director": "Panos Cosmatos",+        "year": 2018+      },+      {+        "title": "Lawrence Anyways",+        "director": "Xavier Dolan",+        "year": 2012+      }+    ]+  }+}|]+```++### Child Segment++```haskell+ghci> query "$.shop.movies[0].title" json+Right [String "Mandy"]++ghci> query "$.shop.movies[0].*" json+Right [+  String "Mandy",+  String "Panos Cosmatos",+  Number 2018.0+]++ghci> query "$['shop']['new-movies']" json+Right []+```++### Descendant Segment++```haskell+-- get all values with key "director", recursively+ghci> query "$..director" json+Right [+  String "Panos Cosmatos",+  String "Xavier Dolan"+]+```++### Slice Selector++```haskell+ghci> query "$[2:5]" [aesonQQ| [1,2,3,4,5,6] |]+Right [+  Number 3.0,+  Number 4.0,+  Number 5.0+]+```++### Filter Selector++```haskell+ghci> query "$.shop.movies[?@.year < 2015]" json+Right [+  Object (fromList [+    ("director",String "Xavier Dolan"),+    ("title",String "Lawrence Anyways"),+    ("year",Number 2012.0)+  ])+]++ghci> queryLocated "$.shop.movies[?@.director == 'Xavier Dolan']" json+Right [+  (+    "$['shop']['movies'][1]",+    Object (fromList [+      ("director",String "Xavier Dolan"),+      ("title",String "Lawrence Anyways"),+      ("year",Number 2012.0)+    ])+  )+]+```++### QuasiQuoter++The functions `queryQQ` and `queryLocatedQQ` can be used with the `jsonPath` quasi quoter.++```haskell+queryQQ [jsonPath|$.shop.movies|] json -- compiles successfully++queryQQ [jsonPath|$.shop$$movies|] json -- compilation error, doesn't parse+```++## Testing++It is tested using 10000+ lines test suite given by [jsonpath-compliance-test-suite](https://github.com/jsonpath-standard/jsonpath-compliance-test-suite) :rocket:.++**Note:** All tests pass except tests related to **function extensions** which we have not implemented yet.++## Development++Please report any bugs you encounter by opening an issue.

@@ -1,8 +1,9 @@ name:               aeson-jsonpath-version:            0.2.0.0+version:            0.3.0.0 synopsis:           Parse and run JSONPath queries on Aeson documents description:        RFC 9535 compliant JSONPath parsing and querying-                    package. JSONPath is similar to XPath for querying XML documents.+                    package. JSONPath is similar to XPath for querying+                    XML documents. license:            MIT license-file:       LICENSE author:             Taimoor Zaeem@@ -12,7 +13,8 @@ bug-reports:        https://github.com/taimoorzaeem/aeson-jsonpath/issues build-type:         Simple extra-source-files: CHANGELOG.md-cabal-version:      >= 1.10+extra-doc-files:    README.md+cabal-version:      1.18  tested-with:     GHC == 9.4.8@@ -32,9 +34,12 @@   hs-source-dirs:     src   exposed-modules:    Data.Aeson.JSONPath                       Data.Aeson.JSONPath.Parser+                      Data.Aeson.JSONPath.Query+                      Data.Aeson.JSONPath.Query.Types   build-depends:      aeson                     >= 2.0.3 && < 2.3                     , base                      >= 4.9 && < 4.22                     , parsec                    >= 3.1.11 && < 3.2+                    , scientific                >= 0.3.4 && < 0.4                     , template-haskell          >= 2.12 && < 2.24                     , text                      >= 1.2.2 && < 2.2                     , vector                    >= 0.11 && < 0.14@@ -51,11 +56,15 @@   main-is:            Main.hs   other-modules:      ParserSpec                       QuerySpec+                      ComplianceSpec+                      LocatedSpec+                      Paths_aeson_jsonpath   build-depends:      aeson                     >= 2.0.3 && < 2.3                     , aeson-jsonpath                     , base                      >= 4.9 && < 4.22                     , hspec                     >= 2.3 && < 2.12                     , parsec                    >= 3.1.11 && < 3.2+                    , text                      >= 1.2.2 && < 2.2                     , vector                    >= 0.11 && < 0.14    ghc-options:        -Wall -Wunused-packages

@@ -1,32 +1,53 @@+{- |+Module      : Data.Aeson.JSONPath+Description : Run JSONPath queries on Data.Aeson+Copyright   : (c) 2024-2025 Taimoor Zaeem+License     : MIT+Maintainer  : Taimoor Zaeem <mtaimoorzaeem@gmail.com>+Stability   : Experimental+Portability : Portable++Run JSONPath queries on Aeson Values using methods exported in this module.+-} module Data.Aeson.JSONPath-  ( runJSPQuery-  , jsonPath)+  (+  -- * Using this library+  -- $use++  -- * API+    query+  , queryQQ+  , queryLocated+  , queryLocatedQQ++  -- * QuasiQuoter+  , jsonPath+  )   where -import qualified Data.Aeson                    as JSON-import qualified Data.Aeson.Key                as K-import qualified Data.Aeson.KeyMap             as KM-import qualified Data.Vector                   as V import qualified Text.ParserCombinators.Parsec as P -import Data.Aeson.JSONPath.Parser (JSPQuery (..)-                                  , JSPSegment (..)-                                  , JSPChildSegment (..)-                                  , JSPDescSegment (..)-                                  , JSPSelector (..)-                                  , JSPWildcardT (..)-                                  , pJSPQuery)-import Data.Maybe                 (fromMaybe)-import Data.Text                  (Text)-import Language.Haskell.TH.Quote  (QuasiQuoter (..))-import Language.Haskell.TH.Syntax (lift)+import Data.Aeson                   (Value)+import Data.Vector                  (Vector)+import Language.Haskell.TH.Quote    (QuasiQuoter (..))+import Language.Haskell.TH.Syntax   (lift) -import Prelude+import Data.Aeson.JSONPath.Query.Types (Query (..))+import Data.Aeson.JSONPath.Query       (Queryable (..))+import Data.Aeson.JSONPath.Parser      (pQuery) +import Prelude +-- |+-- A 'QuasiQuoter' for checking valid JSONPath syntax at compile time+--+-- @+-- path :: Query+-- path = [jsonPath|$.store.records[0,1]|]+-- @ jsonPath :: QuasiQuoter jsonPath = QuasiQuoter-  { quoteExp = \query -> case P.parse pJSPQuery ("failed to parse query: " <> query) query of+  { quoteExp = \q -> case P.parse pQuery ("failed to parse query: " <> q) q of       Left err -> fail $ show err       Right ex -> lift ex   , quotePat = error "Error: quotePat"@@ -34,112 +55,71 @@   , quoteDec = error "Error: quoteDec"   } --- | Run JSONPath query+-- |+-- Use when query string is not known at compile time -- -- @--- {-\# LANGUAGE QuasiQuotes \#-}------ import Data.Aeson          (Value)--- import Data.Aeson.JSONPath (runJSPQuery, jsonPath)+-- >>> query "$.artist" json+-- Right [String "David Bowie"] ----- book :: 'Value'--- book = [jsonPath|$.store.books[2]|]+-- >>> query "$.art[ist" json+-- Left "failed to parse query: $.art[ist" (line 1, column 7) -- @-runJSPQuery :: JSPQuery -> JSON.Value -> JSON.Value-runJSPQuery = traverseJSPQuery---traverseJSPQuery :: JSPQuery -> JSON.Value -> JSON.Value-traverseJSPQuery (JSPRoot segs) = traverseJSPSegments segs---traverseJSPSegments :: [JSPSegment] -> JSON.Value -> JSON.Value-traverseJSPSegments xs doc = foldl (flip traverseJSPSegment) doc xs---traverseJSPSegment :: JSPSegment -> JSON.Value -> JSON.Value-traverseJSPSegment (JSPChildSeg jspChildSeg) doc = traverseJSPChildSeg jspChildSeg doc-traverseJSPSegment (JSPDescSeg jspDescSeg) doc = traverseJSPDescSeg jspDescSeg doc---traverseJSPChildSeg :: JSPChildSegment -> JSON.Value -> JSON.Value-traverseJSPChildSeg (JSPChildBracketed sels) doc = traverseJSPSelectors sels doc-traverseJSPChildSeg (JSPChildMemberNameSH key) (JSON.Object obj) = fromMaybe emptyJSArray $ KM.lookup (K.fromText key) obj-traverseJSPChildSeg (JSPChildMemberNameSH _) _ = emptyJSArray-traverseJSPChildSeg (JSPChildWildSeg JSPWildcard) doc = doc---traverseJSPDescSeg :: JSPDescSegment -> JSON.Value -> JSON.Value-traverseJSPDescSeg (JSPDescBracketed sels) doc = JSON.Array $ V.map (traverseJSPSelectors sels) (allElemsRecursive doc)-traverseJSPDescSeg (JSPDescMemberNameSH key) doc = traverseDescMembers key doc-traverseJSPDescSeg (JSPDescWildSeg JSPWildcard) doc = JSON.Array $ allElemsRecursive doc---- TODO: Clean this super messy code, might require some refactoring-traverseDescMembers :: Text -> JSON.Value -> JSON.Value-traverseDescMembers key (JSON.Object obj) = JSON.Array $ V.concat [-    maybe V.empty V.singleton $ KM.lookup (K.fromText key) obj,-    V.map (traverseDescMembers key) (allElemsRecursive (JSON.Array $ V.fromList $ KM.elems obj))-  ]-traverseDescMembers key ar@(JSON.Array _) = JSON.Array $ V.map (traverseDescMembers key) (allElemsRecursive ar)-traverseDescMembers _ _ = JSON.Array V.empty--traverseJSPSelectors :: [JSPSelector] -> JSON.Value -> JSON.Value-traverseJSPSelectors sels doc = JSON.Array $ V.concat $ map traverse' sels-  where-    traverse' = flip traverseJSPSelector doc--traverseJSPSelector :: JSPSelector -> JSON.Value -> V.Vector JSON.Value-traverseJSPSelector (JSPNameSel key) (JSON.Object obj) = maybe V.empty V.singleton $ KM.lookup (K.fromText key) obj-traverseJSPSelector (JSPNameSel _) _ = V.empty-traverseJSPSelector (JSPIndexSel idx) (JSON.Array arr) = maybe V.empty V.singleton (if idx >= 0 then (V.!?) arr idx else (V.!?) arr (idx + V.length arr))-traverseJSPSelector (JSPIndexSel _) _ = V.empty-traverseJSPSelector (JSPSliceSel sliceVals) (JSON.Array arr) = traverseJSPSliceSelector sliceVals arr-traverseJSPSelector (JSPSliceSel _) _ = V.empty--- This does not work right with descendant segment, fix it later-traverseJSPSelector (JSPWildSel JSPWildcard) doc = V.singleton doc+-- For detailed usage examples, see: <https://github.com/taimoorzaeem/aeson-jsonpath?tab=readme-ov-file#aeson-jsonpath>+query :: String -> Value -> Either P.ParseError (Vector Value)+query q root = do+  parsedQuery <- P.parse pQuery ("failed to parse query: " <> q) q+  return $ queryQQ parsedQuery root  -traverseJSPSliceSelector :: (Maybe Int, Maybe Int, Int) -> JSON.Array -> V.Vector JSON.Value-traverseJSPSliceSelector (start, end, step) doc = getSlice start end step doc-  where-    -- TODO: Refactor this code to make it more pretty-    len = V.length doc-    normalize i = if i >= 0 then i else len + i--    sliceNormalized arr' (n_start, n_end) isStepNeg =-      let (lower, upper) = if isStepNeg then-            (min (max n_end (-1)) (len-1), min (max n_start (-1)) (len-1))-          else-            (min (max n_start 0) len, min (max n_end 0) len)-      in V.slice lower ((if isStepNeg then 1 else 0)+upper-lower) arr'--    getSlice _ _ 0 _ = V.empty-    getSlice (Just st) (Just en) step' arr =-      filterSlice (sliceNormalized arr (normalize st, normalize en) (step' < 0)) step'-    getSlice (Just st) Nothing step' arr =-      filterSlice (sliceNormalized arr (normalize st, len) (step' < 0)) step'-    getSlice Nothing (Just en) step' arr =-      filterSlice (sliceNormalized arr (0, normalize en) (step' < 0)) step'-    getSlice Nothing Nothing step' arr = filterSlice arr step'+-- |+-- Use when query string is known at compile time+--+-- @+-- artist = queryQQ [jsonPath|$.artist|] json -- successfully compiles+--+-- >>> artist+-- [String "David Bowie"]+-- @+-- @+-- artist = queryQQ [jsonPath|$.art[ist|] json -- fails at compilation time+-- @+queryQQ :: Query -> Value -> Vector Value+queryQQ q root = query' q root root -    -- trying to avoid a step loop and keeping it "functional"-    filterSlice slice 1   = slice-    filterSlice slice (-1) = V.reverse slice-    filterSlice slice n = if n < 0 then-          V.ifilter (\i _ -> i `mod` (-n) == 0) $ V.reverse $ V.drop (V.length slice `mod` (-n)) slice-        else-          V.ifilter (\i _ -> i `mod` n == 0) slice+-- |+-- Get the location of the returned nodes along with the node+--+-- @+-- >>> queryLocated "$.title" json+-- Right [("$[\'title\']",String "Space Oddity")]+-- @+queryLocated :: String -> Value -> Either P.ParseError (Vector (String, Value))+queryLocated q root = do+  parsedQuery <- P.parse pQuery ("failed to parse query: " <> q) q+  return $ queryLocatedQQ parsedQuery root -emptyJSArray :: JSON.Value-emptyJSArray = JSON.Array V.empty+-- |+-- Same as 'queryLocated' but allows QuasiQuoter+--+-- @+-- artist = queryLocatedQQ [jsonPath|$.*|] json -- successfully compiles+--+-- >>> artist+-- [("$[\'artist\']",String "David Bowie"),+--  ("$[\'title\']",String "Space Oddity")]+-- @+queryLocatedQQ :: Query -> Value -> Vector (String, Value)+queryLocatedQQ q root = queryLocated' q root root "$" -allElemsRecursive :: JSON.Value -> V.Vector JSON.Value-allElemsRecursive (JSON.Object obj) = V.concat [-    V.fromList (KM.elems obj),-    V.concat $ map allElemsRecursive (KM.elems obj)-  ]-allElemsRecursive (JSON.Array arr) = V.concat [-    arr,-    V.concat $ map allElemsRecursive (V.toList arr)-  ]-allElemsRecursive _ = V.empty+-- $use+--+-- To use this package, I would suggest that you import this module like:+--+-- > {-# LANGUAGE QuasiQuotes #-}+-- > import qualified Data.Aeson.JSONPath as JSONPath+-- > import           Data.Aeson.JSONPath (jsonPath)+--+-- For this module, consider this json for the example queries+--+-- > { "artist": "David Bowie", "title": "Space Oddity" }

@@ -1,172 +1,284 @@-{-# LANGUAGE DeriveLift #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-}+{- |+Module      : Data.Aeson.JSONPath.Parser+Description : Parses the raw query to ADT+Copyright   : (c) 2024-2025 Taimoor Zaeem+License     : MIT+Maintainer  : Taimoor Zaeem <mtaimoorzaeem@gmail.com>+Stability   : Experimental+Portability : Portable++Parses raw query to Haskell Algebraic Data Types+-} module Data.Aeson.JSONPath.Parser-  ( JSPQuery (..)-  , JSPSegment (..)-  , JSPChildSegment (..)-  , JSPDescSegment (..)-  , JSPSelector (..)-  , JSPWildcardT (..)-  , pJSPQuery-  )+  ( pQuery )   where  import qualified Data.Text                      as T import qualified Text.ParserCombinators.Parsec  as P  import Data.Functor                  (($>))-import Data.Text                     (Text)-import Data.Char                     (ord)+import Data.Char                     (ord, chr)+import Data.Maybe                    (isNothing, fromMaybe)+import Data.Scientific               (Scientific, scientific)+import GHC.Num                       (integerFromInt, integerToInt) import Text.ParserCombinators.Parsec ((<|>))-import Language.Haskell.TH.Syntax    (Lift (..)) +import Data.Aeson.JSONPath.Query.Types+ import Prelude -newtype JSPQuery-  = JSPRoot [JSPSegment]-  deriving (Eq, Show, Lift)+-- | Query parser+pQuery :: P.Parser Query+pQuery = P.try pRootQuery <* P.eof --- https://www.rfc-editor.org/rfc/rfc9535#name-segments-2-data JSPSegment-  = JSPChildSeg JSPChildSegment-  | JSPDescSeg JSPDescSegment-  deriving (Eq, Show, Lift)+pRootQuery :: P.Parser Query+pRootQuery = do+  P.char '$'+  segs <- P.many (pSpaces *> pQuerySegment)+  return $ Query { queryType = Root, querySegments = segs } --- https://www.rfc-editor.org/rfc/rfc9535#name-child-segment-data JSPChildSegment-  = JSPChildBracketed [JSPSelector]-  | JSPChildMemberNameSH JSPNameSelector-  | JSPChildWildSeg JSPWildcardT-  deriving (Eq, Show, Lift)+pCurrentQuery :: P.Parser Query+pCurrentQuery = do+  P.char '@'+  segs <- P.many pQuerySegment+  return $ Query { queryType = Current, querySegments = segs }  --- https://www.rfc-editor.org/rfc/rfc9535#name-descendant-segment-data JSPDescSegment-  = JSPDescBracketed [JSPSelector]-  | JSPDescMemberNameSH JSPNameSelector-  | JSPDescWildSeg JSPWildcardT-  deriving (Eq, Show, Lift)+pQuerySegment :: P.Parser QuerySegment+pQuerySegment = do+  dotdot <- P.optionMaybe (P.try $ P.string "..")+  seg <- pSegment $ isNothing dotdot+  let segType = if isNothing dotdot then Child else Descendant+  return $ QuerySegment { segmentType = segType, segment = seg } --- https://www.rfc-editor.org/rfc/rfc9535#name-selectors-2-data JSPSelector-  = JSPNameSel JSPNameSelector-  | JSPIndexSel JSPIndexSelector-  | JSPSliceSel JSPSliceSelector-  | JSPWildSel JSPWildcardT-  deriving (Eq, Show, Lift)+pSegment :: Bool -> P.Parser Segment+pSegment isChild = P.try pBracketed+                <|> P.try (pDotted isChild)+                <|> P.try (pWildcardSeg isChild) -data JSPWildcardT = JSPWildcard-  deriving (Eq, Show, Lift) -type JSPNameSelector = Text+pBracketed :: P.Parser Segment+pBracketed = do+  P.char '['+  pSpaces+  sel <- pSelector+  optionalSels <- P.many pCommaSepSelectors+  pSpaces+  P.char ']'+  return $ Bracketed (sel:optionalSels)+    where+      pCommaSepSelectors :: P.Parser Selector+      pCommaSepSelectors = P.try $ pSpaces *> P.char ',' *> pSpaces *> pSelector -type JSPIndexSelector = Int -type JSPSliceSelector = (Maybe Int, Maybe Int, Int)+pDotted :: Bool -> P.Parser Segment+pDotted isChild = do+  (if isChild then P.string "." else P.string "")+  P.lookAhead (P.letter <|> P.oneOf "_" <|> pUnicodeChar)+  key <- T.pack <$> P.many1 (P.alphaNum <|> P.oneOf "_" <|> pUnicodeChar)+  return $ Dotted key -pJSPQuery :: P.Parser JSPQuery-pJSPQuery = do-  P.char '$'-  segs <- P.many pJSPSegment-  P.eof-  return $ JSPRoot segs -pJSPSelector :: P.Parser JSPSelector-pJSPSelector = P.try pJSPNameSel -            <|> P.try pJSPIndexSel-            <|> P.try pJSPSliceSel -            <|> P.try pJSPWildSel+pWildcardSeg :: Bool -> P.Parser Segment+pWildcardSeg isChild = (if isChild then P.string "." else P.string "") *> P.char '*' $> WildcardSegment+  +pSelector :: P.Parser Selector+pSelector = P.try pName+         <|> P.try pSlice +         <|> P.try pIndex+         <|> P.try pWildcardSel+         <|> P.try pFilter -pJSPNameSel :: P.Parser JSPSelector-pJSPNameSel = JSPNameSel . T.pack <$> (P.char '\'' *> P.many (P.noneOf "\'") <* P.char '\'')+pName :: P.Parser Selector+pName = Name . T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted) -pJSPIndexSel :: P.Parser JSPSelector-pJSPIndexSel = do-  num <- pSignedInt-  P.notFollowedBy $ P.char ':'-  return $ JSPIndexSel num+pIndex :: P.Parser Selector+pIndex = Index <$> pSignedInt -pJSPSliceSel :: P.Parser JSPSelector-pJSPSliceSel = do-  start <- P.optionMaybe pSignedInt+pSlice :: P.Parser Selector+pSlice = do+  start <- P.optionMaybe (pSignedInt <* pSpaces)   P.char ':'-  end <- P.optionMaybe pSignedInt-  step <- P.optionMaybe (P.char ':' *> P.optionMaybe pSignedInt)-  return $ JSPSliceSel (start, end, case step of+  pSpaces+  end <- P.optionMaybe (pSignedInt <* pSpaces)+  step <- P.optionMaybe (P.char ':' *> P.optionMaybe (pSpaces *> pSignedInt))+  return $ ArraySlice (start, end, case step of     Just (Just n) -> n     _ -> 1)  -pJSPWildSel :: P.Parser JSPSelector-pJSPWildSel = JSPWildSel <$> (P.char '*' $> JSPWildcard)+pWildcardSel :: P.Parser Selector+pWildcardSel = P.char '*' $> WildcardSelector -pJSPSegment :: P.Parser JSPSegment-pJSPSegment = pJSPChildSegment <|> pJSPDescSegment -pJSPChildSegment :: P.Parser JSPSegment-pJSPChildSegment = -  JSPChildSeg <$> (P.try pJSPChildBracketed -                  <|> P.try pJSPChildMemberNameSH -                  <|> P.try pJSPChildWildSeg)+pFilter :: P.Parser Selector+pFilter = do+  P.char '?'+  pSpaces+  Filter <$> pLogicalOrExpr -pJSPChildBracketed :: P.Parser JSPChildSegment-pJSPChildBracketed =  do-  P.char '['-  sel <- pJSPSelector-  optionalSels <- P.many pCommaSepSelectors-  P.char ']'-  return $ JSPChildBracketed (sel:optionalSels)++pLogicalOrExpr :: P.Parser LogicalOrExpr+pLogicalOrExpr = do+  expr <- pLogicalAndExpr+  optionalExprs <- P.many pOrSepLogicalAndExprs+  return $ LogicalOr (expr:optionalExprs)     where-      pCommaSepSelectors :: P.Parser JSPSelector-      pCommaSepSelectors = P.char ',' *> P.spaces *> pJSPSelector+      pOrSepLogicalAndExprs :: P.Parser LogicalAndExpr+      pOrSepLogicalAndExprs = P.try $ pSpaces *> P.string "||" *> pSpaces *> pLogicalAndExpr -pJSPChildMemberNameSH :: P.Parser JSPChildSegment-pJSPChildMemberNameSH = do-  P.char '.'-  P.lookAhead (P.letter <|> P.oneOf "-" <|> pUnicodeChar)-  val <- T.pack <$> P.many1 (P.alphaNum <|> (P.oneOf "-" <|> pUnicodeChar))-  return (JSPChildMemberNameSH val)+pLogicalAndExpr :: P.Parser LogicalAndExpr+pLogicalAndExpr = do+  expr <- pBasicExpr+  optionalExprs <- P.many pAndSepBasicExprs+  return $ LogicalAnd (expr:optionalExprs)+    where+      pAndSepBasicExprs :: P.Parser BasicExpr+      pAndSepBasicExprs = P.try $ pSpaces *> P.string "&&" *> pSpaces *> pBasicExpr -pJSPChildWildSeg :: P.Parser JSPChildSegment-pJSPChildWildSeg = JSPChildWildSeg <$> (P.string ".*" $> JSPWildcard)+pBasicExpr :: P.Parser BasicExpr+pBasicExpr = P.try pParenExpr+          <|> P.try pComparisonExpr+          <|> P.try pTestExpr +pParenExpr :: P.Parser BasicExpr+pParenExpr = do+  notOp <- P.optionMaybe (P.char '!' <* pSpaces)+  P.char '('+  pSpaces+  expr <- pLogicalOrExpr+  pSpaces+  P.char ')'+  let parenExp = if isNothing notOp then Paren expr else NotParen expr+  return parenExp -pJSPDescSegment :: P.Parser JSPSegment-pJSPDescSegment = -  JSPDescSeg <$> (P.try pJSPDescBracketed -                  <|> P.try pJSPDescMemberNameSH -                  <|> P.try pJSPDescWildSeg)+pTestExpr :: P.Parser BasicExpr+pTestExpr = do+  notOp <- P.optionMaybe (P.char '!' <* pSpaces)+  q <- P.try pRootQuery <|> P.try pCurrentQuery+  let testExp = if isNothing notOp then Test q else NotTest q+  return testExp -pJSPDescBracketed :: P.Parser JSPDescSegment-pJSPDescBracketed =  do-  P.string ".."-  P.char '['-  sel <- pJSPSelector-  optionalSels <- P.many pCommaSepSelectors-  P.char ']'-  return $ JSPDescBracketed (sel:optionalSels)-    where-      pCommaSepSelectors :: P.Parser JSPSelector-      pCommaSepSelectors = P.char ',' *> P.spaces *> pJSPSelector+pComparisonExpr :: P.Parser BasicExpr+pComparisonExpr = do+  leftC <- pComparable+  pSpaces+  compOp <- pComparisonOp+  pSpaces+  Comparison . Comp leftC compOp <$> pComparable -pJSPDescMemberNameSH :: P.Parser JSPDescSegment-pJSPDescMemberNameSH = do-  P.string ".."-  P.lookAhead (P.letter <|> P.oneOf "-" <|> pUnicodeChar)-  val <- T.pack <$> P.many1 (P.alphaNum <|> P.oneOf "-" <|> pUnicodeChar)-  return (JSPDescMemberNameSH val)+pComparisonOp :: P.Parser ComparisonOp+pComparisonOp = P.try (P.string ">=" $> GreaterOrEqual)+                <|> P.try (P.string "<=" $> LessOrEqual)+                <|> P.try (P.char '>' $> Greater)+                <|> P.try (P.char '<' $> Less)+                <|> P.try (P.string "!=" $> NotEqual)+                <|> P.try (P.string "==" $> Equal) -pJSPDescWildSeg :: P.Parser JSPDescSegment-pJSPDescWildSeg = JSPDescWildSeg <$> (P.string "..*" $> JSPWildcard)+pComparable :: P.Parser Comparable+pComparable = P.try pCompLitString+              <|> P.try pCompLitNum+              <|> P.try pCompLitBool+              <|> P.try pCompLitNull+              <|> P.try pCompSQ +pCompLitString :: P.Parser Comparable+pCompLitString = CompLitString . T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted)++pCompLitNum :: P.Parser Comparable+pCompLitNum = CompLitNum +           <$> (P.try (P.string "-0" $> (0 :: Scientific)) -- edge case+           <|> P.try pDoubleScientific +           <|> P.try pScientific)++pCompLitBool :: P.Parser Comparable+pCompLitBool = CompLitBool <$> (P.try (P.string "true" $> True) <|> P.try (P.string "false" $> False))++pCompLitNull :: P.Parser Comparable+pCompLitNull = P.string "null" $> CompLitNull++pCompSQ :: P.Parser Comparable+pCompSQ = CompSQ <$> (P.try pCurrentSingleQ <|> P.try pRootSingleQ)++pCurrentSingleQ :: P.Parser SingularQuery+pCurrentSingleQ = do+  P.char '@'+  segs <- P.many pSingularQuerySegment+  return $ SingularQuery { singularQueryType = CurrentSQ, singularQuerySegments = segs }++pRootSingleQ :: P.Parser SingularQuery+pRootSingleQ = do+  P.char '$'+  segs <- P.many pSingularQuerySegment+  return $ SingularQuery { singularQueryType = RootSQ, singularQuerySegments = segs }++pSingularQuerySegment :: P.Parser SingularQuerySegment+pSingularQuerySegment = P.try pSingularQNameSeg <|> P.try pSingularQIndexSeg++pSingularQNameSeg :: P.Parser SingularQuerySegment+pSingularQNameSeg = P.try pSingularQNameBracketed <|> P.try pSingularQNameDotted+  where+    pSingularQNameBracketed = do+      P.char '['+      name <- T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted)+      P.char ']'+      return $ NameSQSeg name++    pSingularQNameDotted = do+      P.char '.'+      P.lookAhead (P.letter <|> P.oneOf "_" <|> pUnicodeChar)+      name <- T.pack <$> P.many1 (P.alphaNum <|> P.oneOf "_" <|> pUnicodeChar)+      return $ NameSQSeg name++pSingularQIndexSeg :: P.Parser SingularQuerySegment+pSingularQIndexSeg = do+  P.char '['+  idx <- pSignedInt+  P.char ']'+  return $ IndexSQSeg idx+ pSignedInt :: P.Parser Int pSignedInt = do+  P.notFollowedBy (P.string "-0" *> P.optional P.digit) -- no leading -011... etc+  P.notFollowedBy (P.char   '0' *> P.digit) -- no leading 011... etc   sign <- P.optionMaybe $ P.char '-'+  num <- (read <$> P.many1 P.digit) :: P.Parser Integer+  checkNumOutOfRange num sign+  where+    minInt = -9007199254740991+    maxInt = 9007199254740991+    checkNumOutOfRange num (Just _) =+      if -num < minInt then fail "out of range"+      else return $ integerToInt (-num)++    checkNumOutOfRange num Nothing =+      if num > maxInt then fail "out of range"+      else return $ integerToInt num++-- TODO: Fix Double parse error  "1.12e+23"+pScientific :: P.Parser Scientific+pScientific = do+  mantissa <- pSignedInt+  expo <- P.optionMaybe (P.oneOf "eE" *> pExponent)+  return $ scientific (integerFromInt mantissa) (fromMaybe 0 expo)++pDoubleScientific :: P.Parser Scientific+pDoubleScientific = do+  whole <- P.many1 P.digit+  P.char '.'+  frac <- P.many1 P.digit+  expo <- P.optionMaybe (P.oneOf "eE" *> pExponent)+  let num = read (whole ++ "." ++ frac ++ maybe "" (\x -> "e" ++ show x) expo) :: Scientific+  return num++pExponent :: P.Parser Int+pExponent = do+  sign <- P.optionMaybe (P.oneOf "+-")   num <- read <$> P.many1 P.digit-  return $ -    case sign of-      Just _ -> -num-      Nothing -> num+  return $ case sign of+    Just '-' -> -num+    _        -> num  pUnicodeChar :: P.Parser Char pUnicodeChar = P.satisfy inRange@@ -174,3 +286,90 @@     inRange c = let code = ord c in       (code >= 0x80 && code <= 0xD7FF) ||       (code >= 0xE000 && code <= 0x10FFFF)++-- https://www.rfc-editor.org/rfc/rfc9535#name-syntax+pSpaces :: P.Parser [Char]+pSpaces = P.many (P.oneOf " \n\r\t")++pSingleQuotted :: P.Parser String+pSingleQuotted = P.char '\'' *> P.many inQuote <* P.char '\''+  where+    inQuote = P.try pUnescaped+           <|> P.try (P.char '\"')+           <|> P.try (P.string "\\\'" $> '\'')+           <|> P.try pEscaped++pDoubleQuotted :: P.Parser String+pDoubleQuotted = P.char '\"' *> P.many inQuote <* P.char '\"'+  where+    inQuote = P.try pUnescaped+           <|> P.try (P.char '\'')+           <|> P.try (P.string "\\\"" $> '\"')+           <|> P.try pEscaped++pUnescaped :: P.Parser Char+pUnescaped = P.satisfy inRange+  where+    inRange c = let code = ord c in+      (code >= 0x20 && code <= 0x21) ||+      (code >= 0x23 && code <= 0x26) ||+      (code >= 0x28 && code <= 0x5B) ||+      (code >= 0x5D && code <= 0xD7FF) ||+      (code >= 0xE000 && code <= 0x10FFFF)++pEscaped :: P.Parser Char+pEscaped = do+  P.char '\\'+  P.try pEscapees <|> P.try pHexUnicode+  where+    pEscapees = P.try (P.char 'b' $> '\b')+            <|> P.try (P.char 'f' $> '\f')+            <|> P.try (P.char 'n' $> '\n')+            <|> P.try (P.char 'r' $> '\r')+            <|> P.try (P.char 't' $> '\t')+            <|> P.try (P.char '/')+            <|> P.try (P.char '\\')++pHexUnicode :: P.Parser Char+pHexUnicode = P.try pNonSurrogate <|> P.try pSurrogatePair+  where+    pNonSurrogate = P.try pNonSurrogateFirst <|> P.try pNonSurrogateSecond+      where+        pNonSurrogateFirst = do+          P.char 'u'+          c1 <- P.digit <|> P.oneOf "AaBbCcEeFf"+          c2 <- P.hexDigit+          c3 <- P.hexDigit+          c4 <- P.hexDigit+          return $ chr (read ("0x" ++ [c1,c2,c3,c4]) :: Int)++        pNonSurrogateSecond = do+          P.char 'u'+          c1 <- P.oneOf "Dd"+          c2 <- P.oneOf "01234567"+          c3 <- P.hexDigit+          c4 <- P.hexDigit+          return $ chr (read ("0x" ++ [c1,c2,c3,c4]) :: Int)++    pSurrogatePair = do+      P.char 'u'+      high <- pHighSurrogate+      P.char '\\'+      P.char 'u'+      fromHighAndLow high <$> pLowSurrogate+      where+        pHighSurrogate = do+          c1 <- P.oneOf "Dd"+          c2 <- P.oneOf "89AaBb"+          c3 <- P.hexDigit+          c4 <- P.hexDigit+          return (read ("0x" ++ [c1,c2,c3,c4]) :: Int)++        pLowSurrogate = do+          c1 <- P.oneOf "Dd"+          c2 <- P.oneOf "CcDdEeFf"+          c3 <- P.hexDigit+          c4 <- P.hexDigit+          return (read ("0x" ++ [c1,c2,c3,c4]) :: Int)+          +        fromHighAndLow hi lo = chr $ ((hi - 0xD800) * 0x400) + (lo - 0xDC00) + 0x10000

@@ -0,0 +1,290 @@+{-# 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'        = qQuery+  queryLocated' = qQueryLocated++instance Queryable QuerySegment where+  query'        = qQuerySegment+  queryLocated' = qQuerySegmentLocated++instance Queryable Segment where+  query'        = qSegment+  queryLocated' = qSegmentLocated++instance Queryable Selector where+  query'        = qSelector+  queryLocated' = qSelectorLocated++-- TODO: the whole module is kinda bloated, refactor+--    Blockers with refactoring: qQuery is used recursively++qQuery :: Query -> Value -> Value -> Vector Value+qQuery Query{..} root current = case queryType of+  Root    -> foldl applySegment (V.singleton root)    querySegments+  Current -> foldl applySegment (V.singleton current) querySegments+  where+    applySegment :: Vector Value -> QuerySegment -> Vector Value+    applySegment vec seg = join $ V.map (qQuerySegment seg root) vec++qQueryLocated :: Query -> Value -> Value -> String -> Vector (String,Value)+qQueryLocated Query{..} root current loc = case queryType of+  Root    -> foldl applySegment (V.singleton (loc,root))    querySegments+  Current -> foldl applySegment (V.singleton (loc,current)) querySegments+  where+    applySegment :: Vector (String,Value) -> QuerySegment -> Vector (String,Value)+    applySegment vec seg = join $ V.map (\(location,cur) -> qQuerySegmentLocated seg root cur location) vec++qQuerySegment :: QuerySegment -> Value -> Value -> Vector Value+qQuerySegment QuerySegment{..} root current = case segmentType of+  Child      -> joinAfterMap $ V.singleton current+  Descendant -> joinAfterMap $ allElemsRecursive current+  where+    joinAfterMap x = join $ V.map (qSegment segment root) x++qQuerySegmentLocated :: QuerySegment -> Value -> Value -> String -> Vector (String, Value)+qQuerySegmentLocated QuerySegment{..} root current loc = case segmentType of+  Child      -> joinAfterMap $ V.singleton (loc,current)+  Descendant -> joinAfterMap $ allElemsRecursiveLocated (loc,current)+  where+    joinAfterMap x = join $ V.map (\(location,cur) -> qSegmentLocated segment root cur location) x++qSegment :: Segment -> Value -> Value -> Vector Value+qSegment (Bracketed sels) root current = V.concat $ map (\sel -> qSelector sel root current) sels+qSegment (Dotted key) root current = qSelector (Name key) root current+qSegment WildcardSegment root current = qSelector WildcardSelector root current++qSegmentLocated :: Segment -> Value -> Value -> String -> Vector (String,Value)+qSegmentLocated (Bracketed sels) root current loc = V.concat $ map (\sel -> qSelectorLocated sel root current loc) sels+qSegmentLocated (Dotted key) root current loc = qSelectorLocated (Name key) root current loc+qSegmentLocated WildcardSegment root current loc = qSelectorLocated WildcardSelector root current loc+++-- TODO: Looks kinda ugly, make it pretty <3+allElemsRecursive :: Value -> Vector Value+allElemsRecursive o@(JSON.Object obj) = V.concat [+    V.singleton o,+    V.concat $ map allElemsRecursive (KM.elems obj)+  ]+allElemsRecursive a@(JSON.Array arr) = V.concat [+    V.singleton a,+    V.concat $ map allElemsRecursive (V.toList arr)+  ]+allElemsRecursive _ = V.empty++-- TODO: Looks kinda ugly, make it pretty <3+allElemsRecursiveLocated :: (String,Value) -> Vector (String,Value)+allElemsRecursiveLocated (loc, o@(JSON.Object obj)) = V.concat [+    V.singleton (loc,o),+    V.concat $ zipWith (curry allElemsRecursiveLocated) (replicate (length (KM.elems obj)) loc) (KM.elems obj)+  ]+allElemsRecursiveLocated (loc, a@(JSON.Array arr)) = V.concat [+    V.singleton (loc,a),+    V.concat $ zipWith (curry allElemsRecursiveLocated) (replicate (V.length arr) loc) (V.toList arr)+  ]+allElemsRecursiveLocated _ = V.empty+++qSelector :: Selector -> Value -> Value -> Vector Value+qSelector (Name key) _ (JSON.Object obj) = maybe V.empty  V.singleton $ KM.lookup (K.fromText key) obj+qSelector (Name _) _ _ = V.empty+qSelector (Index idx) _ (JSON.Array arr) = maybe V.empty V.singleton $ if idx >= 0 then (V.!?) arr idx else (V.!?) arr (idx + V.length arr)+qSelector (Index _) _ _ = V.empty+qSelector (ArraySlice startEndStep) _ (JSON.Array arr) = sliceArray startEndStep arr+qSelector (ArraySlice _) _ _ = V.empty+qSelector (Filter orExpr) root current = filterOrExpr orExpr root current+qSelector WildcardSelector _ cur = case cur of+    (JSON.Object obj) -> V.fromList $ KM.elems obj+    (JSON.Array arr)  -> arr+    _                 -> V.empty++qSelectorLocated :: Selector -> Value -> Value -> String -> Vector (String,Value)+qSelectorLocated (Name key) _ (JSON.Object obj) loc = maybe V.empty (\x-> V.singleton (loc ++ "['" ++ T.unpack key ++ "']", x)) $ KM.lookup (K.fromText key) obj+qSelectorLocated (Name _) _ _ _ = V.empty+qSelectorLocated (Index idx) _ (JSON.Array arr) loc = maybe V.empty (\x-> V.singleton (newLocation, x)) $ (V.!?) arr (getIndex idx)+  where+    newLocation = loc ++ "[" ++ show (getIndex idx) ++ "]"+    getIndex i = if i >= 0 then i else i + V.length arr+qSelectorLocated (Index _) _ _ _ = V.empty+qSelectorLocated (ArraySlice (start,end,step)) _ (JSON.Array arr) loc = sliceArrayLocated (start,end,step) $ V.zip (V.fromList locs) arr+  where+    locs = [ loc ++ "[" ++ show i ++ "]" | i <- indices ]+    indices = [0..(V.length arr - 1)]+qSelectorLocated (ArraySlice _) _ _ _ = V.empty+qSelectorLocated (Filter orExpr) root cur loc = filterOrExprLocated orExpr root cur loc+qSelectorLocated WildcardSelector _ cur loc = case cur of+    (JSON.Object obj) -> V.fromList $ zip (locsWithKeys obj) (KM.elems obj)+    (JSON.Array arr)  -> V.zip (V.fromList (locsWithIdxs arr)) arr+    _                 -> V.empty+    where+      locsWithKeys obj = map (\x -> loc ++ "['" ++ K.toString x ++ "']") (KM.keys obj)+      locsWithIdxs arr = map (\x -> loc ++ "[" ++ show x ++ "]") [0..(V.length arr)]+++sliceArray :: (Maybe Int, Maybe Int, Int) -> Vector Value -> Vector Value+sliceArray (start,end,step) vec =+  case compare step 0 of+    GT -> getSliceForward (maybe 0 normalize start) (maybe len normalize end) step vec+    LT -> getSliceReverse (maybe (len-1) normalize start) (maybe (-1) normalize end) step vec+    EQ -> V.empty+    where+      -- TODO: Looks kinda ugly, make it pretty <3+      len = V.length vec+      normalize i = if i >= 0 then i else len + i++      getSliceForward st en stp arr = loop lower V.empty+        where+          (lower,upper) = (min (max st 0) len, min (max en 0) len)++          loop i acc =+            if i < upper+              then loop (i+stp) $ V.snoc acc $ (V.!) arr (normalize i)+            else+              acc++      getSliceReverse st en stp arr = loop upper V.empty+        where+          (lower,upper) = (min (max en (-1)) (len-1), min (max st (-1)) (len-1))++          loop i acc =+            if lower < i+              then loop (i+stp) $ V.snoc acc $ (V.!) arr (normalize i)+            else+              acc+++sliceArrayLocated :: (Maybe Int, Maybe Int, Int) -> Vector (String,Value) -> Vector (String,Value)+sliceArrayLocated (start,end,step) vec =+  case compare step 0 of+    GT -> getSliceForward (maybe 0 normalize start) (maybe len normalize end) step vec+    LT -> getSliceReverse (maybe (len-1) normalize start) (maybe (-1) normalize end) step vec+    EQ -> V.empty+    where+      -- TODO: Looks kinda ugly, make it pretty <3+      len = V.length vec+      normalize i = if i >= 0 then i else len + i++      getSliceForward st en stp arr = loop lower V.empty+        where+          (lower,upper) = (min (max st 0) len, min (max en 0) len)++          loop i acc =+            if i < upper+              then loop (i+stp) $ V.snoc acc $ (V.!) arr (normalize i)+            else+              acc++      getSliceReverse st en stp arr = loop upper V.empty+        where+          (lower,upper) = (min (max en (-1)) (len-1), min (max st (-1)) (len-1))++          loop i acc =+            if lower < i+              then loop (i+stp) $ V.snoc acc $ (V.!) arr (normalize i)+            else+              acc++filterOrExpr :: LogicalOrExpr -> Value -> Value -> Vector Value+filterOrExpr expr root (JSON.Object obj) = V.filter (evaluateLogicalOrExpr expr root) (V.fromList $ KM.elems obj)+filterOrExpr expr root (JSON.Array arr) = V.filter (evaluateLogicalOrExpr expr root) arr+filterOrExpr _ _ _ = V.empty++filterOrExprLocated :: LogicalOrExpr -> Value -> Value -> String -> Vector (String,Value)+filterOrExprLocated expr root (JSON.Object obj) loc = V.filter (\(_,x) -> evaluateLogicalOrExpr expr root x) (V.fromList $ zip locsWithKeys (KM.elems obj))+  where+    locsWithKeys = map (\x -> loc ++ "['" ++ K.toString x ++ "']") (KM.keys obj)+filterOrExprLocated expr root (JSON.Array arr) loc = V.filter (\(_,x) -> evaluateLogicalOrExpr expr root x) (V.zip (V.fromList locsWithIdxs) arr)+  where+    locsWithIdxs = map (\x -> loc ++ "[" ++ show x ++ "]") [0..(V.length arr - 1)]+filterOrExprLocated _ _ _ _ = V.empty+++evaluateLogicalOrExpr :: LogicalOrExpr -> Value -> Value -> Bool+evaluateLogicalOrExpr (LogicalOr exprs) root cur = any (\x -> evaluateLogicalAndExpr x root cur) exprs+++evaluateLogicalAndExpr :: LogicalAndExpr -> Value -> Value -> Bool+evaluateLogicalAndExpr (LogicalAnd exprs) root cur = all (\x -> evaluateBasicExpr x root cur) exprs+++evaluateBasicExpr :: BasicExpr -> Value -> Value -> Bool+evaluateBasicExpr (Paren expr) root cur = evaluateLogicalOrExpr expr root cur+evaluateBasicExpr (NotParen expr) root cur = not $ evaluateLogicalOrExpr expr root cur+evaluateBasicExpr (Test expr) root cur = evaluateTestExpr expr root cur+evaluateBasicExpr (NotTest expr) root cur = not $ evaluateTestExpr expr root cur+evaluateBasicExpr (Comparison expr) root cur = evaluateCompExpr expr root cur+++evaluateTestExpr :: TestExpr -> Value -> Value -> Bool+evaluateTestExpr expr root cur = not $ null $ qQuery expr root cur+++evaluateCompExpr :: ComparisonExpr -> Value -> Value -> Bool+evaluateCompExpr (Comp leftC op rightC) root cur  = compareVals op (getComparableVal leftC root cur) (getComparableVal rightC root cur)+++compareVals :: ComparisonOp -> Maybe Value -> Maybe Value -> Bool+compareVals Less (Just (JSON.String s1)) (Just (JSON.String s2)) = s1 < s2+compareVals Less (Just (JSON.Number n1)) (Just (JSON.Number n2)) = n1 < n2+compareVals Less _  _ = False++compareVals LessOrEqual    o1 o2 = compareVals Less o1 o2 || compareVals Equal o1 o2+compareVals Greater        o1 o2 = compareVals Less o2 o1+compareVals GreaterOrEqual o1 o2 = compareVals Less o2 o1 || compareVals Equal o1 o2+compareVals Equal          o1 o2 = o1 == o2+compareVals NotEqual       o1 o2 = o1 /= o2+++getComparableVal :: Comparable -> Value -> Value -> Maybe Value+getComparableVal (CompLitNum num) _ _ = Just $ JSON.Number num+getComparableVal (CompLitString txt) _ _ = Just $ JSON.String txt+getComparableVal (CompLitBool bool) _ _ = Just $ JSON.Bool bool+getComparableVal CompLitNull _ _ = Just JSON.Null+getComparableVal (CompSQ SingularQuery{..}) root cur = case singularQueryType of+  RootSQ -> traverseSingularQSegs (Just root) singularQuerySegments+  CurrentSQ -> traverseSingularQSegs (Just cur) singularQuerySegments+++traverseSingularQSegs :: Maybe Value -> [SingularQuerySegment] -> Maybe Value+traverseSingularQSegs = foldl 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 (Just (JSON.Object obj)) (NameSQSeg txt) = KM.lookup (K.fromText txt) obj+lookupSingleQSeg (Just (JSON.Array arr)) (IndexSQSeg idx) = (V.!?) arr idx+lookupSingleQSeg _ _ = Nothing

@@ -0,0 +1,139 @@+{-# LANGUAGE DeriveLift #-}+{- |+Module      : Data.Aeson.JSONPath.Query.Types+Description : ADTs used internally+Copyright   : (c) 2024-2025 Taimoor Zaeem+License     : MIT+Maintainer  : Taimoor Zaeem <mtaimoorzaeem@gmail.com>+Stability   : Experimental+Portability : Portable++This module contains the data structures.+-}+module Data.Aeson.JSONPath.Query.Types+  (Query (..)+  , QueryType (..)+  , Segment (..)+  , QuerySegment (..)+  , SegmentType (..)+  , Selector (..)+  , LogicalOrExpr (..)+  , LogicalAndExpr (..)+  , BasicExpr (..)+  , TestExpr+  , ComparisonExpr (..)+  , ComparisonOp (..)+  , Comparable(..)+  , SingularQuery (..)+  , SingularQueryType (..)+  , SingularQuerySegment (..)+  )+  where++import Data.Text                   (Text)+import Data.Scientific             (Scientific)+import Language.Haskell.TH.Syntax  (Lift)++import Prelude++-- |+data QueryType +  = Root +  | Current+  deriving (Eq, Show, Lift)++-- |+data Query = Query+  { queryType     :: QueryType+  , querySegments :: [QuerySegment]+  } deriving (Eq, Show, Lift)++-- |+data SegmentType+  = Child+  | Descendant+  deriving (Eq, Show, Lift)++-- |+data QuerySegment = QuerySegment+  { segmentType :: SegmentType+  , segment     :: Segment+  } deriving (Eq, Show, Lift)++-- |+data Segment+  = Bracketed [Selector]+  | Dotted Text+  | WildcardSegment+  deriving (Eq, Show, Lift)++-- |+data Selector+  = Name Text+  | Index Int+  | ArraySlice (Maybe Int, Maybe Int, Int)+  | Filter LogicalOrExpr+  | WildcardSelector+  deriving (Eq, Show, Lift)++-- |+newtype LogicalOrExpr+  = LogicalOr [LogicalAndExpr]+  deriving (Eq, Show, Lift)++-- |+newtype LogicalAndExpr+  = LogicalAnd [BasicExpr]+  deriving (Eq, Show, Lift)++-- |+data BasicExpr+  = Paren LogicalOrExpr -- ( expr )+  | NotParen LogicalOrExpr -- not (expr)+  | Test TestExpr -- expr+  | NotTest TestExpr -- not expr+  | Comparison ComparisonExpr+  deriving (Eq, Show, Lift)++-- |+type TestExpr = Query++-- |+data ComparisonExpr+  = Comp Comparable ComparisonOp Comparable+  deriving (Eq, Show, Lift)++-- |+data ComparisonOp+  = Less+  | LessOrEqual+  | Greater+  | GreaterOrEqual+  | Equal+  | NotEqual+  deriving (Eq, Show, Lift)++-- |+data Comparable+  = CompLitString Text+  | CompLitNum Scientific+  | CompLitBool Bool+  | CompLitNull+  | CompSQ SingularQuery+  deriving (Eq, Show, Lift)++-- |+data SingularQueryType = RootSQ | CurrentSQ+  deriving (Eq, Show, Lift)++-- |+data SingularQuery = SingularQuery+  { singularQueryType     :: SingularQueryType+  , singularQuerySegments :: [SingularQuerySegment]+  } deriving (Eq, Show, Lift)++-- |+data SingularQuerySegment+  = NameSQSeg Text+  | IndexSQSeg Int+  deriving (Eq, Show, Lift)

@@ -0,0 +1,85 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}+module ComplianceSpec+  ( spec+  , TestSuite (..))+  where++import qualified Data.Aeson                    as JSON+import qualified Data.Vector                   as V+import qualified Text.ParserCombinators.Parsec as P++import Control.Monad              (mzero)+import Data.Aeson                 ((.:),(.:?),Value)+import Data.Aeson.JSONPath        (query)+import Data.Aeson.JSONPath.Parser (pQuery)+import Data.Either                (isLeft, fromRight)+import Data.Vector                (Vector)++import Test.Hspec+import Prelude++data TestSuite = TestSuite+  { tests :: [TestCase]+  } deriving (Show)++instance JSON.FromJSON TestSuite where+  parseJSON (JSON.Object o) =+    TestSuite+    <$> o .: "tests"++  parseJSON _ = mzero++data TestCase = TestCase+  { name       :: String+  , selector   :: String+  , document   :: Maybe Value+  , result     :: Maybe (Vector Value)+  , results    :: Maybe [Vector Value]+  , invalidSel :: Maybe Bool+  , tags       :: Maybe [String]+  } deriving (Show)++instance JSON.FromJSON TestCase where+  parseJSON (JSON.Object o) =+    TestCase+    <$> o .: "name"+    <*> o .: "selector"+    <*> o .:? "document"+    <*> o .:? "result"+    <*> o .:? "results"+    <*> o .:? "invalid_selector"+    <*> o .:? "tags"++  parseJSON _ = mzero++spec :: TestSuite -> Spec+spec TestSuite{tests} = do+  describe "compliance tests" $ do+    mapM_ runTestCase tests+++runTestCase :: TestCase -> SpecWith ()+-- skip function extension tests+runTestCase tc@TestCase{tags=Just xs, ..} =+  if (elem "function" xs)+    then xit name pending+  else+    runTestCase tc{tags=Nothing}++-- invalid selector should not parse correctly+runTestCase TestCase{invalidSel=(Just True), ..} =+  it name $+    P.parse pQuery "" selector `shouldSatisfy` isLeft++-- if result is deterministic (one json)+runTestCase TestCase{result=(Just r), document=(Just doc), ..} =+  it name $+    query selector doc `shouldBe` Right r++-- if result is non-deterministic (any json from the list of results)+runTestCase TestCase{results=(Just rs), document=(Just doc), ..} = do+  it name $+    query selector doc `shouldSatisfy` (\x -> elem (fromRight V.empty x) rs)++runTestCase _ = pure ()

@@ -0,0 +1,143 @@+module LocatedSpec+  ( spec )+  where++import qualified Data.Aeson        as JSON+import qualified Data.Vector       as V++import Data.Aeson.JSONPath  (queryLocatedQQ, jsonPath)+import Data.Aeson.QQ.Simple (aesonQQ)+import Data.Vector          (Vector)+import Test.Hspec++import Prelude++getVector :: JSON.Value -> Vector JSON.Value+getVector (JSON.Array arr) = arr+getVector _ = V.empty++-- taken from https://serdejsonpath.live/+rootDoc :: JSON.Value+rootDoc = [aesonQQ|{+    "store": {+      "books": [+        {+          "title": "Guns, Germs, and Steel",+          "author": "Jared Diamond",+          "category": "reference",+          "price": 24.99+        },+        {+          "title": "David Copperfield",+          "author": "Charles Dickens",+          "category": "fiction",+          "price": 12.99+        },+        {+          "title": "Moby Dick",+          "author": "Herman Melville",+          "category": "fiction",+          "price": 8.99+        },+        {+          "title": "Crime and Punishment",+          "author": "Fyodor Dostoevsky",+          "category": "fiction",+          "price": 19.99+        }+      ]+    }+  }|]+++storeDoc :: JSON.Value+storeDoc = [aesonQQ|+  {+    "books": [+      {+        "title": "Guns, Germs, and Steel",+        "author": "Jared Diamond",+        "category": "reference",+        "price": 24.99+      },+      {+        "title": "David Copperfield",+        "author": "Charles Dickens",+        "category": "fiction",+        "price": 12.99+      },+      {+        "title": "Moby Dick",+        "author": "Herman Melville",+        "category": "fiction",+        "price": 8.99+      },+      {+        "title": "Crime and Punishment",+        "author": "Fyodor Dostoevsky",+        "category": "fiction",+        "price": 19.99+      }+    ]+  }|]++booksDoc :: JSON.Value+booksDoc = [aesonQQ| [+      {+        "title": "Guns, Germs, and Steel",+        "author": "Jared Diamond",+        "category": "reference",+        "price": 24.99+      },+      {+        "title": "David Copperfield",+        "author": "Charles Dickens",+        "category": "fiction",+        "price": 12.99+      },+      {+        "title": "Moby Dick",+        "author": "Herman Melville",+        "category": "fiction",+        "price": 8.99+      },+      {+        "title": "Crime and Punishment",+        "author": "Fyodor Dostoevsky",+        "category": "fiction",+        "price": 19.99+      }+  ]|]+++books0Doc :: JSON.Value+books0Doc = [aesonQQ|[+      {+        "title": "Guns, Germs, and Steel",+        "author": "Jared Diamond",+        "category": "reference",+        "price": 24.99+      }+  ]|]+++spec :: Spec+spec = do+  describe "test queryLocated" $ do+    it "returns root document when query is $" $+      queryLocatedQQ [jsonPath|$|] rootDoc `shouldBe` V.singleton ("$",rootDoc)++    it "returns store object when queryQQ is $.store" $+      queryLocatedQQ [jsonPath|$.store|] rootDoc `shouldBe` V.fromList [("$['store']",storeDoc)]++    it "returns store object when queryQQ is $['store']" $+      queryLocatedQQ [jsonPath|$['store']|] rootDoc `shouldBe` V.fromList [("$['store']",storeDoc)]++    it "returns books array when queryQQ is $.store.books" $+      queryLocatedQQ [jsonPath|$.store.books|] rootDoc `shouldBe` V.fromList [("$['store']['books']",booksDoc)]++    it "returns 0-index book item, $.store.books[0]" $+      queryLocatedQQ [jsonPath|$.store.books[0]|] rootDoc `shouldBe` V.zip (V.singleton "$['store']['books'][0]") (getVector books0Doc)++    it "returns 0-index book item, $.store.books[-4]" $+      queryLocatedQQ [jsonPath|$.store.books[-4]|] rootDoc `shouldBe` V.zip (V.singleton "$['store']['books'][0]") (getVector books0Doc)

@@ -2,25 +2,44 @@   ( main )   where -import qualified Test.Hspec        as HS-import Test.Hspec.Runner+import qualified Data.Aeson         as JSON+import qualified Test.Hspec         as HS+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO       as TIO +import Data.Either                  (fromRight)+ import qualified ParserSpec import qualified QuerySpec+import qualified ComplianceSpec+import qualified LocatedSpec+import qualified Paths_aeson_jsonpath as Paths +import ComplianceSpec   (TestSuite (..))++import Test.Hspec.Runner import Prelude -allSpecs :: Spec-allSpecs = do+allSpecs :: Either String TestSuite -> Spec+allSpecs cts = do   HS.describe "Run all tests" $ do     ParserSpec.spec     QuerySpec.spec+    ComplianceSpec.spec (fromRight TestSuite{tests=[]} cts)+    LocatedSpec.spec +readCtsFile :: FilePath -> IO (Either String TestSuite)+readCtsFile filePath = do+  contents <- TIO.readFile filePath+  return $ JSON.eitherDecodeStrict' $ T.encodeUtf8 contents+ main :: IO () main = do+  file <- Paths.getDataFileName "test/cts.json"+  cts <- readCtsFile file   summary <- hspecWithResult defaultConfig -    { configColorMode = ColorAuto     -- Colorized output-    } allSpecs+    { configColorMode = ColorAuto+    } (allSpecs cts)      putStrLn $ "Total tests: " ++ show (summaryExamples summary)-  putStrLn $ "Failures: " ++ show (summaryFailures summary)+  putStrLn $ "Failures: "    ++ show (summaryFailures summary)

@@ -3,65 +3,440 @@   where  import qualified Text.ParserCombinators.Parsec as P-import Test.Hspec -import Data.Aeson.JSONPath.Parser (pJSPQuery-                                  , JSPQuery (..)-                                  , JSPSegment (..)-                                  , JSPChildSegment (..)-                                  , JSPDescSegment (..)-                                  , JSPSelector (..)-                                  , JSPWildcardT (..))-import Data.Either                (isLeft)+import Data.Aeson.JSONPath.Parser       (pQuery)+import Data.Either                      (isLeft)++import Data.Aeson.JSONPath.Query.Types+import Test.Hspec import Prelude  spec :: Spec spec = do-  describe "Parse JSPQuery" $ do+  describe "Parse query string" $ do     it "parses query: $" $-      P.parse pJSPQuery "" "$" `shouldBe` Right (JSPRoot [])+      P.parse pQuery "" "$"+      `shouldBe`+      Right (Query{queryType=Root,querySegments=[]})      it "parses query: $.store" $-      P.parse pJSPQuery "" "$.store" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store")])+      P.parse pQuery "" "$.store"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }]+      } +    it "parses query: $['store']" $+      P.parse pQuery "" "$['store']"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Bracketed [Name "store"]+        }]+      }+     it "parses query: $.store.books" $-      P.parse pJSPQuery "" "$.store.books" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books")])+      P.parse pQuery "" "$.store.books"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+          }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }]+      }      it "parses query: $.store.books[0]" $-      P.parse pJSPQuery "" "$.store.books[0]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPIndexSel 0])])+      P.parse pQuery "" "$.store.books[0]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }, QuerySegment {+          segmentType = Child,+          segment = Bracketed [Index 0]+        }]+      }      it "parses query: $.store.books[0,2]" $-      P.parse pJSPQuery "" "$.store.books[0,2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPIndexSel 0, JSPIndexSel 2])])+      P.parse pQuery "" "$.store.books[0,2]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }, QuerySegment {+          segmentType = Child,+          segment = Bracketed [Index 0, Index 2]+        }]+      }      it "parses query: $.store.books[1:3]" $-      P.parse pJSPQuery "" "$.store.books[1:3]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just 1, Just 3, 1)])])+      P.parse pQuery "" "$.store.books[1:3]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }, QuerySegment {+          segmentType = Child,+          segment = Bracketed [ArraySlice (Just 1, Just 3, 1)]+        }]+      }      it "parses query: $.store.books[1:4:2]" $-      P.parse pJSPQuery "" "$.store.books[1:4:2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just 1, Just 4, 2)])])+      P.parse pQuery "" "$.store.books[1:4:2]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }, QuerySegment {+          segmentType = Child,+          segment = Bracketed [ArraySlice (Just 1, Just 4, 2)]+        }]+      }      it "parses query: $.store.books[-1:-4:-2]" $-      P.parse pJSPQuery "" "$.store.books[-1:-4:-2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just (-1), Just (-4), -2)])])+      P.parse pQuery "" "$.store.books[-1:-4:-2]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }, QuerySegment {+          segmentType = Child,+          segment = Bracketed [ArraySlice (Just (-1), Just (-4), (-2))]+        }]+      }      it "parses query: $.store.books[1:3, 0, 1]" $-      P.parse pJSPQuery "" "$.store.books[1:3, 0, 1]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just 1, Just 3, 1), JSPIndexSel 0, JSPIndexSel 1])])+      P.parse pQuery "" "$.store.books[1:3, 0, 1]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "store"+        }, QuerySegment {+          segmentType = Child,+          segment = Dotted "books"+        }, QuerySegment {+          segmentType = Child,+          segment = Bracketed [ArraySlice (Just 1, Just 3, 1), Index 0, Index 1]+        }]+      }      it "parses query: $.*" $-      P.parse pJSPQuery "" "$.*" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildWildSeg JSPWildcard)])+      P.parse pQuery "" "$.*" +      `shouldBe` +      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = WildcardSegment+        }]+      }      it "parses query: $[*]" $-      P.parse pJSPQuery "" "$[*]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildBracketed [JSPWildSel JSPWildcard])])+      P.parse pQuery "" "$[*]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Bracketed [WildcardSelector]+        }]+      }      it "parses query: $..*" $-      P.parse pJSPQuery "" "$..*" `shouldBe` Right (JSPRoot [JSPDescSeg (JSPDescWildSeg JSPWildcard)])+      P.parse pQuery "" "$..*"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Descendant,+          segment = WildcardSegment+        }]+      }      it "parses query: $..[*]" $-      P.parse pJSPQuery "" "$..[*]" `shouldBe` Right (JSPRoot [JSPDescSeg (JSPDescBracketed [JSPWildSel JSPWildcard])])--    it "parses query $.hyphen-key" $-      P.parse pJSPQuery "" "$.hyphen-key" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "hyphen-key")])+      P.parse pQuery "" "$..[*]"+      `shouldBe` +      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Descendant,+          segment = Bracketed [WildcardSelector]+        }]+      }      it "fails with $.1startsWithNum" $-      P.parse pJSPQuery "" "$.1startsWithNum" `shouldSatisfy` isLeft+      P.parse pQuery "" "$.1startsWithNum"+      `shouldSatisfy` isLeft      it "parses query $.©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ" $-      P.parse pJSPQuery "" "$.©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ")])+      P.parse pQuery "" "$.©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ"+        }]+      }++    it "parses query: $._" $+      P.parse pQuery "" "$._"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "_"+        }]+      }++    it "parses query: $.underscore_key" $+      P.parse pQuery "" "$.underscore_key"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Dotted "underscore_key"+        }]+      }++    it "parses query: $[0,TAB/LINEFEED/RETURN/SPACE1]" $+      P.parse pQuery "" "$[0,\n\t\r 1]"+      `shouldBe`+      Right Query {+        queryType = Root,+        querySegments = [QuerySegment {+          segmentType = Child,+          segment = Bracketed [Index 0, Index 1]+        }]+      }++    describe "parses JSPFilter Query" $ do+      it "$[?@.category == 'reference']" $+        P.parse pQuery "" "$[?@.category == 'reference']"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "category"]+            }) Equal (CompLitString "reference"))]])]+          }]+        }++      it "test expr: $..books[?@.price].title" $+        P.parse pQuery "" "$..books[?@.price].title"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Descendant,+            segment = Dotted "books"+          }, QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Test Query {+              queryType = Current,+              querySegments = [QuerySegment {+                segmentType = Child,+                segment = Dotted "price"+              }]+            }]])]+          }, QuerySegment {+            segmentType = Child,+            segment = Dotted "title"+          }]+        }++      it "and expr: $[?@.price < 20 && @.price > 10]" $+        P.parse pQuery "" "$[?@.price < 20 && @.price > 10]" +        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Less (CompLitNum 20.0)), Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Greater (CompLitNum 10.0))]])]+          }]+        }++      it "or expr: $[?@.price < 20 || @.price > 10]" $+        P.parse pQuery "" "$[?@.price < 20 || @.price > 10]"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Less (CompLitNum 20.0))], LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Greater (CompLitNum 10.0))]])]+          }]+        }++      it "root filter: $..books[?$.price].title" $+        P.parse pQuery "" "$..books[?$.price].title"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Descendant,+            segment = Dotted "books"+          }, QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Test Query {+              queryType = Root,+              querySegments = [QuerySegment {+                segmentType = Child,+                segment = Dotted "price"+              }]+            }]])]+          }, QuerySegment {+            segmentType = Child,+            segment = Dotted "title"+          }]+        }++      it "not expr: $[?!(@.price < 20 && @.price > 10)]" $+        P.parse pQuery "" "$[?!(@.price < 20 && @.price > 10)]" +        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [NotParen (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            })  Less (CompLitNum 20.0)), Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Greater (CompLitNum 10.0))]])]])]+          }]+        }++      it "scientific: $.store.books[?@.price < -1e20]" $+        P.parse pQuery "" "$.store.books[?@['price'] < -1e20]"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Dotted "store"+          }, QuerySegment {+            segmentType = Child,+            segment = Dotted "books"+          }, QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Less (CompLitNum (-1.0e20)))]])]+          }]+        }++      it "double: $.store.books[?@.price < 0.01]" $+        P.parse pQuery "" "$.store.books[?@['price'] < 0.01]"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Dotted "store"+          }, QuerySegment {+            segmentType = Child,+            segment = Dotted "books"+          }, QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "price"]+            }) Less (CompLitNum (1.0e-2)))]])]+          }]+        }++      it "bool: $.store.books[?@.is_available == true]" $+        P.parse pQuery "" "$.store.books[?@.is_available == true]"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Dotted "store"+          }, QuerySegment {+            segmentType = Child,+            segment = Dotted "books"+          }, QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "is_available"]+            }) Equal (CompLitBool True))]])]+          }]+        }++      it "null: $.store.books[?@.is_available == null]" $+        P.parse pQuery "" "$.store.books[?@.is_available == null]"+        `shouldBe`+        Right Query {+          queryType = Root,+          querySegments = [QuerySegment {+            segmentType = Child,+            segment = Dotted "store"+          }, QuerySegment {+            segmentType = Child,+            segment = Dotted "books"+          }, QuerySegment {+            segmentType = Child,+            segment = Bracketed [Filter (LogicalOr [LogicalAnd [Comparison (Comp (CompSQ SingularQuery {+              singularQueryType = CurrentSQ,+              singularQuerySegments = [NameSQSeg "is_available"]+            }) Equal CompLitNull)]])]+          }]+        }

@@ -5,14 +5,16 @@ import qualified Data.Aeson        as JSON import qualified Data.Vector       as V -import Data.Aeson.JSONPath  (runJSPQuery, jsonPath)+import Data.Aeson.JSONPath  (queryQQ, jsonPath) import Data.Aeson.QQ.Simple (aesonQQ)+import Data.Vector          (Vector) import Test.Hspec  import Prelude -toSingletonArray :: JSON.Value -> JSON.Value-toSingletonArray = JSON.Array . V.singleton+getVector :: JSON.Value -> Vector JSON.Value+getVector (JSON.Array arr) = arr+getVector _ = V.empty  -- taken from https://serdejsonpath.live/ rootDoc :: JSON.Value@@ -178,6 +180,27 @@       }   ]|] +lessThanPrice20Books :: JSON.Value+lessThanPrice20Books = [aesonQQ| [+      {+        "title": "David Copperfield",+        "author": "Charles Dickens",+        "category": "fiction",+        "price": 12.99+      },+      {+        "title": "Moby Dick",+        "author": "Herman Melville",+        "category": "fiction",+        "price": 8.99+      },+      {+        "title": "Crime and Punishment",+        "author": "Fyodor Dostoevsky",+        "category": "fiction",+        "price": 19.99+      }+  ]|]  alphaArr :: JSON.Value alphaArr = [aesonQQ| ["a","b","c","d","e","f","g"] |]@@ -215,54 +238,105 @@     2   ]|] +boolsAndNulls :: JSON.Value+boolsAndNulls = [aesonQQ| [+    { "a": true },+    { "a": false },+    { "a": null }+  ]|]+++boolsAndNullsA :: JSON.Value+boolsAndNullsA = [aesonQQ| [{ "a": true }] |]++boolsAndNullsB :: JSON.Value+boolsAndNullsB = [aesonQQ| [{ "a": false }] |]++boolsAndNullsC :: JSON.Value+boolsAndNullsC = [aesonQQ| [{ "a": null }] |]+ spec :: Spec spec = do-  describe "Run JSPQuery on JSON documents" $ do+  describe "test query" $ do     it "returns root document when query is $" $-      runJSPQuery [jsonPath|$|] rootDoc `shouldBe` rootDoc+      queryQQ [jsonPath|$|] rootDoc `shouldBe` V.singleton rootDoc -    it "returns store object when query is $.store" $-      runJSPQuery [jsonPath|$.store|] rootDoc `shouldBe` storeDoc+    it "returns store object when queryQQ is $.store" $+      queryQQ [jsonPath|$.store|] rootDoc `shouldBe` V.singleton storeDoc -    it "returns books array when query is $.store.books" $-      runJSPQuery [jsonPath|$.store.books|] rootDoc `shouldBe` booksDoc+    it "returns store object when queryQQ is $['store']" $+      queryQQ [jsonPath|$['store']|] rootDoc `shouldBe` V.singleton storeDoc -    it "returns 0-index book item when query is $.store.books[0]" $-      runJSPQuery [jsonPath|$.store.books[0]|] rootDoc `shouldBe`  books0Doc+    it "returns books array when queryQQ is $.store.books" $+      queryQQ [jsonPath|$.store.books|] rootDoc `shouldBe` V.singleton booksDoc -    it "returns 0-index book item when query is $.store.books[-4]" $-      runJSPQuery [jsonPath|$.store.books[-4]|] rootDoc `shouldBe` books0Doc+    it "returns 0-index book item when queryQQ is $.store.books[0]" $+      queryQQ [jsonPath|$.store.books[0]|] rootDoc `shouldBe` getVector books0Doc -    it "returns 0,2-index item when query is $.store.books[0,2]" $-      runJSPQuery [jsonPath|$.store.books[0,2]|] rootDoc `shouldBe` books0And2Doc+    it "returns 0-index book item when queryQQ is $.store.books[-4]" $+      queryQQ [jsonPath|$.store.books[-4]|] rootDoc `shouldBe` getVector books0Doc -    it "returns 1To3-index when query is $.store.books[1:3]" $-      runJSPQuery [jsonPath|$.store.books[1:3]|] rootDoc `shouldBe` books1To3Doc+    it "returns 0,2-index item when queryQQ is $.store.books[0,2]" $+      queryQQ [jsonPath|$.store.books[0,2]|] rootDoc `shouldBe` getVector books0And2Doc -    it "returns 1To3-index and 0,1-index when query is $.store.books[1:3,0,1]" $-      runJSPQuery [jsonPath|$.store.books[1:3,0,1]|] rootDoc `shouldBe` books1To3And0And1Doc+    it "returns 1To3-index when queryQQ is $.store.books[1:3]" $+      queryQQ [jsonPath|$.store.books[1:3]|] rootDoc `shouldBe` getVector books1To3Doc -    it "returns slice with query $[5:]" $-      runJSPQuery [jsonPath|$[5:]|] alphaArr `shouldBe` fgArr+    it "returns 1To3-index and 0,1-index when queryQQ is $.store.books[1:3,0,1]" $+      queryQQ [jsonPath|$.store.books[1:3,0,1]|] rootDoc `shouldBe` getVector books1To3And0And1Doc -    it "returns slice with query $[1:5:2]" $-      runJSPQuery [jsonPath|$[1:5:2]|] alphaArr `shouldBe` bdArr+    it "returns slice with queryQQ $[5:]" $+      queryQQ [jsonPath|$[5:]|] alphaArr `shouldBe` getVector fgArr -    it "returns slice with query $[5:1:-2]" $-      runJSPQuery [jsonPath|$[5:1:-2]|] alphaArr `shouldBe` fdArr+    it "returns slice with queryQQ $[1:5:2]" $+      queryQQ [jsonPath|$[1:5:2]|] alphaArr `shouldBe` getVector bdArr -    it "returns slice with query $[::-1]" $-      runJSPQuery [jsonPath|$[::-1]|] alphaArr `shouldBe` gfedcbaArr+    it "returns slice with queryQQ $[5:1:-2]" $+      queryQQ [jsonPath|$[5:1:-2]|] alphaArr `shouldBe` getVector fdArr -    it "returns root with query $.*" $-      runJSPQuery [jsonPath|$.*|] rootDoc `shouldBe` rootDoc+    it "returns slice with queryQQ $[::-1]" $+      queryQQ [jsonPath|$[::-1]|] alphaArr `shouldBe` getVector gfedcbaArr -    it "returns root with query $[*]" $-      runJSPQuery [jsonPath|$[*]|] rootDoc `shouldBe` (toSingletonArray rootDoc)+    it "returns root with queryQQ $.*" $+      queryQQ [jsonPath|$.*|] rootDoc `shouldBe` V.singleton storeDoc -    it "returns root with query $..*" $-      runJSPQuery [jsonPath|$..*|] rfcExample1 `shouldBe` rfcExample1Desc+    it "returns root with queryQQ $[*]" $+      queryQQ [jsonPath|$[*]|] rootDoc `shouldBe` V.singleton storeDoc -    it "returns root with query $..[*]" $ do-      pendingWith "fix with wildcard selection"-      runJSPQuery [jsonPath|$..[*]|] rfcExample1 `shouldBe` rfcExample1Desc+    it "returns descendants with queryQQ $..*" $+      queryQQ [jsonPath|$..*|] rfcExample1 `shouldBe` getVector rfcExample1Desc++    it "returns descendants with queryQQ $..[*]" $+      queryQQ [jsonPath|$..[*]|] rfcExample1 `shouldBe` getVector rfcExample1Desc++    it "returns with filtering: number comparison" $+      queryQQ [jsonPath|$.store.books[?@.price < 20]|] rootDoc+      `shouldBe` getVector lessThanPrice20Books++    it "returns with filtering: not operator" $+      queryQQ [jsonPath|$.store.books[?!(@.price < 20)]|] rootDoc+      `shouldBe` getVector books0Doc++    it "returns with filtering: true value" $+      queryQQ [jsonPath|$[?@.a == true]|] boolsAndNulls+      `shouldBe` getVector boolsAndNullsA++    it "returns with filtering: false value" $+      queryQQ [jsonPath|$[?@.a == false]|] boolsAndNulls+      `shouldBe` getVector boolsAndNullsB++    it "returns with filtering: null value" $+      queryQQ [jsonPath|$[?@.a == null]|] boolsAndNulls+      `shouldBe` getVector boolsAndNullsC++    it "returns with filtering: string comparison" $+      queryQQ [jsonPath|$.store.books[?@.author == 'Jared Diamond']|] rootDoc+      `shouldBe` getVector books0Doc++    it "returns with filtering: test expression" $+      queryQQ [jsonPath|$.store.books[?@.author]|] rootDoc+      `shouldBe` getVector booksDoc++    it "returns with filtering: test expr gives empty with non-existent key" $+      queryQQ [jsonPath|$.store.books[?@.not_here]|] rootDoc+      `shouldBe` V.empty