aeson-jsonpath 0.3.0.2 → 0.4.0.0
raw patch · 15 files changed
+739/−63 lines, 15 filesdep +regex-tdfaPVP ok
version bump matches the API change (PVP)
Dependencies added: regex-tdfa
API changes (from Hackage documentation)
- Data.Aeson.JSONPath.Types: newtype TestExpr a
+ Data.Aeson.JSONPath.Types: ArgFuncExpr :: FunctionExpr a -> FunctionArg a
+ Data.Aeson.JSONPath.Types: ArgLit :: Literal -> FunctionArg a
+ Data.Aeson.JSONPath.Types: ArgLogicExpr :: LogicalOrExpr a -> FunctionArg a
+ Data.Aeson.JSONPath.Types: ArgQuery :: a -> FunctionArg a
+ Data.Aeson.JSONPath.Types: FunctionSearch :: FunctionName -> FunctionArg a -> FunctionArg a -> FunctionExpr a
+ Data.Aeson.JSONPath.Types: LogicalType :: Bool -> FunctionResult
+ Data.Aeson.JSONPath.Types: NodesType :: Vector Value -> FunctionResult
+ Data.Aeson.JSONPath.Types: Search :: FunctionName
+ Data.Aeson.JSONPath.Types: TestFunc :: FunctionExpr a -> TestExpr a
+ Data.Aeson.JSONPath.Types: ValueType :: Maybe Value -> FunctionResult
+ Data.Aeson.JSONPath.Types: [functionArg1] :: FunctionExpr a -> FunctionArg a
+ Data.Aeson.JSONPath.Types: [functionArg2] :: FunctionExpr a -> FunctionArg a
+ Data.Aeson.JSONPath.Types: [functionName] :: FunctionExpr a -> FunctionName
+ Data.Aeson.JSONPath.Types: data FunctionArg a
+ Data.Aeson.JSONPath.Types: data FunctionExpr a
+ Data.Aeson.JSONPath.Types: data FunctionName
+ Data.Aeson.JSONPath.Types: data FunctionResult
+ Data.Aeson.JSONPath.Types: data TestExpr a
Files
- CHANGELOG.md +5/−0
- README.md +28/−3
- aeson-jsonpath.cabal +11/−8
- jsonpath-compliance-test-suite/cts.json +491/−0
- src/Data/Aeson/JSONPath/Parser.hs +1/−0
- src/Data/Aeson/JSONPath/Parser/Common.hs +3/−2
- src/Data/Aeson/JSONPath/Parser/Filter.hs +44/−23
- src/Data/Aeson/JSONPath/Parser/Name.hs +6/−6
- src/Data/Aeson/JSONPath/Parser/Number.hs +6/−6
- src/Data/Aeson/JSONPath/Parser/Query.hs +13/−13
- src/Data/Aeson/JSONPath/Query/Filter.hs +51/−0
- src/Data/Aeson/JSONPath/Types/Filter.hs +43/−1
- test/compliance/ComplianceSpec.hs +14/−1
- test/spec/LocatedSpec.hs +19/−0
- test/spec/QuerySpec.hs +4/−0
CHANGELOG.md view
@@ -2,6 +2,11 @@ All notable changes to this package are documented in this file. This project adheres to [Haskell PVP](https://pvp.haskell.org/) versioning. +## 0.4.0.0++- #82, Implement `search()` function from function extensions+- #83, Improve parse errors+ ## 0.3.0.2 - #43, Fix spaces not allowed in relative query and singular query segments
README.md view
@@ -1,6 +1,6 @@ # aeson-jsonpath -[](https://github.com/taimoorzaeem/aeson-jsonpath/actions/workflows/build.yml) [](https://hackage.haskell.org/package/aeson-jsonpath) [](https://www.patreon.com/taimoorzaeem) [](https://github.com/taimoorzaeem/aeson-jsonpath/actions/workflows/compliance.yml)+[](https://github.com/taimoorzaeem/aeson-jsonpath/actions/workflows/build.yml) [](https://hackage.haskell.org/package/aeson-jsonpath) [](https://www.patreon.com/taimoorzaeem) [](https://github.com/taimoorzaeem/aeson-jsonpath/actions/workflows/compliance.yml) Run [RFC 9535](https://www.rfc-editor.org/rfc/rfc9535) compliant JSONPath queries on [Data.Aeson](https://hackage.haskell.org/package/aeson). @@ -17,8 +17,13 @@ - [x] Descendant Segment - [x] Normalized Paths - [ ] Function Extensions+ - [ ] `length()`+ - [ ] `count()`+ - [ ] `match()`+ - [x] `search()`+ - [ ] `value()` -I have decided not to implement Function Extension yet. Please open an issue or discussion if you'd like to see them implemented.+Function Extensions are not finished yet. Please open an issue or discussion if you'd like to see them implemented. ## Quick Start @@ -92,6 +97,12 @@ String "Panos Cosmatos", String "Xavier Dolan" ]+-- query along with locations+ghci> queryLocated "$..director" json+Right [+ ("$['shop']['movies'][0]['director']",String "Panos Cosmatos"),+ ("$['shop']['movies'][1]['director']",String "Xavier Dolan")+] ``` ### Slice Selector@@ -130,6 +141,19 @@ ] ``` +### Search Function++```hs+ghci> query "$.shop.movies[?search(@.director, 'Tarantino|Dolan')]" json+Right [+ Object (fromList [+ ("director",String "Xavier Dolan"),+ ("title",String "Laurence Anyways"),+ ("year",Number 2012.0)+ ])+]+```+ ### QuasiQuoter The functions `queryQQ` and `queryLocatedQQ` can be used with the `jsonPath` quasi quoter.@@ -144,7 +168,8 @@ 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.+> [!NOTE]+> All tests pass except tests related to **function extensions** which we have not implemented yet. ## Development
aeson-jsonpath.cabal view
@@ -1,5 +1,5 @@ name: aeson-jsonpath-version: 0.3.0.2+version: 0.4.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@@ -22,6 +22,8 @@ , GHC == 9.6.6 , GHC == 9.8.4 , GHC == 9.10.1+ , GHC == 9.12.2+ , GHC == 9.14.1 source-repository head type: git@@ -50,11 +52,12 @@ Data.Aeson.JSONPath.Types.Segment Data.Aeson.JSONPath.Types.Selector Data.Aeson.JSONPath.Types.Filter- build-depends: aeson >= 2.0.3 && < 2.3- , base >= 4.9 && < 4.22+ build-depends: aeson >= 2.0.3 && < 2.5+ , base >= 4.9 && < 4.23 , parsec >= 3.1.11 && < 3.2+ , regex-tdfa >= 1.3.2.2 && < 1.4 , scientific >= 0.3.4 && < 0.4- , template-haskell >= 2.12 && < 2.24+ , template-haskell >= 2.12 && < 2.25 , text >= 1.2.2 && < 2.2 , vector >= 0.11 && < 0.14 @@ -71,9 +74,9 @@ other-modules: ParserSpec QuerySpec LocatedSpec- build-depends: aeson >= 2.0.3 && < 2.3+ build-depends: aeson >= 2.0.3 && < 2.5 , aeson-jsonpath- , base >= 4.9 && < 4.22+ , base >= 4.9 && < 4.23 , hspec >= 2.3 && < 2.12 , parsec >= 3.1.11 && < 3.2 , vector >= 0.11 && < 0.14@@ -90,9 +93,9 @@ main-is: Main.hs other-modules: ComplianceSpec Paths_aeson_jsonpath- build-depends: aeson >= 2.0.3 && < 2.3+ build-depends: aeson >= 2.0.3 && < 2.5 , aeson-jsonpath- , base >= 4.9 && < 4.22+ , base >= 4.9 && < 4.23 , hspec >= 2.3 && < 2.12 , parsec >= 3.1.11 && < 3.2 , text >= 1.2.2 && < 2.2
jsonpath-compliance-test-suite/cts.json view
@@ -566,6 +566,57 @@ ] }, {+ "name": "basic, name shorthand, true",+ "selector": "$.true",+ "document": {+ "true": "A",+ "_foo": "B"+ },+ "result": [+ "A"+ ],+ "result_paths": [+ "$['true']"+ ],+ "tags": [+ "boundary"+ ]+ },+ {+ "name": "basic, name shorthand, false",+ "selector": "$.false",+ "document": {+ "false": "A",+ "_foo": "B"+ },+ "result": [+ "A"+ ],+ "result_paths": [+ "$['false']"+ ],+ "tags": [+ "boundary"+ ]+ },+ {+ "name": "basic, name shorthand, null",+ "selector": "$.null",+ "document": {+ "null": "A",+ "_foo": "B"+ },+ "result": [+ "A"+ ],+ "result_paths": [+ "$['null']"+ ],+ "tags": [+ "boundary"+ ]+ },+ { "name": "basic, descendant segment, wildcard shorthand, array data", "selector": "$..*", "document": [@@ -3981,6 +4032,272 @@ ] }, {+ "name": "filter, two consecutive ands",+ "selector": "$[?@.a && @.b && @.c]",+ "document": [+ {+ "a": 1,+ "b": 2+ },+ {+ "a": 1,+ "c": 3+ },+ {+ "b": 2,+ "c": 3+ },+ {+ "a": 1,+ "b": 2,+ "c": 3+ }+ ],+ "result": [+ {+ "a": 1,+ "b": 2,+ "c": 3+ }+ ],+ "result_paths": [+ "$[3]"+ ]+ },+ {+ "name": "filter, two consecutive ors",+ "selector": "$[?@.a || @.b || @.c]",+ "document": [+ {+ "a": 1,+ "b": 2+ },+ {+ "a": 1,+ "c": 3+ },+ {+ "b": 2,+ "c": 3+ },+ {+ "a": 1,+ "b": 2,+ "c": 3+ }+ ],+ "result": [+ {+ "a": 1,+ "b": 2+ },+ {+ "a": 1,+ "c": 3+ },+ {+ "b": 2,+ "c": 3+ },+ {+ "a": 1,+ "b": 2,+ "c": 3+ }+ ],+ "result_paths": [+ "$[0]",+ "$[1]",+ "$[2]",+ "$[3]"+ ]+ },+ {+ "name": "filter, multiple consecutive ands",+ "selector": "$[?@.a && @.b && @.c && @.d && @.e]",+ "document": [+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4+ },+ {+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "c": 3,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ }+ ],+ "result": [+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ }+ ],+ "result_paths": [+ "$[3]"+ ]+ },+ {+ "name": "filter, multiple consecutive ors",+ "selector": "$[?@.a || @.b || @.c || @.d || @.e]",+ "document": [+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4+ },+ {+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "c": 3,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ }+ ],+ "result": [+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4+ },+ {+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "c": 3,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ }+ ],+ "result_paths": [+ "$[0]",+ "$[1]",+ "$[2]",+ "$[3]"+ ]+ },+ {+ "name": "filter, multiple consecutive ors and ands",+ "selector": "$[?@.a && @.b && @.c || @.d || @.e]",+ "document": [+ {+ "a": 1+ },+ {+ "e": 5+ },+ {+ "a": 1,+ "b": 2+ },+ {+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3+ },+ {+ "c": 3,+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "c": 3,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ }+ ],+ "result": [+ {+ "e": 5+ },+ {+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3+ },+ {+ "c": 3,+ "d": 4,+ "e": 5+ },+ {+ "a": 1,+ "c": 3,+ "e": 5+ },+ {+ "a": 1,+ "b": 2,+ "c": 3,+ "d": 4,+ "e": 5+ }+ ],+ "result_paths": [+ "$[1]",+ "$[3]",+ "$[4]",+ "$[5]",+ "$[6]",+ "$[7]"+ ]+ },+ { "name": "filter, and binds more tightly than or", "selector": "$[?@.a || @.b && @.c]", "document": [@@ -4355,6 +4672,58 @@ ] }, {+ "name": "filter, quoted True, double quotes",+ "selector": "$[?@.a==\"True\"]",+ "document": [+ {+ "a": "True"+ },+ {+ "a": true+ },+ {+ "a": "SomethingElse"+ }+ ],+ "result": [+ {+ "a": "True"+ }+ ],+ "result_paths": [+ "$[0]"+ ],+ "tags": [+ "case"+ ]+ },+ {+ "name": "filter, quoted True, single quotes",+ "selector": "$[?@.a=='True']",+ "document": [+ {+ "a": "True"+ },+ {+ "a": true+ },+ {+ "a": "SomethingElse"+ }+ ],+ "result": [+ {+ "a": "True"+ }+ ],+ "result_paths": [+ "$[0]"+ ],+ "tags": [+ "case"+ ]+ },+ { "name": "filter, false, incorrectly capitalized", "selector": "$[?@==False]", "invalid_selector": true,@@ -4363,6 +4732,58 @@ ] }, {+ "name": "filter, quoted False, double quotes",+ "selector": "$[?@.a==\"False\"]",+ "document": [+ {+ "a": "False"+ },+ {+ "a": false+ },+ {+ "a": "SomethingElse"+ }+ ],+ "result": [+ {+ "a": "False"+ }+ ],+ "result_paths": [+ "$[0]"+ ],+ "tags": [+ "case"+ ]+ },+ {+ "name": "filter, quoted False, single quotes",+ "selector": "$[?@.a=='False']",+ "document": [+ {+ "a": "False"+ },+ {+ "a": false+ },+ {+ "a": "SomethingElse"+ }+ ],+ "result": [+ {+ "a": "False"+ }+ ],+ "result_paths": [+ "$[0]"+ ],+ "tags": [+ "case"+ ]+ },+ { "name": "filter, null, incorrectly capitalized", "selector": "$[?@==Null]", "invalid_selector": true,@@ -4371,6 +4792,58 @@ ] }, {+ "name": "filter, quoted Null, double quotes",+ "selector": "$[?@.a==\"Null\"]",+ "document": [+ {+ "a": "Null"+ },+ {+ "a": null+ },+ {+ "a": "SomethingElse"+ }+ ],+ "result": [+ {+ "a": "Null"+ }+ ],+ "result_paths": [+ "$[0]"+ ],+ "tags": [+ "case"+ ]+ },+ {+ "name": "filter, quoted Null, single quotes",+ "selector": "$[?@.a=='Null']",+ "document": [+ {+ "a": "Null"+ },+ {+ "a": null+ },+ {+ "a": "SomethingElse"+ }+ ],+ "result": [+ {+ "a": "Null"+ }+ ],+ "result_paths": [+ "$[0]"+ ],+ "tags": [+ "case"+ ]+ },+ { "name": "index selector, first element", "selector": "$[0]", "document": [@@ -7572,6 +8045,24 @@ "result_paths": [ "$[0]" ],+ "tags": [+ "function",+ "length"+ ]+ },+ {+ "name": "functions, length, non-singular query arg, multiple index selectors",+ "selector": "$[?length(@[1, 2])<3]",+ "invalid_selector": true,+ "tags": [+ "function",+ "length"+ ]+ },+ {+ "name": "functions, length, non-singular query arg, multiple name selectors",+ "selector": "$[?length(@['a', 'b'])<3]",+ "invalid_selector": true, "tags": [ "function", "length"
src/Data/Aeson/JSONPath/Parser.hs view
@@ -16,6 +16,7 @@ import qualified Text.ParserCombinators.Parsec as P +import Data.Aeson.JSONPath.Query () import Data.Aeson.JSONPath.Parser.Query (pRootQuery) import Data.Aeson.JSONPath.Types
src/Data/Aeson/JSONPath/Parser/Common.hs view
@@ -5,16 +5,17 @@ where import qualified Text.ParserCombinators.Parsec as P+import Text.ParserCombinators.Parsec ((<?>)) import Data.Char (ord) import Prelude -- https://www.rfc-editor.org/rfc/rfc9535#name-syntax pSpaces :: P.Parser [Char]-pSpaces = P.many (P.oneOf " \n\r\t")+pSpaces = P.many (P.oneOf " \n\r\t") <?> "spaces" pUnicodeChar :: P.Parser Char-pUnicodeChar = P.satisfy inRange+pUnicodeChar = P.satisfy inRange <?> "unicode char" where inRange c = let code = ord c in (code >= 0x80 && code <= 0xD7FF) ||
src/Data/Aeson/JSONPath/Parser/Filter.hs view
@@ -9,7 +9,7 @@ import Data.Functor (($>)) import Data.Maybe (isNothing) import Data.Scientific (Scientific)-import Text.ParserCombinators.Parsec ((<|>))+import Text.ParserCombinators.Parsec ((<|>),(<?>)) import Data.Aeson.JSONPath.Parser.Name import Data.Aeson.JSONPath.Parser.Number@@ -30,7 +30,7 @@ pLogicalOrExpr pQ = do expr <- pLogicalAndExpr pQ optionalExprs <- P.many $ pOrSepLogicalAndExprs pQ- return $ LogicalOr (expr:optionalExprs)+ return (LogicalOr (expr:optionalExprs)) <?> "logical or expression" where pOrSepLogicalAndExprs :: P.Parser a -> P.Parser (LogicalAndExpr a) pOrSepLogicalAndExprs pQ' = P.try $ pSpaces *> P.string "||" *> pSpaces *> pLogicalAndExpr pQ'@@ -39,7 +39,7 @@ pLogicalAndExpr pQ = do expr <- pBasicExpr pQ optionalExprs <- P.many $ pAndSepBasicExprs pQ- return $ LogicalAnd (expr:optionalExprs)+ return (LogicalAnd (expr:optionalExprs)) <?> "logical and expression" where pAndSepBasicExprs :: P.Parser a -> P.Parser (BasicExpr a) pAndSepBasicExprs pQ' = P.try $ pSpaces *> P.string "&&" *> pSpaces *> pBasicExpr pQ'@@ -59,14 +59,14 @@ pSpaces P.char ')' let parenExp = if isNothing notOp then Paren expr else NotParen expr- return parenExp+ return parenExp <?> "parenthesis expression" pTestExpr :: P.Parser a -> P.Parser (BasicExpr a) pTestExpr pQ = do notOp <- P.optionMaybe (P.char '!' <* pSpaces)- q <- P.try (FilterQuery <$> pQ)+ q <- P.try (FilterQuery <$> pQ) <|> P.try (TestFunc <$> pFunctionExpr pQ) let testExp = if isNothing notOp then Test q else NotTest q- return testExp+ return testExp <?> "test expression" pComparisonExpr :: P.Parser (BasicExpr a) pComparisonExpr = do@@ -74,7 +74,7 @@ pSpaces compOp <- pComparisonOp pSpaces- Comparison . Comp leftC compOp <$> pComparable+ Comparison . Comp leftC compOp <$> pComparable <?> "comparison expression" pComparisonOp :: P.Parser ComparisonOp pComparisonOp = P.try (P.string ">=" $> GreaterOrEqual)@@ -83,52 +83,53 @@ <|> P.try (P.char '<' $> Less) <|> P.try (P.string "!=" $> NotEqual) <|> P.try (P.string "==" $> Equal)+ <?> "comparison operator" pComparable :: P.Parser Comparable-pComparable = P.try pCompLit <|> P.try pCompSQ+pComparable = P.try (CompLit <$> pLiteral) <|> P.try pCompSQ <?> "comparable" -pCompLit :: P.Parser Comparable-pCompLit = CompLit- <$> (P.try pLitString- <|> P.try pLitNum- <|> P.try pLitBool- <|> P.try pLitNull)+pLiteral :: P.Parser Literal+pLiteral = P.try pLitString+ <|> P.try pLitNum+ <|> P.try pLitBool+ <|> P.try pLitNull pLitString :: P.Parser Literal-pLitString = LitString . T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted)+pLitString = LitString . T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted) <?> "string literal" pLitNum :: P.Parser Literal pLitNum = LitNum <$> (P.try (P.string "-0" $> (0 :: Scientific)) -- edge case <|> P.try pDoubleScientific <|> P.try pScientific)+ <?> "number literal" pLitBool :: P.Parser Literal-pLitBool = LitBool <$> (P.try (P.string "true" $> True) <|> P.try (P.string "false" $> False))+pLitBool = LitBool <$> (P.try (P.string "true" $> True) <|> P.try (P.string "false" $> False)) <?> "bool literal" pLitNull :: P.Parser Literal-pLitNull = P.string "null" $> LitNull+pLitNull = P.string "null" $> LitNull <?> "null literal" pCompSQ :: P.Parser Comparable-pCompSQ = CompSQ <$> (P.try pCurrentSingleQ <|> P.try pRootSingleQ)+pCompSQ = CompSQ <$> (P.try pCurrentSingleQ <|> P.try pRootSingleQ) <?> "singular query" pCurrentSingleQ :: P.Parser SingularQuery pCurrentSingleQ = do P.char '@' segs <- P.many $ P.try (pSpaces *> pSingularQuerySegment)- return $ SingularQuery { singularQueryType = CurrentSQ, singularQuerySegments = segs }+ (return $ SingularQuery { singularQueryType = CurrentSQ, singularQuerySegments = segs }) <?> "current singular query" pRootSingleQ :: P.Parser SingularQuery pRootSingleQ = do P.char '$' segs <- P.many $ P.try (pSpaces *> pSingularQuerySegment)- return $ SingularQuery { singularQueryType = RootSQ, singularQuerySegments = segs }+ (return $ SingularQuery { singularQueryType = RootSQ, singularQuerySegments = segs }) <?> "root singular query" pSingularQuerySegment :: P.Parser SingularQuerySegment-pSingularQuerySegment = P.try pSingularQNameSeg <|> P.try pSingularQIndexSeg+pSingularQuerySegment = (P.try pSingularQNameSeg <|> P.try pSingularQIndexSeg) <?> "singular query segment" pSingularQNameSeg :: P.Parser SingularQuerySegment-pSingularQNameSeg = P.try pSingularQNameBracketed <|> P.try pSingularQNameDotted+pSingularQNameSeg = (P.try pSingularQNameBracketed <|> P.try pSingularQNameDotted) <?> "singular query name segment" where pSingularQNameBracketed = do P.char '['@@ -147,4 +148,24 @@ P.char '[' idx <- pSignedInt P.char ']'- return $ IndexSQSeg idx+ return (IndexSQSeg idx) <?> "singular query index segment"+++pFunctionExpr :: P.Parser a -> P.Parser (FunctionExpr a)+pFunctionExpr pQ = do+ funcName <- P.try (P.string "search" $> Search)+ P.char '('+ arg1 <- pSpaces *> pFunctionArg pQ+ pSpaces *> P.char ','+ arg2 <- pSpaces *> pFunctionArg pQ+ pSpaces+ P.char ')'+ return (FunctionSearch funcName arg1 arg2) <?> "function expression"+++pFunctionArg :: P.Parser a -> P.Parser (FunctionArg a)+pFunctionArg pQ = P.try (ArgLit <$> pLiteral)+ <|> P.try (ArgQuery <$> pQ)+ <|> P.try (ArgLogicExpr <$> pLogicalOrExpr pQ)+ <|> P.try (ArgFuncExpr <$> pFunctionExpr pQ)+ <?> "function argument"
src/Data/Aeson/JSONPath/Parser/Name.hs view
@@ -9,12 +9,12 @@ import Data.Functor (($>)) import Data.Char (ord, chr)-import Text.ParserCombinators.Parsec ((<|>))+import Text.ParserCombinators.Parsec ((<|>),(<?>)) import Prelude pSingleQuotted :: P.Parser String-pSingleQuotted = P.char '\'' *> P.many inQuote <* P.char '\''+pSingleQuotted = P.char '\'' *> P.many inQuote <* P.char '\'' <?> "single quoted string" where inQuote = P.try pUnescaped <|> P.try (P.char '\"')@@ -22,7 +22,7 @@ <|> P.try pEscaped pDoubleQuotted :: P.Parser String-pDoubleQuotted = P.char '\"' *> P.many inQuote <* P.char '\"'+pDoubleQuotted = P.char '\"' *> P.many inQuote <* P.char '\"' <?> "double quoted string" where inQuote = P.try pUnescaped <|> P.try (P.char '\'')@@ -30,7 +30,7 @@ <|> P.try pEscaped pUnescaped :: P.Parser Char-pUnescaped = P.satisfy inRange+pUnescaped = P.satisfy inRange <?> "unescaped character" where inRange c = let code = ord c in (code >= 0x20 && code <= 0x21) ||@@ -42,7 +42,7 @@ pEscaped :: P.Parser Char pEscaped = do P.char '\\'- P.try pEscapees <|> P.try pHexUnicode+ (P.try pEscapees <|> P.try pHexUnicode) <?> "escape character" where pEscapees = P.try (P.char 'b' $> '\b') <|> P.try (P.char 'f' $> '\f')@@ -53,7 +53,7 @@ <|> P.try (P.char '\\') pHexUnicode :: P.Parser Char-pHexUnicode = P.try pNonSurrogate <|> P.try pSurrogatePair+pHexUnicode = (P.try pNonSurrogate <|> P.try pSurrogatePair) <?> "hexadecimal unicode character" where pNonSurrogate = P.try pNonSurrogateFirst <|> P.try pNonSurrogateSecond where
src/Data/Aeson/JSONPath/Parser/Number.hs view
@@ -11,6 +11,7 @@ import Data.Maybe (fromMaybe) import Data.Scientific (Scientific, scientific) import GHC.Num (integerFromInt, integerToInt)+import Text.ParserCombinators.Parsec ((<?>)) import Prelude @@ -20,7 +21,7 @@ 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+ checkNumOutOfRange num sign <?> "signed integer" where minInt = -9007199254740991 maxInt = 9007199254740991@@ -37,7 +38,7 @@ pScientific = do mantissa <- pSignedInt expo <- P.optionMaybe (P.oneOf "eE" *> pExponent)- return $ scientific (integerFromInt mantissa) (fromMaybe 0 expo)+ return (scientific (integerFromInt mantissa) (fromMaybe 0 expo)) <?> "scientific integer" pDoubleScientific :: P.Parser Scientific pDoubleScientific = do@@ -46,12 +47,11 @@ 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+ return num <?> "scientific double" pExponent :: P.Parser Int pExponent = do sign <- P.optionMaybe (P.oneOf "+-") num <- read <$> P.many1 P.digit- return $ case sign of- Just '-' -> -num- _ -> num+ let e = case sign of {Just '-' -> -num; _ -> num }+ return e <?> "exponent"
src/Data/Aeson/JSONPath/Parser/Query.hs view
@@ -9,7 +9,7 @@ import Data.Functor (($>)) import Data.Maybe (isNothing)-import Text.ParserCombinators.Parsec ((<|>))+import Text.ParserCombinators.Parsec ((<|>),(<?>)) import Data.Aeson.JSONPath.Parser.Filter (pFilter) import Data.Aeson.JSONPath.Parser.Name@@ -23,7 +23,7 @@ pRootQuery = do P.char '$' segs <- P.many $ P.try pSpacedOutSegments- return $ Query { queryType = Root, querySegments = segs }+ (return $ Query { queryType = Root, querySegments = segs }) <?> "root query ($)" where pQ = P.try pRootQuery <|> P.try pCurrentQuery pSpacedOutSegments = pSpaces *> pQuerySegment pQ@@ -32,7 +32,7 @@ pCurrentQuery = do P.char '@' segs <- P.many $ P.try pSpacedOutSegments- return $ Query { queryType = Current, querySegments = segs }+ (return $ Query { queryType = Current, querySegments = segs }) <?> "current query (@)" where pQ = P.try pRootQuery <|> P.try pCurrentQuery pSpacedOutSegments = pSpaces *> pQuerySegment pQ@@ -43,8 +43,9 @@ dotdot <- P.optionMaybe (P.try $ P.string "..") seg <- pSegment pQ $ isNothing dotdot let segType = if isNothing dotdot then Child else Descendant- return $ QuerySegment { segmentType = segType, segment = seg }+ (return $ QuerySegment { segmentType = segType, segment = seg }) <?> "query segment" + pSegment :: P.Parser a -> Bool -> P.Parser (Segment a) pSegment pQ isChild = P.try (pBracketed pQ)@@ -59,7 +60,7 @@ optionalSels <- P.many $ pCommaSepSelectors pQ pSpaces P.char ']'- return $ Bracketed (sel:optionalSels)+ return (Bracketed (sel:optionalSels)) <?> "bracketed segment" where pCommaSepSelectors :: P.Parser a -> P.Parser (Selector a) pCommaSepSelectors p = P.try $ pSpaces *> P.char ',' *> pSpaces *> pSelector p@@ -70,11 +71,11 @@ (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+ return (Dotted key) <?> "dotted segment" pWildcardSeg :: Bool -> P.Parser (Segment a)-pWildcardSeg isChild = (if isChild then P.string "." else P.string "") *> P.char '*' $> WildcardSegment+pWildcardSeg isChild = (if isChild then P.string "." else P.string "") *> P.char '*' $> WildcardSegment <?> "wildcard segment" pSelector :: P.Parser a -> P.Parser (Selector a) pSelector pQ = P.try pName@@ -84,10 +85,10 @@ <|> P.try (pFilter pQ) pName :: P.Parser (Selector a)-pName = Name . T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted)+pName = Name . T.pack <$> (P.try pSingleQuotted <|> P.try pDoubleQuotted) <?> "name selector" pIndex :: P.Parser (Selector a)-pIndex = Index <$> pSignedInt+pIndex = Index <$> pSignedInt <?> "index selector" pSlice :: P.Parser (Selector a) pSlice = do@@ -96,10 +97,9 @@ 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)+ let step' = case step of {Just (Just n) -> n; _ -> 1}+ return (ArraySlice (start, end, step')) <?> "array selector" pWildcardSel :: P.Parser (Selector a)-pWildcardSel = P.char '*' $> WildcardSelector+pWildcardSel = P.char '*' $> WildcardSelector <?> "wildcard selector"
src/Data/Aeson/JSONPath/Query/Filter.hs view
@@ -6,6 +6,7 @@ import Data.Aeson (Value) import Data.Vector (Vector)+import Text.Regex.TDFA ((=~)) import qualified Data.Aeson as JSON import qualified Data.Aeson.KeyMap as KM@@ -49,6 +50,12 @@ evaluateTestExpr :: TestExpr Query -> QueryState -> Bool evaluateTestExpr (FilterQuery expr) qS@QueryState{..} = not $ null $ executeQuery expr qS+-- https://www.rfc-editor.org/rfc/rfc9535#type-conv+evaluateTestExpr (TestFunc funcExpr) qS =+ case evaluateFunctionExpr funcExpr qS of+ NodesType res -> not $ null res+ LogicalType b -> b+ ValueType _ -> False evaluateCompExpr :: ComparisonExpr -> QueryState -> Bool@@ -88,3 +95,47 @@ 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+++evaluateFunctionExpr :: FunctionExpr Query -> QueryState -> FunctionResult+evaluateFunctionExpr FunctionSearch{..} qS =+ case functionName of+ Search -> evaluateSearchFunction (functionArg1, functionArg2) qS++-- TODO: find a better way to enforce argument types (remove underscores)+-- Search Function+-- ===============+-- Argument 1: ValueType+-- Argument 2: ValueType+-- Result: LogicalType++evaluateSearchFunction :: (FunctionArg Query, FunctionArg Query) -> QueryState -> FunctionResult+evaluateSearchFunction (arg1, arg2) qS@QueryState{..} =+ case (arg1, arg2) of+ (ArgLit (LitString txt), ArgLit (LitString regex)) -> LogicalType $ txt =~ regex++ (ArgLit (LitString txt), ArgQuery q) ->+ if V.length (executeQuery q qS) /= 1 then+ LogicalType False+ else+ case V.head (executeQuery q qS) of+ JSON.String regex -> LogicalType $ txt =~ regex+ _ -> LogicalType False++ (ArgQuery q, ArgLit (LitString regex)) ->+ if V.length (executeQuery q qS) /= 1 then+ LogicalType False+ else+ case V.head (executeQuery q qS) of+ JSON.String txt -> LogicalType $ txt =~ regex+ _ -> LogicalType False++ (ArgQuery q1, ArgQuery q2) ->+ if V.length (executeQuery q1 qS) /= 1 || V.length (executeQuery q2 qS) /= 1 then+ LogicalType False+ else+ case (V.head (executeQuery q1 qS), V.head (executeQuery q2 qS)) of+ (JSON.String txt, JSON.String regex) -> LogicalType $ txt =~ regex+ _ -> LogicalType False++ _ -> LogicalType False -- All other combinations are not valid, so return False
src/Data/Aeson/JSONPath/Types/Filter.hs view
@@ -11,11 +11,17 @@ , SingularQueryType (..) , SingularQuery (..) , SingularQuerySegment (..)+ , FunctionExpr (..)+ , FunctionName (..)+ , FunctionArg (..)+ , FunctionResult (..) ) where +import Data.Aeson (Value) import Data.Text (Text) import Data.Scientific (Scientific)+import Data.Vector (Vector) import Language.Haskell.TH.Syntax (Lift) @@ -41,8 +47,9 @@ deriving (Eq, Show, Lift) -- |-newtype TestExpr a+data TestExpr a = FilterQuery a+ | TestFunc (FunctionExpr a) deriving (Eq, Show, Lift) -- |@@ -89,3 +96,38 @@ = NameSQSeg Text | IndexSQSeg Int deriving (Eq, Show, Lift)++-- Function Extensions++-- |+data FunctionExpr a =+ FunctionSearch {+ functionName :: FunctionName+ , functionArg1 :: FunctionArg a+ , functionArg2 :: FunctionArg a+ }+ deriving (Eq, Show, Lift)++-- |+data FunctionName+ = Search+ -- Length+ -- Count+ -- Match+ -- Value+ deriving (Eq, Show, Lift)++-- |+data FunctionArg a+ = ArgLit Literal+ | ArgQuery a+ | ArgLogicExpr (LogicalOrExpr a)+ | ArgFuncExpr (FunctionExpr a)+ deriving (Eq, Show, Lift)++-- |+data FunctionResult+ = NodesType (Vector Value)+ | LogicalType Bool+ | ValueType (Maybe Value)+ deriving Eq
test/compliance/ComplianceSpec.hs view
@@ -62,11 +62,24 @@ describe "compliance tests" $ do mapM_ runTestCase tests +-- Skip 5 tests because these tests are not according to Haskell TDFA regular expression.+-- Skip 2 tests that include other functions like "value()" or "count()" which are not yet+-- implemented. TODO: These can be removed, if tagged accordingly+searchFunctionTestsToBeSkipped :: [String]+searchFunctionTestsToBeSkipped = [+ "functions, search, filter, search function, unicode char class, uppercase"+ , "functions, search, filter, search function, unicode char class negated, uppercase"+ , "functions, search, dot matcher on \\u2028"+ , "functions, search, dot matcher on \\u2029"+ , "functions, search, arg is a function expression"+ , "functions, search, escaped right square bracket"+ , "whitespace, functions, space between arg and parenthesis"+ ] runTestCase :: TestCase -> SpecWith () -- skip function extension tests runTestCase tc@TestCase{tags=Just xs, ..} =- if "function" `elem` xs+ if ("function" `elem` xs && not ("search" `elem` xs)) || (name `elem` searchFunctionTestsToBeSkipped) then xit name pending else runTestCase tc{tags=Nothing}
test/spec/LocatedSpec.hs view
@@ -121,6 +121,21 @@ } ]|] +books0And2Doc :: Value+books0And2Doc = [aesonQQ|[+ {+ "title": "Guns, Germs, and Steel",+ "author": "Jared Diamond",+ "category": "reference",+ "price": 24.99+ },+ {+ "title": "Moby Dick",+ "author": "Herman Melville",+ "category": "fiction",+ "price": 8.99+ }+ ]|] spec :: Spec spec = do@@ -142,3 +157,7 @@ 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)++ it "search function matches correctly with regex" $+ queryLocatedQQ [jsonPath|$.store.books[?search(@.author, 'Diamond|Herman')]|] rootDoc+ `shouldBe` V.zip (V.fromList [("$['store']['books'][0]"),("$['store']['books'][2]")]) (getVector books0And2Doc)
test/spec/QuerySpec.hs view
@@ -346,3 +346,7 @@ it "returns with filtering: test expr gives empty with non-existent key" $ queryQQ [jsonPath|$.store.books[?@.not_here]|] rootDoc `shouldBe` V.empty++ it "search function matches correctly with regex" $+ queryQQ [jsonPath|$.store.books[?search(@.author, 'Diamond|Herman')]|] rootDoc+ `shouldBe` getVector books0And2Doc