summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraxeman <>2019-07-05 18:35:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-07-05 18:35:00 (GMT)
commit68452a4267ae84f17f2bf821999aa7c4e81fbfd9 (patch)
tree4c1adf619f7f0acc9c65d04db643f949b2d09bbe
version 0.1.0.00.1.0.0
-rw-r--r--ChangeLog.md3
-rw-r--r--LICENSE30
-rw-r--r--README.md20
-rw-r--r--Setup.hs2
-rw-r--r--jsonpath.cabal72
-rw-r--r--src/Data/JSONPath.hs11
-rw-r--r--src/Data/JSONPath/Execute.hs106
-rw-r--r--src/Data/JSONPath/ExecutionResult.hs59
-rw-r--r--src/Data/JSONPath/Parser.hs167
-rw-r--r--src/Data/JSONPath/Types.hs45
-rw-r--r--test/Data/JSONPathSpec.hs73
-rw-r--r--test/Spec.hs1
12 files changed, 589 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..9903e21
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for jsonpath-hs
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..43ad14d
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..04a59e0
--- /dev/null
+++ b/README.md
@@ -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).
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/jsonpath.cabal b/jsonpath.cabal
new file mode 100644
index 0000000..127a38c
--- /dev/null
+++ b/jsonpath.cabal
@@ -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
diff --git a/src/Data/JSONPath.hs b/src/Data/JSONPath.hs
new file mode 100644
index 0000000..58984bd
--- /dev/null
+++ b/src/Data/JSONPath.hs
@@ -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
diff --git a/src/Data/JSONPath/Execute.hs b/src/Data/JSONPath/Execute.hs
new file mode 100644
index 0000000..6e529cf
--- /dev/null
+++ b/src/Data/JSONPath/Execute.hs
@@ -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)
diff --git a/src/Data/JSONPath/ExecutionResult.hs b/src/Data/JSONPath/ExecutionResult.hs
new file mode 100644
index 0000000..fca1d8f
--- /dev/null
+++ b/src/Data/JSONPath/ExecutionResult.hs
@@ -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)
diff --git a/src/Data/JSONPath/Parser.hs b/src/Data/JSONPath/Parser.hs
new file mode 100644
index 0000000..037a941
--- /dev/null
+++ b/src/Data/JSONPath/Parser.hs
@@ -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 ']'
diff --git a/src/Data/JSONPath/Types.hs b/src/Data/JSONPath/Types.hs
new file mode 100644
index 0000000..559c688
--- /dev/null
+++ b/src/Data/JSONPath/Types.hs
@@ -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)
diff --git a/test/Data/JSONPathSpec.hs b/test/Data/JSONPathSpec.hs
new file mode 100644
index 0000000..fa43c8b
--- /dev/null
+++ b/test/Data/JSONPathSpec.hs
@@ -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)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}