jsonpath-0.3.0.0/0000755000000000000000000000000007346545000011667 5ustar0000000000000000jsonpath-0.3.0.0/ChangeLog.md0000644000000000000000000000347207346545000014046 0ustar0000000000000000# Changelog for jsonpath-hs ## v0.3.0.0 - Lots of breaking changes, they come with new features This release aims to address many deviations from similar libraries in other programming languages, this is thanks to Christoph Burgmer's [json-path-comparison project](https://cburgmer.github.io/json-path-comparison/). There has also been significant work in codifying JSONPath by the IETF-WG for JSONPath, the draft spec can be acccessed [here](https://ietf-wg-jsonpath.github.io/draft-ietf-jsonpath-base/draft-ietf-jsonpath-base.html). This release also aims to adapt some of the ideas from from spec. As a result there have been significant breaking changes in the types and also small changes in the way JSONPaths are executed. List of changes: * Fix compiler warnings and bugs with non-total pattern matches. * Allow double quoted literals and field accessors. * Ensure termination when start or end of slice are too big/small. * Implement slice execution based on IETF draft spec . * Ensure that a valid JSONPath never fails to execute. * Drop support for GHC <= 8.2. * Use megaparsec instead of attoparsec for better error messages. * Allow escape sequences in key names. * Allow parsing empty paths. * Allow spaces arround index selectors. * Allow selecting keys in unions and allow many union elements. * Implement 'and', 'or' and 'not' operator support in filters. * Allow comparison between two singular paths. * Allow bools and nulls in filters. ## v0.2.1.0 * Support and require aeson >= 2 ## v0.2.0.0 * BreakingChange: Fix typo in `BeginningPoint`. * Fix typo in parser error. ## v0.1.0.2 * Remove upper bounds from dependencies, as most of them are quite stable packages. ## v0.1.0.1 * Import Data.Semigroup to support GHC 8. * Add test json files to make sure test sdist compile and runs. ## v0.1.0.0 * Start the project. jsonpath-0.3.0.0/LICENSE0000644000000000000000000000276307346545000012704 0ustar0000000000000000Copyright Akshay Mankar (c) 2019 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Akshay Mankar nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. jsonpath-0.3.0.0/README.md0000644000000000000000000000173707346545000013156 0ustar0000000000000000# jsonpath-hs Implementation of jsonpath as [described by Steffen Göessner](https://goessner.net/articles/JsonPath/). ## State of this library This library is still work in progress, but feel free to use it create issues. It lacks some features and has a few variances from the description. ### Missing Features * The Length funtion: The ability to say `$.length`. It will just look for `length` key as of now. * ScriptExpression: The ability to say things like `$.book[(3+1)]` ### Variances * The `$` sign in the beginning is not compulsory * The `$..*` will not produce the root object itself. ## Shout out to [JSON-Path-Test-Suite](https://github.com/gregsdennis/JSON-Path-Test-Suite/tree/master/Tests) I have copied a few of the tests from there, I will probably just sub-module the repository if and when the whole test suite is green. ## Uses I am using this library to support GCP authentication in the [Kubernetes haskell client](http://github.com/kubernetes-client/haskell). jsonpath-0.3.0.0/Setup.hs0000644000000000000000000000005707346545000013325 0ustar0000000000000000import Distribution.Simple main = defaultMain jsonpath-0.3.0.0/jsonpath.cabal0000644000000000000000000000323407346545000014503 0ustar0000000000000000cabal-version: 1.12 name: jsonpath version: 0.3.0.0 synopsis: Library to parse and execute JSONPath description: Please see the README on GitHub at category: Text, Web, JSON homepage: https://github.com/akshaymankar/jsonpath-hs#readme bug-reports: https://github.com/akshaymankar/jsonpath-hs/issues author: Akshay Mankar maintainer: itsakshaymankar@gmail.com copyright: Akshay Mankar license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md test/resources/json-path-tests/*.json source-repository head type: git location: https://github.com/akshaymankar/jsonpath-hs library exposed-modules: Data.JSONPath Data.JSONPath.Execute Data.JSONPath.Parser Data.JSONPath.Types other-modules: Paths_jsonpath hs-source-dirs: src build-depends: aeson >=2 , megaparsec , base >=4.9 && <5 , scientific , text >=1.2 , unordered-containers >=0.2.8 , vector >=0.12 default-language: Haskell2010 test-suite jsonpath-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Data.JSONPathSpec Paths_jsonpath hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tool-depends: hspec-discover:hspec-discover build-depends: aeson >=1.1 , aeson-casing , megaparsec , base >=4.9 && <5 , bytestring , file-embed , hspec , hspec-megaparsec , jsonpath , text >=1.2 , unordered-containers >=0.2.8 , vector >=0.12 default-language: Haskell2010 jsonpath-0.3.0.0/src/Data/0000755000000000000000000000000007346545000013327 5ustar0000000000000000jsonpath-0.3.0.0/src/Data/JSONPath.hs0000644000000000000000000000032707346545000015253 0ustar0000000000000000module Data.JSONPath ( module Data.JSONPath.Types, module Data.JSONPath.Parser, module Data.JSONPath.Execute, ) where import Data.JSONPath.Execute import Data.JSONPath.Parser import Data.JSONPath.Types jsonpath-0.3.0.0/src/Data/JSONPath/0000755000000000000000000000000007346545000014715 5ustar0000000000000000jsonpath-0.3.0.0/src/Data/JSONPath/Execute.hs0000644000000000000000000001666007346545000016664 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.JSONPath.Execute (executeJSONPath, executeJSONPathElement) where import Data.Aeson import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as Map import qualified Data.Foldable as Foldable import Data.JSONPath.Types import Data.Maybe (fromMaybe, isJust, maybeToList) import Data.Text (Text) import qualified Data.Vector as V executeJSONPath :: [JSONPathElement] -> Value -> [Value] executeJSONPath path rootVal = go path rootVal where go :: [JSONPathElement] -> Value -> [Value] go [] v = [v] go (j : js) v = go js =<< executeJSONPathElement j rootVal v executeJSONPathElement :: JSONPathElement -> Value -> Value -> [Value] executeJSONPathElement (KeyChild key) _ val = executeKeyChildOnValue key val executeJSONPathElement AnyChild _ val = case val of Object o -> map snd $ Map.toList o Array a -> V.toList a _ -> [] executeJSONPathElement (IndexChild i) _ val = executeIndexChildOnValue i val executeJSONPathElement (Slice start end step) _ val = executeSliceOnValue start end step val executeJSONPathElement (Union elements) _ val = concatMap (flip executeUnionElement val) elements executeJSONPathElement (Filter expr) rootVal val = case val of Array a -> executeFilter expr rootVal (V.toList a) Object o -> executeFilter expr rootVal (Map.elems o) _ -> [] executeJSONPathElement s@(Search js) origVal val = let x = executeJSONPath js val y = mconcat $ valMap (executeJSONPathElement s origVal) val in x <> y valMap :: ToJSON b => (Value -> [b]) -> Value -> [[b]] valMap f (Object o) = map snd . Map.toList $ Map.map f o valMap f (Array a) = V.toList $ V.map f a valMap _ _ = [] executeConditionOnMaybes :: Maybe Value -> Condition -> Maybe Value -> Bool executeConditionOnMaybes (Just val1) c (Just val2) = executeCondition val1 c val2 executeConditionOnMaybes Nothing Equal Nothing = True executeConditionOnMaybes Nothing GreaterThanOrEqual Nothing = True executeConditionOnMaybes Nothing SmallerThanOrEqual Nothing = True executeConditionOnMaybes Nothing NotEqual (Just _) = True executeConditionOnMaybes (Just _) NotEqual Nothing = True executeConditionOnMaybes _ _ _ = False {- ORMOLU_DISABLE -} isEqualTo :: Value -> Value -> Bool (Object _) `isEqualTo` _ = False _ `isEqualTo` (Object _) = False (Array _) `isEqualTo` _ = False _ `isEqualTo` (Array _) = False val1 `isEqualTo` val2 = val1 == val2 isSmallerThan :: Value -> Value -> Bool (Number n1) `isSmallerThan` (Number n2) = n1 < n2 (String s1) `isSmallerThan` (String s2) = s1 < s2 _ `isSmallerThan` _ = False {- ORMOLU_ENABLE -} executeCondition :: Value -> Condition -> Value -> Bool executeCondition val1 NotEqual val2 = not (executeCondition val1 Equal val2) executeCondition val1 Equal val2 = val1 `isEqualTo` val2 executeCondition val1 SmallerThan val2 = val1 `isSmallerThan` val2 executeCondition val1 GreaterThan val2 = canCompare val1 val2 && not (executeCondition val1 SmallerThan val2) && not (executeCondition val1 Equal val2) executeCondition val GreaterThanOrEqual lit = canCompare val lit && not (executeCondition val SmallerThan lit) executeCondition val1 SmallerThanOrEqual val2 = canCompare val1 val2 && not (executeCondition val1 GreaterThan val2) canCompare :: Value -> Value -> Bool canCompare (Number _) (Number _) = True canCompare (String _) (String _) = True canCompare _ _ = False executeSliceOnValue :: Maybe Int -> Maybe Int -> Maybe Int -> Value -> [Value] executeSliceOnValue start end step val = case val of Array a -> executeSlice start end step a _ -> [] -- | Implementation is based on -- https://ietf-wg-jsonpath.github.io/draft-ietf-jsonpath-base/draft-ietf-jsonpath-base.html#name-array-slice-selector executeSlice :: forall a. Maybe Int -> Maybe Int -> Maybe Int -> V.Vector a -> [a] executeSlice mStart mEnd mStep v | step == 0 = [] | step > 0 = postitiveStepLoop lowerBound | otherwise = negativeStepLoop upperBound where postitiveStepLoop :: Int -> [a] postitiveStepLoop i | i < upperBound = v V.! i : postitiveStepLoop (i + step) | otherwise = [] negativeStepLoop :: Int -> [a] negativeStepLoop i | i > lowerBound = v V.! i : negativeStepLoop (i + step) | otherwise = [] len = V.length v step = fromMaybe 1 mStep normalizeIndex :: Int -> Int normalizeIndex i = if i >= 0 then i else len + i defaultStart | step >= 0 = 0 | otherwise = len - 1 start = fromMaybe defaultStart mStart normalizedStart = normalizeIndex start defaultEnd | step >= 0 = len | otherwise = negate len - 1 end = fromMaybe defaultEnd mEnd normalizedEnd = normalizeIndex end lowerBound | step >= 0 = min (max normalizedStart 0) len | otherwise = min (max normalizedEnd (-1)) (len - 1) upperBound | step >= 0 = min (max normalizedEnd 0) len | otherwise = min (max normalizedStart (-1)) (len - 1) executeIndexChild :: Int -> V.Vector a -> Maybe a executeIndexChild i v = if i < 0 then (V.!?) v (V.length v + i) else (V.!?) v i executeUnionElement :: UnionElement -> Value -> [Value] executeUnionElement (UEIndexChild i) v = executeIndexChildOnValue i v executeUnionElement (UESlice start end step) v = executeSliceOnValue start end step v executeUnionElement (UEKeyChild child) v = executeKeyChildOnValue child v executeKeyChildOnValue :: Text -> Value -> [Value] executeKeyChildOnValue key val = maybeToList $ executeSingularPathElement (Key key) val executeIndexChildOnValue :: Int -> Value -> [Value] executeIndexChildOnValue i val = maybeToList $ executeSingularPathElement (Index i) val executeSingularPathElement :: SingularPathElement -> Value -> Maybe Value executeSingularPathElement (Key key) val = case val of Object o -> Map.lookup (Key.fromText key) o _ -> Nothing executeSingularPathElement (Index i) val = case val of Array a -> executeIndexChild i a _ -> Nothing executeSingularPath :: SingularPath -> Value -> Value -> Maybe Value executeSingularPath (SingularPath beginnigPoint ps) rootVal currentVal = let val = case beginnigPoint of Root -> rootVal CurrentObject -> currentVal in Foldable.foldl' ( \case Nothing -> const Nothing Just v -> flip executeSingularPathElement v ) (Just val) ps executeFilter :: FilterExpr -> Value -> [Value] -> [Value] executeFilter expr rootVal = Prelude.filter (filterExprPred expr rootVal) comparableToValue :: Comparable -> Value -> Value -> Maybe Value comparableToValue (CmpNumber n) _ _ = Just $ Number n comparableToValue (CmpString s) _ _ = Just $ String s comparableToValue (CmpBool b) _ _ = Just $ Bool b comparableToValue CmpNull _ _ = Just Null comparableToValue (CmpPath p) rootVal val = executeSingularPath p rootVal val filterExprPred :: FilterExpr -> Value -> Value -> Bool filterExprPred expr rootVal val = case expr of ComparisonExpr cmp1 cond cmp2 -> let val1 = comparableToValue cmp1 rootVal val val2 = comparableToValue cmp2 rootVal val in executeConditionOnMaybes val1 cond val2 ExistsExpr path -> isJust $ executeSingularPath path rootVal val Or e1 e2 -> filterExprPred e1 rootVal val || filterExprPred e2 rootVal val And e1 e2 -> filterExprPred e1 rootVal val && filterExprPred e2 rootVal val Not e -> not $ filterExprPred e rootVal val jsonpath-0.3.0.0/src/Data/JSONPath/Parser.hs0000644000000000000000000001452107346545000016510 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} module Data.JSONPath.Parser (jsonPathElement, jsonPath) where import qualified Data.Char as Char import Data.Functor import Data.Functor.Identity import Data.JSONPath.Types import Data.Text (Text) import qualified Data.Text as Text import Data.Void (Void) import Text.Megaparsec as P import Text.Megaparsec.Char (char, space, string) import qualified Text.Megaparsec.Char.Lexer as L type Parser = P.ParsecT Void Text Identity jsonPath :: Parser a -> Parser [JSONPathElement] jsonPath endParser = do _ <- optional $ char '$' manyTill jsonPathElement (hidden $ lookAhead endParser) jsonPathElement :: Parser JSONPathElement jsonPathElement = ignoreSurroundingSpace $ try anyChild <|> try keyChild <|> try slice <|> try indexChild <|> try union <|> try filterParser <|> try search <|> searchBeginningWithSlice indexChild :: Parser JSONPathElement indexChild = IndexChild <$> inSqBr indexChildWithoutBrackets indexChildWithoutBrackets :: Parser Int indexChildWithoutBrackets = ignoreSurroundingSpace $ L.signed space L.decimal slice :: Parser JSONPathElement slice = uncurry3 Slice <$> inSqBr sliceWithoutBrackets sliceWithoutBrackets :: Parser (Maybe Int, Maybe Int, Maybe Int) sliceWithoutBrackets = do (,,) <$> parseStart <*> parseEnd <*> parseStep where parseStart :: Parser (Maybe Int) parseStart = ignoreSurroundingSpace (optional (L.signed space L.decimal)) <* char ':' parseEnd = ignoreSurroundingSpace $ optional $ L.signed space L.decimal parseStep = optional (char ':') *> ignoreSurroundingSpace (optional (L.signed space L.decimal)) keyChild :: Parser JSONPathElement keyChild = KeyChild <$> (try sqBrKeyChild <|> dotKeyChild) sqBrKeyChild :: Parser Text sqBrKeyChild = inSqBr $ ignoreSurroundingSpace quotedString dotKeyChild :: Parser Text dotKeyChild = char '.' *> takeWhile1P Nothing (\c -> Char.isAlphaNum c || c == '-' || c == '_') anyChild :: Parser JSONPathElement anyChild = ignoreSurroundingSpace $ AnyChild <$ (void (string ".*") <|> void (inSqBr (char '*'))) union :: Parser JSONPathElement union = inSqBr $ Union <$> do firstElement <- unionElement restElements <- some (char ',' *> unionElement) pure (firstElement : restElements) unionElement :: Parser UnionElement unionElement = try (uncurry3 UESlice <$> sliceWithoutBrackets) <|> try (UEIndexChild <$> indexChildWithoutBrackets) <|> UEKeyChild <$> ignoreSurroundingSpace quotedString filterParser :: Parser JSONPathElement filterParser = inSqBr $ do _ <- ignoreSurroundingSpace $ char '?' Filter <$> filterExpr (ignoreSurroundingSpace (char ']')) filterExpr :: Parser a -> Parser FilterExpr filterExpr endParser = try (orFilterExpr endParser) <|> try (andFilterExpr endParser) <|> basicFilterExpr endParser basicFilterExpr :: Parser a -> Parser FilterExpr basicFilterExpr endParser = do maybeNot <- optional (char '!') expr <- try (comparisionFilterExpr endParser) <|> try (existsFilterExpr endParser) <|> (inParens (filterExpr closingParen) <* lookAhead endParser) case maybeNot of Nothing -> pure expr Just _ -> pure $ Not expr comparisionFilterExpr :: Parser a -> Parser FilterExpr comparisionFilterExpr endParser = do expr <- ComparisonExpr <$> comparable condition <*> condition <*> comparable endParser _ <- lookAhead endParser pure expr existsFilterExpr :: Parser a -> Parser FilterExpr existsFilterExpr endParser = ExistsExpr <$> singularPath endParser singularPath :: Parser a -> Parser SingularPath singularPath endParser = SingularPath <$> beginningPoint <*> manyTill singularPathElement (lookAhead endParser) singularPathElement :: Parser SingularPathElement singularPathElement = (Key <$> try dotKeyChild) <|> (Key <$> try sqBrKeyChild) <|> Index <$> inSqBr indexChildWithoutBrackets orFilterExpr :: Parser a -> Parser FilterExpr orFilterExpr endParser = do let orOperator = ignoreSurroundingSpace $ string "||" e1 <- -- If there is an '&&' operation, it should take precedence over the '||' try (andFilterExpr orOperator) <|> basicFilterExpr orOperator _ <- orOperator Or e1 <$> filterExpr endParser andFilterExpr :: Parser a -> Parser FilterExpr andFilterExpr endParser = do let andOperator = ignoreSurroundingSpace $ string "&&" e1 <- basicFilterExpr andOperator _ <- andOperator And e1 <$> filterExpr endParser search :: Parser JSONPathElement search = do _ <- char '.' _ <- lookAhead (char '.') Search <$> some jsonPathElement searchBeginningWithSlice :: Parser JSONPathElement searchBeginningWithSlice = do _ <- string ".." _ <- lookAhead (char '[') Search <$> some jsonPathElement beginningPoint :: Parser BeginningPoint beginningPoint = try (char '$' $> Root) <|> (char '@' $> CurrentObject) condition :: Parser Condition condition = ignoreSurroundingSpace $ string "==" $> Equal <|> string "!=" $> NotEqual <|> string "<=" $> SmallerThanOrEqual <|> string ">=" $> GreaterThanOrEqual <|> string ">" $> GreaterThan <|> string "<" $> SmallerThan comparable :: Parser a -> Parser Comparable comparable endParser = do CmpNumber <$> L.scientific <|> CmpString <$> quotedString <|> CmpBool <$> bool <|> CmpNull <$ string "null" <|> CmpPath <$> singularPath endParser bool :: Parser Bool bool = True <$ string "true" <|> False <$ string "false" ignoreSurroundingSpace :: Parser a -> Parser a ignoreSurroundingSpace p = space *> p <* space inSqBr :: Parser a -> Parser a inSqBr p = openingSqBr *> p <* closingSqBr openingSqBr :: Parser Char openingSqBr = ignoreSurroundingSpace (char '[') closingSqBr :: Parser Char closingSqBr = ignoreSurroundingSpace (char ']') inParens :: Parser a -> Parser a inParens p = openingParen *> p <* closingParen openingParen :: Parser Char openingParen = ignoreSurroundingSpace (char '(') closingParen :: Parser Char closingParen = ignoreSurroundingSpace (char ')') quotedString :: Parser Text quotedString = ignoreSurroundingSpace $ Text.pack <$> (inQuotes '"' <|> inQuotes '\'') where inQuotes quoteChar = char quoteChar *> manyTill L.charLiteral (char quoteChar) uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (a, b, c) = f a b c jsonpath-0.3.0.0/src/Data/JSONPath/Types.hs0000644000000000000000000000343007346545000016355 0ustar0000000000000000module Data.JSONPath.Types ( BeginningPoint (..), Condition (..), Comparable (..), JSONPathElement (..), UnionElement (..), FilterExpr (..), SingularPathElement (..), SingularPath (..), ) where import Data.Scientific (Scientific) import Data.Text data BeginningPoint = Root | CurrentObject deriving (Show, Eq) -- | A JSONPath which finds at max one value, given a beginning point. Used by -- 'FilterExpr' for 'ExistsExpr' and 'ComparisonExpr'. data SingularPath = SingularPath BeginningPoint [SingularPathElement] deriving (Show, Eq) data SingularPathElement = Key Text | Index Int deriving (Show, Eq) data Comparable = CmpNumber Scientific | CmpString Text | CmpBool Bool | CmpNull | CmpPath SingularPath deriving (Show, Eq) data Condition = Equal | NotEqual | GreaterThan | SmallerThan | GreaterThanOrEqual | SmallerThanOrEqual deriving (Show, Eq) data FilterExpr = ExistsExpr SingularPath | ComparisonExpr Comparable Condition Comparable | And FilterExpr FilterExpr | Or FilterExpr FilterExpr | Not FilterExpr deriving (Show, Eq) -- | Elements which can occur inside a union data UnionElement = UEKeyChild Text | UEIndexChild Int | UESlice (Maybe Int) (Maybe Int) (Maybe Int) deriving (Show, Eq) -- | A 'JSONPath' is a list of 'JSONPathElement's. data JSONPathElement = -- | '$.foo' or '$["foo"]' KeyChild Text | -- | '$[1]' IndexChild Int | -- | '$[*]' AnyChild | -- | '$[1:7]', '$[0:10:2]', '$[::2]', '$[::]', etc. Slice (Maybe Int) (Maybe Int) (Maybe Int) | -- | '$[0,1,9]' or '$[0, 1:2, "foo", "bar"]' Union [UnionElement] | -- | '$[?(@.foo == 42)]', '$[?(@.foo > @.bar)]', etc. Filter FilterExpr | -- | '$..foo.bar' Search [JSONPathElement] deriving (Show, Eq) jsonpath-0.3.0.0/test/Data/0000755000000000000000000000000007346545000013517 5ustar0000000000000000jsonpath-0.3.0.0/test/Data/JSONPathSpec.hs0000644000000000000000000000564607346545000016267 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Data.JSONPathSpec where import Control.Monad.IO.Class (liftIO) import Data.Aeson import Data.Aeson.Casing import Data.Aeson.TH import Data.Aeson.Text import Data.Bifunctor (Bifunctor (first)) import qualified Data.ByteString.Lazy as LBS import Data.Either import Data.FileEmbed import Data.JSONPath import Data.Text (Text, unpack) import qualified Data.Text.Lazy as LazyText import qualified Data.Vector as V import GHC.Generics import System.Timeout import Test.Hspec import Test.Hspec.Megaparsec import Text.Megaparsec data Test = Test { path :: Text, result :: Value } deriving (Eq, Show, Generic) data TestGroup = TestGroup { groupTitle :: Text, groupData :: Value, groupTests :: [Test] } deriving (Eq, Show, Generic) $(deriveJSON defaultOptions ''Test) $(deriveJSON (aesonPrefix snakeCase) ''TestGroup) spec :: Spec spec = let testFiles = map snd $(embedDir "test/resources/json-path-tests") testVals :: Either String [TestGroup] testVals = traverse (eitherDecode . LBS.fromStrict) testFiles in case testVals of Left e -> describe "JSONPath Tests" $ it "shouldn't fail to parse test files" $ expectationFailure ("failed to parse test files with error: \n" <> e) Right gs -> describe "JSONPath" $ do mapM_ group gs describe "Parser" $ do it "should parse basic things" $ do parse (jsonPathElement <* eof) "" ".foo" `shouldParse` KeyChild "foo" parse (jsonPath eof) "" "$.foo" `shouldParse` [KeyChild "foo"] parseJSONPath :: Text -> Either String [JSONPathElement] parseJSONPath = first errorBundlePretty . parse (jsonPath eof) "" group :: TestGroup -> Spec group TestGroup {..} = do describe (unpack groupTitle) $ mapM_ (test groupData) groupTests -- | 100 ms timeLimit :: Int timeLimit = 100000 test :: Value -> Test -> Spec test testData (Test path expected) = it (unpack path) $ do mResult <- liftIO $ timeout timeLimit $ do -- Using '$!' here ensures that the computation is strict, so this can -- be timed out properly pure $! do parsed <- parseJSONPath path Right $ executeJSONPath parsed testData result <- case mResult of Just r -> pure r Nothing -> do expectationFailure "JSONPath execution timed out" undefined case expected of Array a -> case result of Left e -> expectationFailure $ "Unexpected Left: " <> e -- TODO: Define order of result and make this `shouldBe` Right r -> r `shouldMatchList` V.toList a Bool False -> result `shouldSatisfy` isLeft v -> expectationFailure $ "Invalid result in test data " <> LazyText.unpack (encodeToLazyText v) jsonpath-0.3.0.0/test/0000755000000000000000000000000007346545000012646 5ustar0000000000000000jsonpath-0.3.0.0/test/Spec.hs0000644000000000000000000000005407346545000014073 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} jsonpath-0.3.0.0/test/resources/json-path-tests/0000755000000000000000000000000007346545000017723 5ustar0000000000000000jsonpath-0.3.0.0/test/resources/json-path-tests/DotOperator.json0000644000000000000000000000134307346545000023061 0ustar0000000000000000{ "title": "Dot Operator", "data": { "firstName": "John", "lastName": "Doe", "home": "987-654-3210", "mobile": null }, "tests": [{ "path": "$.firstName", "result": [ "John" ] }, { "path": "$.lastName", "result": [ "Doe" ] }, { "path": "$.home", "result": [ "987-654-3210" ] }, { "path": "$.mobile", "result": [ null ] }, { "path": "$.missingKey", "result": [] }, { "path": "$.*", "result": [ "John", "Doe", "987-654-3210", null ] }] } jsonpath-0.3.0.0/test/resources/json-path-tests/EmptyPath.json0000644000000000000000000000255607346545000022541 0ustar0000000000000000{ "title" : "Chained Elements", "data" : { "firstName" : "John", "lastName" : "Doe", "eyes" : "blue", "children" : [{ "firstName" : "Sally", "lastName" : "Doe", "favoriteGames" : ["Halo", "Minecraft", "Lego: Star Wars"] }, { "firstName" : "Mike", "lastName" : "Doe", "eyes" : "green" }] }, "tests" : [{ "path" : "", "result" : [{ "firstName" : "John", "lastName" : "Doe", "eyes" : "blue", "children" : [{ "firstName" : "Sally", "lastName" : "Doe", "favoriteGames" : ["Halo", "Minecraft", "Lego: Star Wars"] }, { "firstName" : "Mike", "lastName" : "Doe", "eyes" : "green" }] }] }, { "path" : "$", "result" : [{ "firstName" : "John", "lastName" : "Doe", "eyes" : "blue", "children" : [{ "firstName" : "Sally", "lastName" : "Doe", "favoriteGames" : ["Halo", "Minecraft", "Lego: Star Wars"] }, { "firstName" : "Mike", "lastName" : "Doe", "eyes" : "green" }] }] }] } jsonpath-0.3.0.0/test/resources/json-path-tests/FieldAccess.json0000644000000000000000000000212107346545000022757 0ustar0000000000000000{ "title": "Field Access", "data": { "a": 1, "b": {"c" : { "d" : 2 }}, "e.f": {"g.h" : 3}, "!@#$+=- %)@!(*%\"": 4, ":": 5, "": 6, "'": 7, "\"": 8, "\\'": 9 }, "tests": [{ "path": "$.a", "result": [1] }, { "path": "$['a']", "result": [1] }, { "path": "$[\"a\"]", "result": [1] }, { "path": "$[ 'a']", "result": [1] }, { "path": "$[ \"a\"]", "result": [1] }, { "path": "$['b']['c'].d", "result": [2] }, { "path": "$['e.f']['g.h']", "result": [3] }, { "path": "$['!@#$+=- %)@!(*%\"']", "result": [4] }, { "path": "$[':']", "result": [5] }, { "path": "$['']", "result": [6] }, { "path": "$[\"\"]", "result": [6] }, { "path": "$['\\'']", "result": [7] }, { "path": "$[\"\\\"\"]", "result": [8] }, { "path": "$['\\\\\\'']", "result": [9] }] } jsonpath-0.3.0.0/test/resources/json-path-tests/FilterExpressionSubscriptOperator.json0000644000000000000000000003117707346545000027547 0ustar0000000000000000{ "title" : "Filter Expression Subscript Operator", "data" : {"arr" : [4, "string", false, null, [1, 2, 3], { "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" } , { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" } ], "obj": {"foo": 1, "bar": 2, "baz": {"qux": 3}, "bux": 4} }, "tests" : [{ "path" : "$.arr[?(@.occupation == \"Architect\")]", "result" : [{ "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" }] }, { "path" : "$.arr[?(@.occupation != \"Architect\")]", "result" : [4, "string", false, null, [1, 2, 3], { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" }] }, { "path" : "$.arr[?(@.name == \"John Smith\")]", "result" : [{ "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }] }, { "path" : "$.arr[?(@.name == 'John Smith')]", "result" : [{ "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }] }, { "path" : "$.arr[?(@.val > 3)]", "result" : [{ "val" : 4 }] }, { "path" : "$.arr[?(3 < @.val)]", "result" : [{ "val" : 4 }] }, { "path" : "$.arr[?@.val > 3]", "result" : [{ "val" : 4 }] }, { "path" : "$.arr[? @.val > 3]", "result" : [{ "val" : 4 }] }, { "path" : "$.arr[?(@.val >= 3)]", "result" : [{ "val" : 4 }, { "val" : 3 }] }, { "path" : "$.arr[?(@.val < 3)]", "result" : [{ "val" : 1 }, { "val" : 2 }] }, { "path" : "$.arr[?@.val]", "result" : [{ "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }] }, { "path" : "$.arr[?(@.val <= 3)]", "result" : [{ "val" : 1 }, { "val" : 2 }, { "val" : 3 }] }, { "path" : "$.arr[?(@.val <= 1) || (@.val > 3)]", "result" : [{ "val" : 1 }, { "val" : 4 }] }, { "path" : "$.arr[?(@.val <= 1) || (@.val > 1)]", "result" : [{ "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }] }, { "path" : "$.arr[?@.val <= 1 || @.val > 1]", "result" : [{ "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }] }, { "path" : "$.arr[?@.val > 1 && @.val < 4]", "result" : [{ "val": 2 }, { "val": 3 }] }, { "path" : "$.arr[?@.val <= 1 && @.val > 4]", "result" : [] }, { "path" : "$.arr[?@.val <= 1 && @.val >= 4 || @.val < 3]", "result" : [{ "val": 1 }, { "val": 2 }] }, { "path" : "$.arr[?(@.val <= 1 && @.val >= 4) || @.val < 3]", "result" : [{ "val": 1 }, { "val": 2 }] }, { "path" : "$.arr[?@.val >= 4 || @.val < 3 && @.val <= 1]", "result" : [{ "val": 1 }, { "val": 4 }] }, { "path" : "$.arr[?@.val >= 4 || (@.val < 3 && @.val <= 1)]", "result" : [{ "val": 1 }, { "val": 4 }] }, { "path" : "$.arr[?@.val == 4 || @.val == 3 || @.val == 1]", "result" : [{ "val": 1 }, { "val": 4 }, { "val": 3}] }, { "path" : "$.arr[?@.val <= 4 && @.val <= 3 && @.val <= 1]", "result" : [{ "val": 1 }] }, { "path" : "$.arr[?@.val <= 4 && @.val <= 3 && @.val <= 1 || @.val > 1]", "result" : [{ "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }] }, { "path" : "$.arr[?!@.val]", "result" : [4, "string", false, null, [1, 2, 3], { "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" } , { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" } ] }, { "path" : "$.arr[?!@.val == 1]", "comment": "This is not allowed according to the IETF Draft.", "result" : [4, "string", false, null, [1, 2, 3], { "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" } , { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "val": 2 }, { "val": 4 }, { "val": 3 }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" } ] }, { "path" : "$.arr[?!(@.val == 1)]", "result" : [4, "string", false, null, [1, 2, 3], { "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" } , { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "val": 2 }, { "val": 4 }, { "val": 3 }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" } ] }, { "path" : "$.arr[?(@.textval > \"c\")]", "result" : [{ "textval" : "d" }] }, { "path" : "$.arr[?(@.textval >= \"c\")]", "result" : [{ "textval" : "d" }, { "textval" : "c" }] }, { "path" : "$.arr[?(@.textval < \"b\")]", "result" : [{ "textval" : "a" }] }, { "path" : "$.arr[?(@.textval <= \"b\")]", "result" : [{ "textval" : "a" }, { "textval" : "b" }] }, { "path" : "$.arr[?(@.textval <= 'b')]", "result" : [{ "textval" : "a" }, { "textval" : "b" }] }, { "path" : "$.arr[?(@.val == \"1\")]", "result" : [] }, { "path": "$.obj[?@ > 1]", "result": [2, 4] }, { "path": "$.obj[?(@.qux)]", "result": [{"qux": 3}] }, { "path": "$[?@.foo < @.baz.qux]", "result": [{"foo": 1, "bar": 2, "baz": {"qux": 3}, "bux": 4}] }, { "path": "$[?@.foo < @.baz.qux]", "result": [{"foo": 1, "bar": 2, "baz": {"qux": 3}, "bux": 4}] }, { "path": "$[?@[0] == @[8].index]", "comment": "Both arr and obj match this as 4 == 4 for arr and no_path == no_path for obj", "result": [ [4, "string", false, null, [1, 2, 3], { "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" } , { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" } ], {"foo": 1, "bar": 2, "baz": {"qux": 3}, "bux": 4} ] }, { "path": "$[?@[0] && @[0] == @[8].index]", "result": [ [4, "string", false, null, [1, 2, 3], { "index" : 1, "name" : "John Doe", "occupation" : "Architect" }, { "index" : 2, "name" : "Jane Smith", "occupation" : "Architect", "color" : "blue" } , { "index" : 3, "name" : "John Smith", "occupation" : "Plumber" }, { "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }, { "val": 1 }, { "val": 2 }, { "val": 4 }, { "val": 3 }, { "textval": "a" }, { "textval": "b" }, { "textval": "d" }, { "textval": "c" } ] ] }, { "path": "$.arr[?@ > 3]", "result": [4] }, { "path": "$.arr[?@ == null]", "result": [null] }, { "path": "$.arr[?@ == false]", "result": [false] }, { "path": "$.arr[?@ == true]", "result": [] }, { "path": "$.arr[?@.index == $.obj.bux]", "result": [{ "index" : 4, "name" : "Jane Doe", "occupation" : "Pilot" }] } ] } jsonpath-0.3.0.0/test/resources/json-path-tests/IndexedSubscriptOperator.json0000644000000000000000000000703607346545000025617 0ustar0000000000000000{ "title" : "Indexed Subscript Operator", "data" : [ "John Doe", 36, "Architect", "one", "three", "five", {"string": "str", "array": ["arr"]} ], "tests" : [{ "path" : "$[2]", "result" : ["Architect"] }, { "path" : "$[ 2 ]", "result" : ["Architect"] },{ "path" : "$[-1]", "result" : [{"string": "str", "array": ["arr"]}] }, { "path" : "$[10]", "result" : [] }, { "path" : "$[1:4]", "result" : [36, "Architect", "one"] }, { "path" : "$[1:4:2]", "result" : [36, "one"] }, { "path" : "$[ 1 : 4 : 2 ]", "result" : [36, "one"] }, { "path" : "$[:4:2]", "result" : ["John Doe", "Architect"] }, { "path" : "$[1::2]", "result" : [36, "one", "five"] }, { "path" : "$[::2]", "result" : ["John Doe", "Architect", "three", {"string": "str", "array": ["arr"]}] }, { "path" : "$[1:]", "result" : [36, "Architect", "one", "three", "five", {"string": "str", "array": ["arr"]}] }, { "path" : "$[:3]", "result" : ["John Doe", 36, "Architect"] }, { "path" : "$[0,3]", "result" : ["John Doe", "one"] }, { "path" : "$[0,1::2]", "result" : ["John Doe", 36, "one", "five"] }, { "path" : "$[0:2,4:6]", "result" : ["John Doe", 36, "three", "five"] }, { "path" : "$[0:2,4]", "result" : ["John Doe", 36, "three"] }, { "path" : "$[ 0:2 , 4]", "result" : ["John Doe", 36, "three"] }, { "path" : "$[0:2, 'foo']", "result" : ["John Doe", 36] }, { "path" : "$[-1]['string', 'array']", "result" : ["str", ["arr"]] }, { "path" : "$[-1][\"not-here\", \"array\", \"string\"]", "result" : [["arr"], "str"] }, { "path" : "$[*]", "result" : ["John Doe", 36, "Architect", "one", "three", "five", {"string": "str", "array": ["arr"]}] }, { "path": "$[2:113667776004]", "result": ["Architect", "one", "three", "five", {"string": "str", "array": ["arr"]}] }, { "path": "$[-113667776004:2]", "result": ["John Doe", 36] }, { "path": "$[::0]", "result": [] }, { "path": "$[5:0:-1]", "result": [ "five", "three", "one", "Architect", 36 ] }, { "path": "$[-1:0:-1]", "result": [ "five", "three", "one", "Architect", 36, {"string": "str", "array": ["arr"]} ] }, { "path": "$[::-2]", "result": [ {"string": "str", "array": ["arr"]}, "three", "Architect", "John Doe" ] }, { "path": "$[::]", "result": [ "John Doe", 36, "Architect", "one", "three", "five", {"string": "str", "array": ["arr"]} ] } ] } jsonpath-0.3.0.0/test/resources/json-path-tests/SearchOperator.json0000644000000000000000000000170407346545000023541 0ustar0000000000000000{ "title" : "Search Operator", "data" : { "firstName" : "John", "lastName" : "Doe", "eyes" : "blue", "children" : [{ "firstName" : "Sally", "lastName" : "Doe", "favoriteGames" : ["Halo", "Minecraft", "Lego: Star Wars"] }, { "firstName" : "Mike", "lastName" : "Doe", "eyes" : "green" } ] }, "tests" : [{ "path" : "$..firstName", "result" : ["John", "Sally", "Mike"] }, { "path" : "$..lastName", "result" : ["Doe", "Doe", "Doe"] }, { "path" : "$..eyes", "result" : ["blue", "green"] }, { "path" : "$..missingKey", "result" : [] }, { "path" : "$..[1]", "result" : [{ "firstName" : "Mike", "lastName" : "Doe", "eyes" : "green" }, "Minecraft"] }] }