diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## 0.2.0.0 + +- Remove dependency on `protolude` +- Fix parsing bug with Wildcard Selector +- Implement Descendant Segment +- Fix allowed characters in the `member-name-shorthand` +- Add `QuasiQuoter` for compile-time syntax checking + ## 0.1.0.0 - Initial Release diff --git a/aeson-jsonpath.cabal b/aeson-jsonpath.cabal --- a/aeson-jsonpath.cabal +++ b/aeson-jsonpath.cabal @@ -1,5 +1,5 @@ name: aeson-jsonpath -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Parse and run JSONPath queries on Aeson documents description: RFC 9535 compliant JSONPath parsing and querying package. JSONPath is similar to XPath for querying XML documents. @@ -15,8 +15,10 @@ cabal-version: >= 1.10 tested-with: - -- On Ubuntu Latest - GHC == 9.4.5 + GHC == 9.4.8 + , GHC == 9.6.6 + , GHC == 9.8.4 + , GHC == 9.10.1 source-repository head type: git @@ -26,30 +28,34 @@ default-language: Haskell2010 default-extensions: OverloadedStrings NoImplicitPrelude + QuasiQuotes hs-source-dirs: src exposed-modules: Data.Aeson.JSONPath Data.Aeson.JSONPath.Parser build-depends: aeson >= 2.0.3 && < 2.3 - , base >= 4.9 && < 4.20 + , base >= 4.9 && < 4.22 , parsec >= 3.1.11 && < 3.2 - , protolude >= 0.3.1 && < 0.4 + , template-haskell >= 2.12 && < 2.24 + , text >= 1.2.2 && < 2.2 , vector >= 0.11 && < 0.14 - ghc-options: -Wall + ghc-options: -Wall -Wunused-packages test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 default-extensions: OverloadedStrings NoImplicitPrelude + QuasiQuotes hs-source-dirs: test main-is: Main.hs other-modules: ParserSpec QuerySpec build-depends: aeson >= 2.0.3 && < 2.3 , aeson-jsonpath + , base >= 4.9 && < 4.22 , hspec >= 2.3 && < 2.12 , parsec >= 3.1.11 && < 3.2 - , protolude >= 0.3.1 && < 0.4 + , vector >= 0.11 && < 0.14 - ghc-options: -Wall + ghc-options: -Wall -Wunused-packages diff --git a/src/Data/Aeson/JSONPath.hs b/src/Data/Aeson/JSONPath.hs --- a/src/Data/Aeson/JSONPath.hs +++ b/src/Data/Aeson/JSONPath.hs @@ -1,48 +1,88 @@ module Data.Aeson.JSONPath - ( runJSPQuery ) + ( runJSPQuery + , jsonPath) where import qualified Data.Aeson as JSON -import qualified Text.ParserCombinators.Parsec as P import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import qualified Data.Vector as V +import qualified Text.ParserCombinators.Parsec as P import Data.Aeson.JSONPath.Parser (JSPQuery (..) , JSPSegment (..) , JSPChildSegment (..) + , JSPDescSegment (..) , JSPSelector (..) , JSPWildcardT (..) , pJSPQuery) -import Protolude +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) +import Language.Haskell.TH.Syntax (lift) +import Prelude -runJSPQuery :: Text -> JSON.Value -> Either P.ParseError JSON.Value -runJSPQuery query document = do - jspath <- P.parse pJSPQuery ("failed to parse query: " <> toS query) (toS query) - return $ traverseJSPQuery jspath document +jsonPath :: QuasiQuoter +jsonPath = QuasiQuoter + { quoteExp = \query -> case P.parse pJSPQuery ("failed to parse query: " <> query) query of + Left err -> fail $ show err + Right ex -> lift ex + , quotePat = error "Error: quotePat" + , quoteType = error "Error: quoteType" + , quoteDec = error "Error: quoteDec" + } +-- | Run JSONPath query +-- +-- @ +-- {-\# LANGUAGE QuasiQuotes \#-} +-- +-- import Data.Aeson (Value) +-- import Data.Aeson.JSONPath (runJSPQuery, jsonPath) +-- +-- book :: 'Value' +-- book = [jsonPath|$.store.books[2]|] +-- @ +runJSPQuery :: JSPQuery -> JSON.Value -> JSON.Value +runJSPQuery = traverseJSPQuery + + traverseJSPQuery :: JSPQuery -> JSON.Value -> JSON.Value -traverseJSPQuery (JSPRoot segs) doc = traverseJSPSegments segs doc +traverseJSPQuery (JSPRoot segs) = traverseJSPSegments segs traverseJSPSegments :: [JSPSegment] -> JSON.Value -> JSON.Value -traverseJSPSegments [] doc = doc -traverseJSPSegments (x:xs) doc = traverseJSPSegments xs (traverseJSPSegment x doc) +traverseJSPSegments xs doc = foldl (flip traverseJSPSegment) doc xs traverseJSPSegment :: JSPSegment -> JSON.Value -> JSON.Value traverseJSPSegment (JSPChildSeg jspChildSeg) doc = traverseJSPChildSeg jspChildSeg doc +traverseJSPSegment (JSPDescSeg jspDescSeg) doc = traverseJSPDescSeg jspDescSeg doc traverseJSPChildSeg :: JSPChildSegment -> JSON.Value -> JSON.Value -traverseJSPChildSeg (JSPBracketed sels) doc = traverseJSPSelectors sels doc -traverseJSPChildSeg (JSPMemberNameSH key) (JSON.Object obj) = fromMaybe emptyJSArray $ KM.lookup (K.fromText key) obj -traverseJSPChildSeg (JSPMemberNameSH _) _ = emptyJSArray -traverseJSPChildSeg (JSPSegWildcard JSPWildcard) doc = doc +traverseJSPChildSeg (JSPChildBracketed sels) doc = traverseJSPSelectors sels doc +traverseJSPChildSeg (JSPChildMemberNameSH key) (JSON.Object obj) = fromMaybe emptyJSArray $ KM.lookup (K.fromText key) obj +traverseJSPChildSeg (JSPChildMemberNameSH _) _ = emptyJSArray +traverseJSPChildSeg (JSPChildWildSeg JSPWildcard) doc = doc +traverseJSPDescSeg :: JSPDescSegment -> JSON.Value -> JSON.Value +traverseJSPDescSeg (JSPDescBracketed sels) doc = JSON.Array $ V.map (traverseJSPSelectors sels) (allElemsRecursive doc) +traverseJSPDescSeg (JSPDescMemberNameSH key) doc = traverseDescMembers key doc +traverseJSPDescSeg (JSPDescWildSeg JSPWildcard) doc = JSON.Array $ allElemsRecursive doc + +-- TODO: Clean this super messy code, might require some refactoring +traverseDescMembers :: Text -> JSON.Value -> JSON.Value +traverseDescMembers key (JSON.Object obj) = JSON.Array $ V.concat [ + maybe V.empty V.singleton $ KM.lookup (K.fromText key) obj, + V.map (traverseDescMembers key) (allElemsRecursive (JSON.Array $ V.fromList $ KM.elems obj)) + ] +traverseDescMembers key ar@(JSON.Array _) = JSON.Array $ V.map (traverseDescMembers key) (allElemsRecursive ar) +traverseDescMembers _ _ = JSON.Array V.empty + traverseJSPSelectors :: [JSPSelector] -> JSON.Value -> JSON.Value traverseJSPSelectors sels doc = JSON.Array $ V.concat $ map traverse' sels where @@ -51,10 +91,11 @@ traverseJSPSelector :: JSPSelector -> JSON.Value -> V.Vector JSON.Value traverseJSPSelector (JSPNameSel key) (JSON.Object obj) = maybe V.empty V.singleton $ KM.lookup (K.fromText key) obj traverseJSPSelector (JSPNameSel _) _ = V.empty -traverseJSPSelector (JSPIndexSel idx) (JSON.Array arr) = maybe V.empty V.singleton $ (if idx >= 0 then (V.!?) arr idx else (V.!?) arr (idx + V.length arr)) +traverseJSPSelector (JSPIndexSel idx) (JSON.Array arr) = maybe V.empty V.singleton (if idx >= 0 then (V.!?) arr idx else (V.!?) arr (idx + V.length arr)) traverseJSPSelector (JSPIndexSel _) _ = V.empty traverseJSPSelector (JSPSliceSel sliceVals) (JSON.Array arr) = traverseJSPSliceSelector sliceVals arr traverseJSPSelector (JSPSliceSel _) _ = V.empty +-- This does not work right with descendant segment, fix it later traverseJSPSelector (JSPWildSel JSPWildcard) doc = V.singleton doc @@ -85,9 +126,20 @@ filterSlice slice 1 = slice filterSlice slice (-1) = V.reverse slice filterSlice slice n = if n < 0 then - V.ifilter (\i _ -> i `mod` (-1 * n) == 0) $ V.reverse $ V.drop (V.length slice `mod` (-1 * n)) slice + V.ifilter (\i _ -> i `mod` (-n) == 0) $ V.reverse $ V.drop (V.length slice `mod` (-n)) slice else V.ifilter (\i _ -> i `mod` n == 0) slice emptyJSArray :: JSON.Value emptyJSArray = JSON.Array V.empty + +allElemsRecursive :: JSON.Value -> V.Vector JSON.Value +allElemsRecursive (JSON.Object obj) = V.concat [ + V.fromList (KM.elems obj), + V.concat $ map allElemsRecursive (KM.elems obj) + ] +allElemsRecursive (JSON.Array arr) = V.concat [ + arr, + V.concat $ map allElemsRecursive (V.toList arr) + ] +allElemsRecursive _ = V.empty diff --git a/src/Data/Aeson/JSONPath/Parser.hs b/src/Data/Aeson/JSONPath/Parser.hs --- a/src/Data/Aeson/JSONPath/Parser.hs +++ b/src/Data/Aeson/JSONPath/Parser.hs @@ -1,46 +1,62 @@ +{-# LANGUAGE DeriveLift #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-} module Data.Aeson.JSONPath.Parser ( JSPQuery (..) , JSPSegment (..) , JSPChildSegment (..) + , JSPDescSegment (..) , JSPSelector (..) , JSPWildcardT (..) , pJSPQuery ) where +import qualified Data.Text as T import qualified Text.ParserCombinators.Parsec as P -import Text.Read (read) +import Data.Functor (($>)) +import Data.Text (Text) +import Data.Char (ord) +import Text.ParserCombinators.Parsec ((<|>)) +import Language.Haskell.TH.Syntax (Lift (..)) -import Protolude +import Prelude -data JSPQuery +newtype JSPQuery = JSPRoot [JSPSegment] - deriving (Eq, Show) + deriving (Eq, Show, Lift) -- https://www.rfc-editor.org/rfc/rfc9535#name-segments-2 data JSPSegment = JSPChildSeg JSPChildSegment - deriving (Eq, Show) + | JSPDescSeg JSPDescSegment + deriving (Eq, Show, Lift) -- https://www.rfc-editor.org/rfc/rfc9535#name-child-segment data JSPChildSegment - = JSPBracketed [JSPSelector] - | JSPMemberNameSH JSPNameSelector - | JSPSegWildcard JSPWildcardT - deriving (Eq, Show) + = JSPChildBracketed [JSPSelector] + | JSPChildMemberNameSH JSPNameSelector + | JSPChildWildSeg JSPWildcardT + deriving (Eq, Show, Lift) + +-- https://www.rfc-editor.org/rfc/rfc9535#name-descendant-segment +data JSPDescSegment + = JSPDescBracketed [JSPSelector] + | JSPDescMemberNameSH JSPNameSelector + | JSPDescWildSeg JSPWildcardT + deriving (Eq, Show, Lift) + -- https://www.rfc-editor.org/rfc/rfc9535#name-selectors-2 data JSPSelector = JSPNameSel JSPNameSelector | JSPIndexSel JSPIndexSelector | JSPSliceSel JSPSliceSelector | JSPWildSel JSPWildcardT - deriving (Eq, Show) + deriving (Eq, Show, Lift) data JSPWildcardT = JSPWildcard - deriving (Eq, Show) + deriving (Eq, Show, Lift) type JSPNameSelector = Text @@ -52,6 +68,7 @@ pJSPQuery = do P.char '$' segs <- P.many pJSPSegment + P.eof return $ JSPRoot segs pJSPSelector :: P.Parser JSPSelector @@ -61,7 +78,7 @@ <|> P.try pJSPWildSel pJSPNameSel :: P.Parser JSPSelector -pJSPNameSel = JSPNameSel <$> toS <$> (P.char '"' *> P.many (P.noneOf "\"") <* P.char '"') +pJSPNameSel = JSPNameSel . T.pack <$> (P.char '\'' *> P.many (P.noneOf "\'") <* P.char '\'') pJSPIndexSel :: P.Parser JSPSelector pJSPIndexSel = do @@ -81,42 +98,79 @@ pJSPWildSel :: P.Parser JSPSelector -pJSPWildSel = JSPWildSel <$> (P.string ".*" $> JSPWildcard) +pJSPWildSel = JSPWildSel <$> (P.char '*' $> JSPWildcard) pJSPSegment :: P.Parser JSPSegment -pJSPSegment = pJSPChildSegment +pJSPSegment = pJSPChildSegment <|> pJSPDescSegment pJSPChildSegment :: P.Parser JSPSegment pJSPChildSegment = - JSPChildSeg <$> (P.try pJSPBracketed - <|> P.try pJSPMemberNameSH - <|> P.try pJSPWildSeg) + JSPChildSeg <$> (P.try pJSPChildBracketed + <|> P.try pJSPChildMemberNameSH + <|> P.try pJSPChildWildSeg) -pJSPBracketed :: P.Parser JSPChildSegment -pJSPBracketed = do +pJSPChildBracketed :: P.Parser JSPChildSegment +pJSPChildBracketed = do P.char '[' sel <- pJSPSelector optionalSels <- P.many pCommaSepSelectors P.char ']' - return $ JSPBracketed (sel:optionalSels) + return $ JSPChildBracketed (sel:optionalSels) where pCommaSepSelectors :: P.Parser JSPSelector pCommaSepSelectors = P.char ',' *> P.spaces *> pJSPSelector -pJSPMemberNameSH :: P.Parser JSPChildSegment -pJSPMemberNameSH = do +pJSPChildMemberNameSH :: P.Parser JSPChildSegment +pJSPChildMemberNameSH = do P.char '.' - val <- toS <$> P.many1 (P.alphaNum <|> P.oneOf "_$@") - return (JSPMemberNameSH val) + P.lookAhead (P.letter <|> P.oneOf "-" <|> pUnicodeChar) + val <- T.pack <$> P.many1 (P.alphaNum <|> (P.oneOf "-" <|> pUnicodeChar)) + return (JSPChildMemberNameSH val) -pJSPWildSeg :: P.Parser JSPChildSegment -pJSPWildSeg = JSPSegWildcard <$> (P.string ".*" $> JSPWildcard) +pJSPChildWildSeg :: P.Parser JSPChildSegment +pJSPChildWildSeg = JSPChildWildSeg <$> (P.string ".*" $> JSPWildcard) + +pJSPDescSegment :: P.Parser JSPSegment +pJSPDescSegment = + JSPDescSeg <$> (P.try pJSPDescBracketed + <|> P.try pJSPDescMemberNameSH + <|> P.try pJSPDescWildSeg) + +pJSPDescBracketed :: P.Parser JSPDescSegment +pJSPDescBracketed = do + P.string ".." + P.char '[' + sel <- pJSPSelector + optionalSels <- P.many pCommaSepSelectors + P.char ']' + return $ JSPDescBracketed (sel:optionalSels) + where + pCommaSepSelectors :: P.Parser JSPSelector + pCommaSepSelectors = P.char ',' *> P.spaces *> pJSPSelector + +pJSPDescMemberNameSH :: P.Parser JSPDescSegment +pJSPDescMemberNameSH = do + P.string ".." + P.lookAhead (P.letter <|> P.oneOf "-" <|> pUnicodeChar) + val <- T.pack <$> P.many1 (P.alphaNum <|> P.oneOf "-" <|> pUnicodeChar) + return (JSPDescMemberNameSH val) + +pJSPDescWildSeg :: P.Parser JSPDescSegment +pJSPDescWildSeg = JSPDescWildSeg <$> (P.string "..*" $> JSPWildcard) + pSignedInt :: P.Parser Int pSignedInt = do sign <- P.optionMaybe $ P.char '-' num <- read <$> P.many1 P.digit return $ case sign of - Just _ -> -1 * num + Just _ -> -num Nothing -> num + +pUnicodeChar :: P.Parser Char +pUnicodeChar = P.satisfy inRange + where + inRange c = let code = ord c in + (code >= 0x80 && code <= 0xD7FF) || + (code >= 0xE000 && code <= 0x10FFFF) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -8,7 +8,7 @@ import qualified ParserSpec import qualified QuerySpec -import Protolude +import Prelude allSpecs :: Spec allSpecs = do diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -9,8 +9,11 @@ , JSPQuery (..) , JSPSegment (..) , JSPChildSegment (..) - , JSPSelector (..)) -import Protolude + , JSPDescSegment (..) + , JSPSelector (..) + , JSPWildcardT (..)) +import Data.Either (isLeft) +import Prelude spec :: Spec spec = do @@ -19,25 +22,46 @@ P.parse pJSPQuery "" "$" `shouldBe` Right (JSPRoot []) it "parses query: $.store" $ - P.parse pJSPQuery "" "$.store" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store")]) + P.parse pJSPQuery "" "$.store" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store")]) it "parses query: $.store.books" $ - P.parse pJSPQuery "" "$.store.books" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books")]) + P.parse pJSPQuery "" "$.store.books" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books")]) it "parses query: $.store.books[0]" $ - P.parse pJSPQuery "" "$.store.books[0]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books"), JSPChildSeg (JSPBracketed [JSPIndexSel 0])]) + P.parse pJSPQuery "" "$.store.books[0]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPIndexSel 0])]) it "parses query: $.store.books[0,2]" $ - P.parse pJSPQuery "" "$.store.books[0,2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books"), JSPChildSeg (JSPBracketed [JSPIndexSel 0, JSPIndexSel 2])]) + P.parse pJSPQuery "" "$.store.books[0,2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPIndexSel 0, JSPIndexSel 2])]) it "parses query: $.store.books[1:3]" $ - P.parse pJSPQuery "" "$.store.books[1:3]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books"), JSPChildSeg (JSPBracketed [JSPSliceSel (Just 1, Just 3, 1)])]) + P.parse pJSPQuery "" "$.store.books[1:3]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just 1, Just 3, 1)])]) it "parses query: $.store.books[1:4:2]" $ - P.parse pJSPQuery "" "$.store.books[1:4:2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books"), JSPChildSeg (JSPBracketed [JSPSliceSel (Just 1, Just 4, 2)])]) + P.parse pJSPQuery "" "$.store.books[1:4:2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just 1, Just 4, 2)])]) it "parses query: $.store.books[-1:-4:-2]" $ - P.parse pJSPQuery "" "$.store.books[-1:-4:-2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books"), JSPChildSeg (JSPBracketed [JSPSliceSel (Just (-1), Just (-4), -2)])]) + P.parse pJSPQuery "" "$.store.books[-1:-4:-2]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just (-1), Just (-4), -2)])]) it "parses query: $.store.books[1:3, 0, 1]" $ - P.parse pJSPQuery "" "$.store.books[1:3, 0, 1]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPMemberNameSH "store"), JSPChildSeg (JSPMemberNameSH "books"), JSPChildSeg (JSPBracketed [JSPSliceSel (Just 1, Just 3, 1), JSPIndexSel 0, JSPIndexSel 1])]) + P.parse pJSPQuery "" "$.store.books[1:3, 0, 1]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "store"), JSPChildSeg (JSPChildMemberNameSH "books"), JSPChildSeg (JSPChildBracketed [JSPSliceSel (Just 1, Just 3, 1), JSPIndexSel 0, JSPIndexSel 1])]) + + it "parses query: $.*" $ + P.parse pJSPQuery "" "$.*" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildWildSeg JSPWildcard)]) + + it "parses query: $[*]" $ + P.parse pJSPQuery "" "$[*]" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildBracketed [JSPWildSel JSPWildcard])]) + + it "parses query: $..*" $ + P.parse pJSPQuery "" "$..*" `shouldBe` Right (JSPRoot [JSPDescSeg (JSPDescWildSeg JSPWildcard)]) + + it "parses query: $..[*]" $ + P.parse pJSPQuery "" "$..[*]" `shouldBe` Right (JSPRoot [JSPDescSeg (JSPDescBracketed [JSPWildSel JSPWildcard])]) + + it "parses query $.hyphen-key" $ + P.parse pJSPQuery "" "$.hyphen-key" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "hyphen-key")]) + + it "fails with $.1startsWithNum" $ + P.parse pJSPQuery "" "$.1startsWithNum" `shouldSatisfy` isLeft + + it "parses query $.©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ" $ + P.parse pJSPQuery "" "$.©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ" `shouldBe` Right (JSPRoot [JSPChildSeg (JSPChildMemberNameSH "©®±×÷Ωπ•€→∀∃∈≠≤≥✓λ")]) diff --git a/test/QuerySpec.hs b/test/QuerySpec.hs --- a/test/QuerySpec.hs +++ b/test/QuerySpec.hs @@ -1,149 +1,268 @@ -{-# LANGUAGE DeriveGeneric #-} module QuerySpec ( spec ) where import qualified Data.Aeson as JSON +import qualified Data.Vector as V -import Data.Aeson.JSONPath (runJSPQuery) +import Data.Aeson.JSONPath (runJSPQuery, jsonPath) +import Data.Aeson.QQ.Simple (aesonQQ) import Test.Hspec -import Protolude - -data Book = Book - { title :: Text - , author :: Text - , category :: Text - , price :: Double - } deriving (Show, Generic) - -instance JSON.ToJSON Book - -data Store = Store - { books :: [Book] - } deriving (Show, Generic) - -instance JSON.ToJSON Store - -data Root = Root - { store :: Store - } deriving (Show, Generic) +import Prelude -instance JSON.ToJSON Root +toSingletonArray :: JSON.Value -> JSON.Value +toSingletonArray = JSON.Array . V.singleton -- taken from https://serdejsonpath.live/ rootDoc :: JSON.Value -rootDoc = JSON.toJSON $ Root - { store = Store - { books = - [ Book { title = "Guns, Germs, and Steel", author = "Jared Diamond", category = "reference", price = 24.99 } - , Book { title = "David Copperfield", author = "Charles Dickens", category = "fiction", price = 12.99 } - , Book { title = "Moby Dick", author = "Herman Melville", category = "fiction", price = 8.99 } - , Book { title = "Crime and Punishment", author = "Fyodor Dostoevsky", category = "fiction", price = 19.99 } - ] - } - } +rootDoc = [aesonQQ|{ + "store": { + "books": [ + { + "title": "Guns, Germs, and Steel", + "author": "Jared Diamond", + "category": "reference", + "price": 24.99 + }, + { + "title": "David Copperfield", + "author": "Charles Dickens", + "category": "fiction", + "price": 12.99 + }, + { + "title": "Moby Dick", + "author": "Herman Melville", + "category": "fiction", + "price": 8.99 + }, + { + "title": "Crime and Punishment", + "author": "Fyodor Dostoevsky", + "category": "fiction", + "price": 19.99 + } + ] + } + }|] storeDoc :: JSON.Value -storeDoc = JSON.toJSON $ Store - { books = - [ Book { title = "Guns, Germs, and Steel", author = "Jared Diamond", category = "reference", price = 24.99 } - , Book { title = "David Copperfield", author = "Charles Dickens", category = "fiction", price = 12.99 } - , Book { title = "Moby Dick", author = "Herman Melville", category = "fiction", price = 8.99 } - , Book { title = "Crime and Punishment", author = "Fyodor Dostoevsky", category = "fiction", price = 19.99 } - ] - } - +storeDoc = [aesonQQ| + { + "books": [ + { + "title": "Guns, Germs, and Steel", + "author": "Jared Diamond", + "category": "reference", + "price": 24.99 + }, + { + "title": "David Copperfield", + "author": "Charles Dickens", + "category": "fiction", + "price": 12.99 + }, + { + "title": "Moby Dick", + "author": "Herman Melville", + "category": "fiction", + "price": 8.99 + }, + { + "title": "Crime and Punishment", + "author": "Fyodor Dostoevsky", + "category": "fiction", + "price": 19.99 + } + ] + }|] booksDoc :: JSON.Value -booksDoc = JSON.toJSON $ - [ Book { title = "Guns, Germs, and Steel", author = "Jared Diamond", category = "reference", price = 24.99 } - , Book { title = "David Copperfield", author = "Charles Dickens", category = "fiction", price = 12.99 } - , Book { title = "Moby Dick", author = "Herman Melville", category = "fiction", price = 8.99 } - , Book { title = "Crime and Punishment", author = "Fyodor Dostoevsky", category = "fiction", price = 19.99 } - ] +booksDoc = [aesonQQ| [ + { + "title": "Guns, Germs, and Steel", + "author": "Jared Diamond", + "category": "reference", + "price": 24.99 + }, + { + "title": "David Copperfield", + "author": "Charles Dickens", + "category": "fiction", + "price": 12.99 + }, + { + "title": "Moby Dick", + "author": "Herman Melville", + "category": "fiction", + "price": 8.99 + }, + { + "title": "Crime and Punishment", + "author": "Fyodor Dostoevsky", + "category": "fiction", + "price": 19.99 + } + ]|] books0Doc :: JSON.Value -books0Doc = JSON.toJSON $ [ - Book { title = "Guns, Germs, and Steel", author = "Jared Diamond", category = "reference", price = 24.99 } - ] +books0Doc = [aesonQQ|[ + { + "title": "Guns, Germs, and Steel", + "author": "Jared Diamond", + "category": "reference", + "price": 24.99 + } + ]|] books0And2Doc :: JSON.Value -books0And2Doc = JSON.toJSON $ [ - Book { title = "Guns, Germs, and Steel", author = "Jared Diamond", category = "reference", price = 24.99 } - , Book { title = "Moby Dick", author = "Herman Melville", category = "fiction", price = 8.99 } - ] +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 + } + ]|] books1To3Doc :: JSON.Value -books1To3Doc = JSON.toJSON $ [ - Book { title = "David Copperfield", author = "Charles Dickens", category = "fiction", price = 12.99 } - , Book { title = "Moby Dick", author = "Herman Melville", category = "fiction", price = 8.99 } - ] +books1To3Doc = [aesonQQ|[ + { + "title": "David Copperfield", + "author": "Charles Dickens", + "category": "fiction", + "price": 12.99 + }, + { + "title": "Moby Dick", + "author": "Herman Melville", + "category": "fiction", + "price": 8.99 + } + ]|] books1To3And0And1Doc :: JSON.Value -books1To3And0And1Doc = JSON.toJSON $ [ - Book { title = "David Copperfield", author = "Charles Dickens", category = "fiction", price = 12.99 } - , Book { title = "Moby Dick", author = "Herman Melville", category = "fiction", price = 8.99 } - , Book { title = "Guns, Germs, and Steel", author = "Jared Diamond", category = "reference", price = 24.99 } - , Book { title = "David Copperfield", author = "Charles Dickens", category = "fiction", price = 12.99 } - ] +books1To3And0And1Doc = [aesonQQ|[ + { + "title": "David Copperfield", + "author": "Charles Dickens", + "category": "fiction", + "price": 12.99 + }, + { + "title": "Moby Dick", + "author": "Herman Melville", + "category": "fiction", + "price": 8.99 + }, + { + "title": "Guns, Germs, and Steel", + "author": "Jared Diamond", + "category": "reference", + "price": 24.99 + }, + { + "title": "David Copperfield", + "author": "Charles Dickens", + "category": "fiction", + "price": 12.99 + } + ]|] -data AlphaList = AList [Text] - deriving (Show, Generic) -instance JSON.ToJSON AlphaList alphaArr :: JSON.Value -alphaArr = JSON.toJSON $ AList ["a","b","c","d","e","f","g"] +alphaArr = [aesonQQ| ["a","b","c","d","e","f","g"] |] fgArr :: JSON.Value -fgArr = JSON.toJSON $ AList ["f","g"] +fgArr = [aesonQQ| ["f","g"] |] bdArr :: JSON.Value -bdArr = JSON.toJSON $ AList ["b","d"] +bdArr = [aesonQQ| ["b","d"] |] fdArr :: JSON.Value -fdArr = JSON.toJSON $ AList ["f","d"] +fdArr = [aesonQQ| ["f","d"] |] gfedcbaArr :: JSON.Value -gfedcbaArr = JSON.toJSON $ AList ["g","f","e","d","c","b","a"] +gfedcbaArr = [aesonQQ| ["g","f","e","d","c","b","a"] |] +rfcExample1 :: JSON.Value +rfcExample1 = [aesonQQ| { + "o": {"j": 1, "k": 2}, + "a": [5, 3, [{"j": 4}, {"k": 6}]] + } |] + +rfcExample1Desc :: JSON.Value +rfcExample1Desc = [aesonQQ| [ + [5, 3, [{"j": 4}, {"k": 6}]], + {"j": 1, "k": 2}, + 5, + 3, + [{"j": 4}, {"k": 6}], + {"j": 4}, + {"k": 6}, + 4, + 6, + 1, + 2 + ]|] + spec :: Spec spec = do describe "Run JSPQuery on JSON documents" $ do it "returns root document when query is $" $ - runJSPQuery "$" rootDoc `shouldBe` Right rootDoc + runJSPQuery [jsonPath|$|] rootDoc `shouldBe` rootDoc it "returns store object when query is $.store" $ - runJSPQuery "$.store" rootDoc `shouldBe` Right storeDoc + runJSPQuery [jsonPath|$.store|] rootDoc `shouldBe` storeDoc it "returns books array when query is $.store.books" $ - runJSPQuery "$.store.books" rootDoc `shouldBe` Right booksDoc + runJSPQuery [jsonPath|$.store.books|] rootDoc `shouldBe` booksDoc it "returns 0-index book item when query is $.store.books[0]" $ - runJSPQuery "$.store.books[0]" rootDoc `shouldBe` Right books0Doc + runJSPQuery [jsonPath|$.store.books[0]|] rootDoc `shouldBe` books0Doc it "returns 0-index book item when query is $.store.books[-4]" $ - runJSPQuery "$.store.books[-4]" rootDoc `shouldBe` Right books0Doc + runJSPQuery [jsonPath|$.store.books[-4]|] rootDoc `shouldBe` books0Doc it "returns 0,2-index item when query is $.store.books[0,2]" $ - runJSPQuery "$.store.books[0,2]" rootDoc `shouldBe` Right books0And2Doc + runJSPQuery [jsonPath|$.store.books[0,2]|] rootDoc `shouldBe` books0And2Doc it "returns 1To3-index when query is $.store.books[1:3]" $ - runJSPQuery "$.store.books[1:3]" rootDoc `shouldBe` Right books1To3Doc + runJSPQuery [jsonPath|$.store.books[1:3]|] rootDoc `shouldBe` books1To3Doc it "returns 1To3-index and 0,1-index when query is $.store.books[1:3,0,1]" $ - runJSPQuery "$.store.books[1:3,0,1]" rootDoc `shouldBe` Right books1To3And0And1Doc + runJSPQuery [jsonPath|$.store.books[1:3,0,1]|] rootDoc `shouldBe` books1To3And0And1Doc it "returns slice with query $[5:]" $ - runJSPQuery "$[5:]" alphaArr `shouldBe` Right fgArr + runJSPQuery [jsonPath|$[5:]|] alphaArr `shouldBe` fgArr it "returns slice with query $[1:5:2]" $ - runJSPQuery "$[1:5:2]" alphaArr `shouldBe` Right bdArr + runJSPQuery [jsonPath|$[1:5:2]|] alphaArr `shouldBe` bdArr it "returns slice with query $[5:1:-2]" $ - runJSPQuery "$[5:1:-2]" alphaArr `shouldBe` Right fdArr + runJSPQuery [jsonPath|$[5:1:-2]|] alphaArr `shouldBe` fdArr it "returns slice with query $[::-1]" $ - runJSPQuery "$[::-1]" alphaArr `shouldBe` Right gfedcbaArr + runJSPQuery [jsonPath|$[::-1]|] alphaArr `shouldBe` gfedcbaArr + + it "returns root with query $.*" $ + runJSPQuery [jsonPath|$.*|] rootDoc `shouldBe` rootDoc + + it "returns root with query $[*]" $ + runJSPQuery [jsonPath|$[*]|] rootDoc `shouldBe` (toSingletonArray rootDoc) + + it "returns root with query $..*" $ + runJSPQuery [jsonPath|$..*|] rfcExample1 `shouldBe` rfcExample1Desc + + it "returns root with query $..[*]" $ do + pendingWith "fix with wildcard selection" + runJSPQuery [jsonPath|$..[*]|] rfcExample1 `shouldBe` rfcExample1Desc