jsonpath (empty) → 0.1.0.0
raw patch · 12 files changed
+589/−0 lines, 12 filesdep +aesondep +aeson-casingdep +attoparsecsetup-changed
Dependencies added: aeson, aeson-casing, attoparsec, base, bytestring, file-embed, hspec, hspec-attoparsec, jsonpath, text, unordered-containers, vector
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +20/−0
- Setup.hs +2/−0
- jsonpath.cabal +72/−0
- src/Data/JSONPath.hs +11/−0
- src/Data/JSONPath/Execute.hs +106/−0
- src/Data/JSONPath/ExecutionResult.hs +59/−0
- src/Data/JSONPath/Parser.hs +167/−0
- src/Data/JSONPath/Types.hs +45/−0
- test/Data/JSONPathSpec.hs +73/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for jsonpath-hs++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 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.
+ README.md view
@@ -0,0 +1,20 @@+# 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).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jsonpath.cabal view
@@ -0,0 +1,72 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: fabb3215a8083837cad56530f0576cfca0cb5d7f685b839c26adcf1f3eb129ab++name: jsonpath+version: 0.1.0.0+synopsis: Library to parse and execute JSONPath+description: Please see the README on GitHub at <https://github.com/akshaymankar/jsonpath-hs#readme>+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++source-repository head+ type: git+ location: https://github.com/akshaymankar/jsonpath-hs++library+ exposed-modules:+ Data.JSONPath+ Data.JSONPath.Execute+ Data.JSONPath.ExecutionResult+ Data.JSONPath.Parser+ Data.JSONPath.Types+ other-modules:+ Paths_jsonpath+ hs-source-dirs:+ src+ build-depends:+ aeson >=1.4.2 && <1.5+ , attoparsec >=0.13.2 && <0.14+ , base >=4.7 && <5+ , text >=1.2.3 && <1.3+ , unordered-containers >=0.2.10 && <0.3+ , vector >=0.12.0 && <0.13+ 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-depends:+ aeson >=1.4.2 && <1.5+ , aeson-casing+ , attoparsec >=0.13.2 && <0.14+ , base >=4.7 && <5+ , bytestring+ , file-embed+ , hspec+ , hspec-attoparsec+ , jsonpath+ , text >=1.2.3 && <1.3+ , unordered-containers >=0.2.10 && <0.3+ , vector >=0.12.0 && <0.13+ default-language: Haskell2010
+ src/Data/JSONPath.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.JSONPath+ ( module Data.JSONPath.Types+ , module Data.JSONPath.Parser+ , module Data.JSONPath.Execute+ )+where++import Data.JSONPath.Types+import Data.JSONPath.Parser+import Data.JSONPath.Execute
+ src/Data/JSONPath/Execute.hs view
@@ -0,0 +1,106 @@+module Data.JSONPath.Execute+ (executeJSONPath, executeJSONPathEither, executeJSONPathElement)+where++import Data.Aeson+import Data.Aeson.Text+import Data.Function ((&))+import Data.HashMap.Strict as Map+import Data.JSONPath.Types+import Data.Text (unpack)++import qualified Data.Text.Lazy as LazyText+import qualified Data.Vector as V++executeJSONPath :: [JSONPathElement] -> Value -> ExecutionResult Value+executeJSONPath [] val = ResultError "empty json path"+executeJSONPath (j:[]) val = executeJSONPathElement j val+executeJSONPath (j:js) val = executeJSONPath js =<< executeJSONPathElement j val++executeJSONPathEither :: [JSONPathElement] -> Value -> Either String [Value]+executeJSONPathEither js val = resultToEither $ executeJSONPath js val++executeJSONPathElement :: JSONPathElement -> Value -> ExecutionResult Value+executeJSONPathElement (KeyChild key) val =+ case val of+ Object o -> Map.lookup key o+ & (maybeToResult (notFoundErr key o))+ _ -> ResultError $ expectedObjectErr val+executeJSONPathElement (AnyChild) val =+ case val of+ Object o -> ResultList $ Map.elems o+ Array a -> ResultList $ V.toList a+ _ -> ResultError $ expectedObjectErr val+executeJSONPathElement (Slice slice) val =+ case val of+ Array a -> executeSliceElement slice a+ _ -> ResultError $ expectedArrayErr val+executeJSONPathElement (SliceUnion first second) val =+ case val of+ Array a -> appendResults (executeSliceElement first a) (executeSliceElement second a)+ _ -> ResultError $ expectedArrayErr val+executeJSONPathElement (Filter _ jsonPath cond lit) val =+ case val of+ Array a -> do+ let l = V.toList a+ ResultList $ Prelude.map (executeJSONPath jsonPath) l+ & zip l+ & excludeSndErrors+ & Prelude.foldr (\(x,ys) acc -> if length ys == 1 then (x, head ys):acc else acc) []+ & Prelude.filter (\(origVal, exprVal) -> executeCondition exprVal cond lit)+ & Prelude.map fst+ _ -> ResultError $ expectedArrayErr val+executeJSONPathElement s@(Search js) val =+ let x = either (const []) id $ executeJSONPathEither js val+ y = excludeErrors $ valMap (executeJSONPathElement s) val+ in if Prelude.null x && Prelude.null y+ then ResultError "Search failed"+ else ResultList $ x ++ y++valMap :: ToJSON b => (Value -> ExecutionResult b) -> Value -> [ExecutionResult b]+valMap f v@(Object o) = elems $ Map.map f o+valMap f (Array a) = V.toList $ V.map f a+valMap _ v = pure $ ResultError $ "Expected object or array, found " <> (encodeJSONToString v)++executeCondition :: Value -> Condition -> Literal -> Bool+executeCondition (Number n1) Equal (LitNumber n2) = n1 == (fromInteger $ toInteger n2)+executeCondition (String s1) Equal (LitString s2) = s1 == s2++executeSliceElement :: SliceElement -> V.Vector Value -> ExecutionResult Value+executeSliceElement (SingleIndex i) v = if i < 0+ then maybeToResult (invalidIndexErr i v) $ (V.!?) v (V.length v + i)+ else maybeToResult (invalidIndexErr i v) $ (V.!?) v i+executeSliceElement (SimpleSlice start end) v = sliceEither v start end 1+executeSliceElement (SliceWithStep start end step) v = sliceEither v start end step+executeSliceElement (SliceTo end) v = sliceEither v 0 end 1+executeSliceElement (SliceToWithStep end step) v = sliceEither v 0 end step+executeSliceElement (SliceFrom start) v = sliceEither v start (-1) 1+executeSliceElement (SliceFromWithStep start step) v = sliceEither v start (-1) step+executeSliceElement (SliceWithOnlyStep step) v = sliceEither v 0 (-1) step++sliceEither :: ToJSON a+ => V.Vector a -> Int -> Int -> Int -> ExecutionResult a+sliceEither v start end step = let len = V.length v+ realStart = if start < 0 then len + start else start+ realEnd = if end < 0 then len + end + 1 else end+ in if realStart < realEnd+ then appendResults (indexEither v realStart) (sliceEither v (realStart + step) realEnd step)+ else ResultList []++indexEither :: ToJSON a => V.Vector a -> Int -> ExecutionResult a+indexEither v i = (V.!?) v i+ & maybeToResult (invalidIndexErr i v)++excludeSndErrors :: [(c, ExecutionResult a)] -> [(c, [a])]+excludeSndErrors xs = Prelude.foldr accumulateFn ([] :: [(c, b)]) xs where+ accumulateFn (x, ResultList ys) acc = (x, ys):acc+ accumulateFn (x, ResultValue y) acc = (x, [y]):acc+ accumulateFn (x, _) acc = acc++encodeJSONToString :: ToJSON a => a -> String+encodeJSONToString x = LazyText.unpack $ encodeToLazyText x++notFoundErr key o = "expected key " <> unpack key <> " in object " <> (encodeJSONToString o)+invalidIndexErr i a = "index " <> show i <> " invalid for array " <> (encodeJSONToString a)+expectedObjectErr val = "expected object, found " <> (encodeJSONToString val)+expectedArrayErr val = "expected array, found " <> (encodeJSONToString val)
+ src/Data/JSONPath/ExecutionResult.hs view
@@ -0,0 +1,59 @@+module Data.JSONPath.ExecutionResult where++data ExecutionResult a = ResultList [a]+ | ResultValue a+ | ResultError String++instance Functor ExecutionResult where+ fmap f (ResultList xs) = ResultList $ Prelude.map f xs+ fmap f (ResultValue x) = ResultValue $ f x+ fmap f (ResultError err) = ResultError err++instance Applicative ExecutionResult where+ pure = ResultValue+ (<*>) (ResultList fs) (ResultList xs) = ResultList $ fs <*> xs+ (<*>) (ResultList fs) (ResultValue x) = ResultList $ Prelude.map (\f -> f x) fs+ (<*>) (ResultValue f) (ResultList xs) = ResultList $ Prelude.map f xs+ (<*>) (ResultValue f) (ResultValue x) = ResultValue $ f x+ (<*>) (ResultError e) _ = ResultError e+ (<*>) _ (ResultError e) = ResultError e++instance Monad ExecutionResult where+ (>>=) (ResultValue x) f = f x+ (>>=) (ResultList xs) f = concatResults $ Prelude.map f xs+ (>>=) (ResultError e) f = ResultError e++concatResults :: [ExecutionResult a] -> ExecutionResult a+concatResults [] = ResultList []+concatResults (ResultList xs:rs) = case concatResults rs of+ ResultList ys -> ResultList (xs ++ ys)+ ResultValue y -> ResultList (y:xs)+ e -> e+concatResults (ResultValue x:[]) = ResultValue x+concatResults (ResultValue x:rs) = case concatResults rs of+ ResultList ys -> ResultList (x:ys)+ ResultValue y -> ResultList [x,y]+ e -> e+concatResults (e:_) = e++appendResults :: ExecutionResult a -> ExecutionResult a -> ExecutionResult a+appendResults (ResultValue x) (ResultValue y) = ResultList [x,y]+appendResults (ResultValue x) (ResultList ys) = ResultList $ x:ys+appendResults (ResultList xs) (ResultValue y) = ResultList $ y:xs+appendResults (ResultList xs) (ResultList ys) = ResultList $ xs ++ ys+appendResults _ e = e++maybeToResult :: String -> Maybe a ->ExecutionResult a+maybeToResult _ (Just x) = ResultValue x+maybeToResult err _ = ResultError err++resultToEither :: ExecutionResult a -> Either String [a]+resultToEither (ResultList xs) = return xs+resultToEither (ResultValue x) = return [x]+resultToEither (ResultError e) = Left e++excludeErrors :: [ExecutionResult a] -> [a]+excludeErrors [] = []+excludeErrors (ResultError _:rs) = excludeErrors rs+excludeErrors (ResultList xs:rs) = xs ++ excludeErrors rs+excludeErrors (ResultValue x:rs) = x:(excludeErrors rs)
+ src/Data/JSONPath/Parser.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.JSONPath.Parser+ (jsonPathElement, jsonPath)+where++import Control.Applicative ((<|>))+import Data.Attoparsec.Text as A+import Data.Functor+import Data.JSONPath.Types++jsonPath :: Parser [JSONPathElement]+jsonPath = do+ _ <- skip (== '$') <|> pure ()+ many1 jsonPathElement++jsonPathElement :: Parser JSONPathElement+jsonPathElement = do+ (keyChildDot <?> "keyChldDot")+ <|> (keyChildBracket <?> "keyChildBracket")+ <|> (keyChildren <?> "keyChildren")+ <|> (anyChild <?> "anyChild")+ <|> (slice <?> "slice")+ <|> (sliceUnion <?> "sliceUnion")+ <|> (filterParser <?> "filterParser")+ <|> (search <?> "serach")+ <|> (searchBeginingWithSlice <?> "serachBegingingWithSlice")++slice :: Parser JSONPathElement+slice = Slice <$> ignoreSurroundingSqBr sliceWithoutBrackets++sliceWithoutBrackets = (sliceWithStep <?> "sliceWithStep")+ <|> (simpleSlice <?> "simpleSlice")+ <|> (sliceFromWithStep <?> "sliceFromWithStep")+ <|> (sliceFrom <?> "sliceFrom")+ <|> (singleIndex <?> "singleIndex")+ <|> (sliceToWithStep <?> "sliceToWithStep")+ <|> (sliceTo <?> "sliceTo")+ <|> (sliceWithOnlyStep <?> "sliceWithOnlyStep")++singleIndex :: Parser SliceElement+singleIndex = SingleIndex <$> signed decimal++keyChildBracket :: Parser JSONPathElement+keyChildBracket = KeyChild+ <$> (string "['" *> takeWhile1 (inClass "a-zA-Z0-9_-") <* string "']")++keyChildDot :: Parser JSONPathElement+keyChildDot = KeyChild+ <$> (char '.' *> takeWhile1 (inClass "a-zA-Z0-9_-"))++keyChildren :: Parser JSONPathElement+keyChildren = do+ _ <- string "['"+ firstKey <- takeWhile1 (inClass "a-zA-Z0-9_-")+ restKeys <- many' $ char '.' *> takeWhile1 (inClass "a-zA-Z0-9_-")+ _ <- string "']"+ return $ KeyChildren (firstKey:restKeys)++anyChild :: Parser JSONPathElement+anyChild = AnyChild <$ (string ".*" <|> string "[*]")++-- peekAssertClosingSqBr :: Parser ()+-- peekAssertClosingSqBr ++simpleSlice :: Parser SliceElement+simpleSlice = do+ start <- signed decimal+ _ <- char ':'+ end <- signed decimal+ return $ SimpleSlice start end++sliceWithStep :: Parser SliceElement+sliceWithStep = do+ start <- signed decimal+ _ <- char ':'+ end <- signed decimal+ _ <- char ':'+ step <- signed decimal+ return $ SliceWithStep start end step++sliceFrom :: Parser SliceElement+sliceFrom = do+ start <- signed decimal+ _ <- char ':'+ return $ SliceFrom start++sliceFromWithStep :: Parser SliceElement+sliceFromWithStep = do+ start <- signed decimal+ _ <- string "::"+ step <- signed decimal+ return $ SliceFromWithStep start step++sliceTo :: Parser SliceElement+sliceTo = do+ _ <- char ':'+ end <- signed decimal+ return $ SliceTo end++sliceToWithStep :: Parser SliceElement+sliceToWithStep = do+ _ <- char ':'+ end <- signed decimal+ _ <- char ':'+ step <- signed decimal+ return $ SliceToWithStep end step++sliceWithOnlyStep :: Parser SliceElement+sliceWithOnlyStep = do+ _ <- string "::"+ step <- signed decimal+ return $ SliceWithOnlyStep step++sliceUnion :: Parser JSONPathElement+sliceUnion = ignoreSurroundingSqBr $ do+ firstElement <- sliceWithoutBrackets <?> "firstElement"+ _ <- char ','+ secondElement <- sliceWithoutBrackets <?> "secondElement"+ return $ SliceUnion firstElement secondElement++filterParser :: Parser JSONPathElement+filterParser = do+ _ <- string "[?(" <?> "[?("+ b <- beginingPoint <?> "begining point"+ js <- jsonPath <?> "jsonPathElements"+ c <- condition <?> "condition"+ l <- literal <?> "literal"+ _ <- string ")]" <?> ")]"+ return $ Filter b js c l++search :: Parser JSONPathElement+search = do+ _ <- char '.'+ isDot <- (== '.') <$> peekChar'+ if isDot+ then Search <$> many1 jsonPathElement+ else fail "not a search element"++searchBeginingWithSlice :: Parser JSONPathElement+searchBeginingWithSlice = do+ _ <- string ".."+ isBracket <- (== '[') <$> peekChar'+ if isBracket+ then Search <$> many1 jsonPathElement+ else fail "not a search element"++beginingPoint :: Parser BegingingPoint+beginingPoint = do+ ((char '$' $> Root) <|> (char '@' $> CurrentObject))++condition :: Parser Condition+condition = ignoreSurroundingSpace+ $ string "==" $> Equal+ <|> string "!=" $> NotEqual+ <|> string ">" $> GreaterThan+ <|> string "<" $> SmallerThan++literal :: Parser Literal+literal = do+ (LitNumber <$> signed decimal)+ <|> LitString <$> (char '"' *> A.takeWhile (/= '"') <* char '"')++ignoreSurroundingSpace :: Parser a -> Parser a+ignoreSurroundingSpace p = many' space *> p <* many' space++ignoreSurroundingSqBr :: Parser a -> Parser a+ignoreSurroundingSqBr p = char '[' *> p <* char ']'
+ src/Data/JSONPath/Types.hs view
@@ -0,0 +1,45 @@+module Data.JSONPath.Types+ ( BegingingPoint(..)+ , Condition(..)+ , Literal(..)+ , JSONPathElement(..)+ , SliceElement(..)+ , module Data.JSONPath.ExecutionResult+ )+where++import Data.Text+import Data.JSONPath.ExecutionResult++data BegingingPoint = Root+ | CurrentObject+ deriving (Show, Eq)++data Condition = Equal+ | NotEqual+ | GreaterThan+ | SmallerThan+ deriving (Show, Eq)++data Literal = LitNumber Int+ | LitString Text+ deriving (Show, Eq)++data SliceElement = SingleIndex Int+ | SimpleSlice Int Int+ | SliceWithStep Int Int Int+ | SliceTo Int+ | SliceToWithStep Int Int+ | SliceFrom Int+ | SliceFromWithStep Int Int+ | SliceWithOnlyStep Int+ deriving (Show, Eq)++data JSONPathElement = KeyChild Text+ | KeyChildren [Text]+ | AnyChild+ | Slice SliceElement+ | SliceUnion SliceElement SliceElement+ | Filter BegingingPoint [JSONPathElement] Condition Literal+ | Search [JSONPathElement]+ deriving (Show, Eq)
+ test/Data/JSONPathSpec.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+module Data.JSONPathSpec where++import Data.Aeson+import Data.Aeson.Casing+import Data.Aeson.Text+import Data.Aeson.TH+import Data.Attoparsec.Text+import Data.Either+import Data.FileEmbed+import Data.JSONPath+import Data.Text (Text, unpack)+import GHC.Generics+import Test.Hspec+import Test.Hspec.Attoparsec++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text.Lazy as LazyText+import qualified Data.Vector as V++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 = sequenceA $ map (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+ (".foo" :: Text) ~> (jsonPathElement <* endOfInput)+ `shouldParse` KeyChild "foo"+ ("$.foo" :: Text) ~> (jsonPath <* endOfInput)+ `shouldParse` [KeyChild "foo"]++parseJSONPath :: Text -> Either String [JSONPathElement]+parseJSONPath = parseOnly (jsonPath <* endOfInput)++group :: TestGroup -> Spec+group TestGroup{..} = describe (unpack groupTitle)+ $ mapM_ (test groupData) groupTests++test :: Value -> Test -> Spec+test testData (Test path expected) =+ let result = parseJSONPath path >>= (flip executeJSONPathEither testData)+ in it (unpack path) $+ case expected of+ Array a -> case result of+ Left err -> expectationFailure $ "Unexpected Left: " <> err+ Right r -> r `shouldMatchList` (V.toList a)+ Bool False -> result `shouldSatisfy` isLeft+ v -> expectationFailure $ "Invalid result in test data " <> (LazyText.unpack $ encodeToLazyText v)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}