diff --git a/Data/JsonStream/Parser.hs b/Data/JsonStream/Parser.hs --- a/Data/JsonStream/Parser.hs +++ b/Data/JsonStream/Parser.hs @@ -92,7 +92,7 @@ , objectFound ) where -import Control.Applicative ( Alternative(..), optional ) +import Control.Applicative ( Alternative(..), optional, Applicative (liftA2) ) import qualified Data.Aeson as AE import qualified Data.Aeson.Types as AE import qualified Data.ByteString.Char8 as BS @@ -863,37 +863,30 @@ (Map.Map T.Text [()] -> [f]) -- ^ How to generate results from already parsed fields deriving (Functor) --- We use unsafeCoerce to convert to () and back; we guarantee that there exists only --- one key to the map and so the original Parser will get the right type of value. --- This allows to drop the Typeable constraint, but the code better be OK here. +-- | Helper function for some parser combining operators +joinObjectFieldWith ::([a] -> [b] -> [c]) -> Object a -> Object b -> Object c +joinObjectFieldWith joinFunc (Object amap adata) (Object bmap bdata) = + -- We MUST disallow duplicate field access as we do unsafeCoerce and that could lead to mixing types + let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap + in dmap `seq` Object dmap (\inp -> joinFunc (adata inp) (bdata inp)) instance Applicative Object where pure f = Object mempty (const (pure f)) - (Object amap adata) <*> (Object bmap bdata) = - let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap - in dmap `seq` Object dmap dfunc - where - dfunc dmap = ($) <$> adata dmap <*> bdata dmap + (<*>) = joinObjectFieldWith (liftA2 ($)) instance Alternative Object where empty = Object mempty (const []) - (Object amap adata) <|> (Object bmap bdata) = - let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap - in dmap `seq` Object dmap dfunc + (<|>) = joinObjectFieldWith dfunc where - -- Return second one if first one generates nothing - dfunc dmap = - case adata dmap of - [] -> bdata dmap - lst -> lst + dfunc [] bdata = bdata + dfunc adata _ = adata instance Semigroup (Object a) where - (Object amap adata) <> (Object bmap bdata) = - let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap - in dmap `seq` Object dmap dfunc - where - -- Return second one if first one generates nothing - dfunc dmap = adata dmap <> bdata dmap + (<>) = joinObjectFieldWith (<>) + +-- We use unsafeCoerce to convert to () and back; we guarantee that there exists only +-- one key to the map and so the original Parser will get the right type of value. +-- This allows to drop the Typeable constraint, but the code better be OK here. -- | Similar to 'objectWithKey', generates a field-accessor in JSON object fastObjectWithKey :: forall a. T.Text -> Parser a -> Object a diff --git a/Data/JsonStream/Unescape.hs b/Data/JsonStream/Unescape.hs --- a/Data/JsonStream/Unescape.hs +++ b/Data/JsonStream/Unescape.hs @@ -2,6 +2,9 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiWayIf #-} + {-# OPTIONS_GHC -Wno-unused-imports #-} module Data.JsonStream.Unescape ( diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# 0.4.5.1 + +- fixed testing suite + # 0.4.5.0 - objectOf parser for faster one-pass JSON object parsing diff --git a/json-stream.cabal b/json-stream.cabal --- a/json-stream.cabal +++ b/json-stream.cabal @@ -1,5 +1,5 @@ name: json-stream -version: 0.4.5.0 +version: 0.4.5.1 synopsis: Incremental applicative JSON parser description: Easy to use JSON parser fully supporting incremental parsing. Parsing grammar in applicative form. @@ -77,6 +77,7 @@ , text , aeson , vector + , containers , unordered-containers , hspec , scientific @@ -105,6 +106,7 @@ , text , aeson , vector + , containers , unordered-containers , hspec , scientific diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -119,6 +119,20 @@ msg = parseLazyByteString parser (BL.fromChunks test) :: [Int] msg `shouldBe` [1] + it "objectOf <|> returns first items even if second is in previous chunk" $ do + let test = ["{\"error\":1, ", "\"values\":[2,3,4]}"] + parser = objectOf $ "values" .: arrayOf integer + <|> "error" .: integer + msg = parseLazyByteString parser (BL.fromChunks test) :: [Int] + msg `shouldBe` [2,3,4] + it "objectOf <|> returns second item if first does not match" $ do + let test = ["{\"error\":1, ", "\"values\":[true,null,false]}"] + parser = objectOf $ "values" .: arrayOf integer + <|> ("error" .: integer) + msg = parseLazyByteString parser (BL.fromChunks test) :: [Int] + msg `shouldBe` [1] + + it "arrayFound generates events" $ do let test = ["[[1,2,3],true,[],false,{\"key\":1}]"] parser = arrayOf (arrayFound 10 20 (1 .! integer)) @@ -131,6 +145,12 @@ msg = parseLazyByteString parser (BL.fromChunks test) :: [Int] msg `shouldBe` [10,1,20] + it "objectOf objectFound generates events" $ do + let test = ["[[1,2,3],true,[],false,{\"key\":1}]"] + parser = arrayOf (objectFound 10 20 (objectOf $ "key" .: integer)) + msg = parseLazyByteString parser (BL.fromChunks test) :: [Int] + msg `shouldBe` [10,1,20] + it "Has working byteString parser" $ do let test = ["[\"abcd\\n\\rxyz\"]"] parser = arrayOf byteString :: Parser BS.ByteString @@ -282,6 +302,13 @@ res = parse parser test1 :: [(T.Text, Int)] res `shouldBe` [("test1",1),("test2",-1),("test3",-1),("test4",-1)] + it "objectOf $ binds correctly convenience operators" $ do + let test1 = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}, {\"name\": \"test4\", \"value\": true}]" + parser = arrayOf $ objectOf $ (,) <$> "name" .: string + <*> "value" .: integer .| (-1) + res = parse parser test1 :: [(T.Text, Int)] + res `shouldBe` [("test1",1),("test2",-1),("test3",-1),("test4",-1)] + it "binds correctly convenience operators 2" $ do let test1 = "{\"key\":[{\"key2\":13}]}" parser = "key" .: 0 .! "key2" .: integer @@ -298,6 +325,18 @@ res = parse parser test1 :: [Int] res `shouldBe` [2] + + it "objectOf $ binds correctly .| at the last moment" $ do + let test1 = "{\"key3\":{}}" + parser = objectOf $ "key-none" .: "key2" .: integer .| 2 + res = parse parser test1 :: [Int] + res `shouldBe` [2] + it "objectOf $ binds correct .| 2" $ do + let test1 = "{\"key3\":{\"key2\": null}}" + parser = objectOf $ "key-none" .: "key2" .: integer .| 2 + res = parse parser test1 :: [Int] + res `shouldBe` [2] + it "Parses correctly empty arrays:" $ do let test1 = "[]" parser = arrayOf $ many ("keys" .: arrayOf integer) @@ -308,6 +347,13 @@ let test1 = "[{\"name\":\"x\",\"key\":20}]" onechar = BL.fromChunks $ map BS.singleton $ BS.unpack test1 parser = arrayOf $ "key" .: integer + res = parseLazyByteString parser onechar :: [Int] + res `shouldBe` [20] + + it "objectOf $ Parses correctly runs ignore parser on array:" $ do + let test1 = "[{\"name\":\"x\",\"key\":20}]" + onechar = BL.fromChunks $ map BS.singleton $ BS.unpack test1 + parser = arrayOf $ objectOf $ "key" .: integer res = parseLazyByteString parser onechar :: [Int] res `shouldBe` [20]