diff --git a/Data/JsonStream/CLexer.hs b/Data/JsonStream/CLexer.hs --- a/Data/JsonStream/CLexer.hs +++ b/Data/JsonStream/CLexer.hs @@ -218,9 +218,9 @@ Nothing -> TokFailed | resType == resString -> if | resAddData == -1 || resAddData == 0 -> -- One-part string without escaped characters; with escaped - PartialResult (StringRaw textSection (resAddData == -1)) next + PartialResult (StringRaw textSection (resAddData == -1) (BS.drop 1 context)) next -- (tail - skip the last '"') | otherwise -> PartialResult (StringContent textSection) -- Final part of partial strings - (PartialResult StringEnd next) + (PartialResult (StringEnd (BS.drop 1 context)) next ) -- (tail - skip the last '"') | resType == resStringPartial -> PartialResult (StringContent textSection) next -- string section | otherwise -> error "Unsupported" diff --git a/Data/JsonStream/Parser.hs b/Data/JsonStream/Parser.hs --- a/Data/JsonStream/Parser.hs +++ b/Data/JsonStream/Parser.hs @@ -130,7 +130,6 @@ -- The bytestring is remaining unparsed data, we need to return it somehow | Yield v (ParseResult v) - instance Functor ParseResult where fmap f (MoreData (np, ntok)) = MoreData (fmap f np, ntok) fmap _ (Failed err) = Failed err @@ -324,9 +323,9 @@ nextitem _ _ (ObjectEnd ctx) ntok = Done ctx ntok nextitem yielded _ (JValue (AE.String key)) ntok = objcontent yielded (callParse (valparse key) ntok) - nextitem yielded _ (StringRaw bs True) ntok = + nextitem yielded _ (StringRaw bs True _) ntok = objcontent yielded (callParse (valparse (unsafeDecodeASCII bs)) ntok) - nextitem yielded _ (StringRaw bs False) ntok = + nextitem yielded _ (StringRaw bs False _) ntok = case unescapeText bs of Right t -> objcontent yielded (callParse (valparse t) ntok) Left e -> Failed (show e) @@ -344,7 +343,7 @@ getLongKey acc !len _ el ntok = case el of - StringEnd + StringEnd _ | Right key <- unescapeText (BS.concat $ reverse acc) -> callParse (valparse key) ntok | otherwise -> Failed "Error decoding UTF8" @@ -403,9 +402,9 @@ JValue val -> Yield val (Done "" ntok) JInteger val -> Yield (AE.Number $ fromIntegral val) (Done "" ntok) StringContent _ -> callParse (AE.String <$> longString Nothing) tok - StringRaw bs True -> Yield (AE.String (unsafeDecodeASCII bs)) (Done "" ntok) - StringRaw bs False -> case unescapeText bs of - Right t -> Yield (AE.String t) (Done "" ntok) + StringRaw bs True ctx -> Yield (AE.String (unsafeDecodeASCII bs)) (Done ctx ntok) + StringRaw bs False ctx -> case unescapeText bs of + Right t -> Yield (AE.String t) (Done ctx ntok) Left e -> Failed (show e) ArrayBegin -> AE.Array . Vec.fromList <$> callParse (many (arrayOf aeValue)) tok ObjectBegin -> AE.Object . tomap <$> callParse (manyReverse (objectItems aeValue)) tok @@ -444,12 +443,12 @@ handle acc !len tok el ntok = case el of JValue (AE.String _) -> Failed "INTERNAL ERROR! - got decoded JValue instead of string" - StringRaw bs _ -> Yield bs (Done "" ntok) + StringRaw bs _ ctx -> Yield bs (Done ctx ntok) StringContent str | (Just bounds) <- mbounds, len > bounds -- If the string exceeds bounds, discard it -> callParse (ignoreStrRestThen (Parser $ Done "")) ntok | otherwise -> moreData (handle (acc . (str:)) (len + BS.length str)) ntok - StringEnd -> Yield (BS.concat (acc [])) (Done "" ntok) + StringEnd ctx -> Yield (BS.concat (acc [])) (Done ctx ntok) _ -> callParse ignoreVal tok @@ -472,18 +471,18 @@ handle acc !len tok el ntok = case el of JValue (AE.String str) -> Yield str (Done "" ntok) - StringRaw bs True -> Yield (unsafeDecodeASCII bs) (Done "" ntok) - StringRaw bs False -> + StringRaw bs True ctx -> Yield (unsafeDecodeASCII bs) (Done ctx ntok) + StringRaw bs False ctx -> case unescapeText bs of - Right t -> Yield t (Done "" ntok) + Right t -> Yield t (Done ctx ntok) Left e -> Failed (show e) StringContent str | (Just bounds) <- mbounds, len > bounds -- If the string exceeds bounds, discard it -> callParse (ignoreStrRestThen (Parser $ Done "")) ntok | otherwise -> moreData (handle (acc . (str:)) (len + BS.length str)) ntok - StringEnd + StringEnd ctx | Right val <- unescapeText (BS.concat (acc [])) - -> Yield val (Done "" ntok) + -> Yield val (Done ctx ntok) | otherwise -> Failed "Error decoding UTF8" _ -> callParse ignoreVal tok @@ -600,7 +599,7 @@ handle _ el ntok = case el of StringContent _ -> moreData handle ntok - StringEnd -> callParse next ntok + StringEnd _ -> callParse next ntok _ -> Failed "Unexpected result in ignoreStrRestPlusOne" @@ -612,13 +611,13 @@ ignoreVal' stval = Parser $ moreData (handleTok stval) where handleLongString level _ (StringContent _) ntok = moreData (handleLongString level) ntok - handleLongString 0 _ StringEnd ntok = Done "" ntok - handleLongString level _ StringEnd ntok = moreData (handleTok level) ntok + handleLongString 0 _ (StringEnd ctx) ntok = Done ctx ntok + handleLongString level _ (StringEnd _) ntok = moreData (handleTok level) ntok handleLongString _ _ el _ = Failed $ "Unexpected element in handleLongStr: " ++ show el handleTok :: Int -> TokenResult -> Element -> TokenResult -> ParseResult a handleTok 0 _ (JValue _) ntok = Done "" ntok - handleTok 0 _ (StringRaw _ _) ntok = Done "" ntok + handleTok 0 _ (StringRaw _ _ ctx) ntok = Done ctx ntok handleTok 0 _ (JInteger _) ntok = Done "" ntok handleTok 0 _ (ArrayEnd _) _ = Failed "ArrayEnd in ignoreval on 0 level" handleTok 0 _ (ObjectEnd _) _ = Failed "ObjectEnd in ignoreval on 0 level" @@ -629,12 +628,12 @@ JValue _ -> moreData (handleTok level) ntok JInteger _ -> moreData (handleTok level) ntok StringContent _ -> moreData (handleLongString level) ntok - StringRaw _ _ -> moreData (handleTok level) ntok + StringRaw{} -> moreData (handleTok level) ntok ArrayEnd _ -> moreData (handleTok (level - 1)) ntok ObjectEnd _ -> moreData (handleTok (level - 1)) ntok ArrayBegin -> moreData (handleTok (level + 1)) ntok ObjectBegin -> moreData (handleTok (level + 1)) ntok - StringEnd -> Failed "Internal error - out of order StringEnd" + StringEnd _ -> Failed "Internal error - out of order StringEnd" -- | Let only items matching a condition pass. -- @@ -766,7 +765,16 @@ data ParseOutput a = ParseYield a (ParseOutput a) -- ^ Returns a value from a parser. | ParseNeedData (BS.ByteString -> ParseOutput a) -- ^ Parser needs more data to continue parsing. | ParseFailed String -- ^ Parsing failed, error is reported. - | ParseDone BS.ByteString -- ^ Parsing finished, unparsed data is returned. + | ParseDone BS.ByteString + -- ^ Parsing finished, unparsed data is returned. + -- Remaining data is not returned correctly if the parser parses directly numbers/booleans/nulls; JSON should be an array/object. + + +instance (Show a) => Show (ParseOutput a) where + showsPrec d (ParseYield a next) = showParen True $ showString "ParseYield " . showsPrec d a . showString " " . showsPrec d next + showsPrec _ (ParseNeedData _) = showString "ParseNeedData" + showsPrec d (ParseFailed err) = showParen True $ showString "ParseFailed " . showsPrec d err + showsPrec d (ParseDone rest) = showParen True $ showString "ParseDone " . showsPrec d rest -- | Run streaming parser with initial input. runParser' :: Parser a -> BS.ByteString -> ParseOutput a diff --git a/Data/JsonStream/TokenParser.hs b/Data/JsonStream/TokenParser.hs --- a/Data/JsonStream/TokenParser.hs +++ b/Data/JsonStream/TokenParser.hs @@ -11,12 +11,12 @@ data Element = ArrayBegin - | ArrayEnd !BS.ByteString + | ArrayEnd !BS.ByteString -- Rest of the source string for correct (ParseDone ) | ObjectBegin - | ObjectEnd !BS.ByteString + | ObjectEnd !BS.ByteString -- Rest of the source string for correct (ParseDone ) | StringContent !BS.ByteString - | StringRaw !BS.ByteString !Bool -- Allow raw strings to go into parser as bytestring/ isAscii - | StringEnd + | StringRaw !BS.ByteString !Bool !BS.ByteString -- Allow raw strings to go into parser as bytestring/ isAscii + | StringEnd !BS.ByteString | JValue !AE.Value | JInteger !CLong deriving (Show, Eq) @@ -32,4 +32,4 @@ instance Show TokenResult where show (TokMoreData _) = "TokMoreData" show TokFailed = "TokFailed" - show (PartialResult el _) = "(PartialResult' " ++ show el ++ ")" + show (PartialResult el next) = "(PartialResult (" ++ show el ++ ") " ++ show next ++ ")" diff --git a/c_lib/lexer.c b/c_lib/lexer.c --- a/c_lib/lexer.c +++ b/c_lib/lexer.c @@ -208,7 +208,7 @@ else if (hasspecialchar) res->adddata = 0; // Indicate that the string contains escaped/UTF-8 characters else - res->adddata = -1; // Indicate that the stirng is clean ASCII (optimization) + res->adddata = -1; // Indicate that the string is clean ASCII (optimization) lexer->result_num++; lexer->current_state = STATE_BASE; diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +# 0.4.6.0 + +- Show instance for ParseOutput +- Correctly return remaining data for direct String parser (doesn't return correct data for direct Number/Bool/Null parser) + # 0.4.5.3 - lifted upper bounds on aeson 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.3 +version: 0.4.6.0 synopsis: Incremental applicative JSON parser description: Easy to use JSON parser fully supporting incremental parsing. Parsing grammar in applicative form. @@ -64,13 +64,15 @@ Type: exitcode-stdio-1.0 Default-Language: Haskell2010 HS-Source-Dirs: test, . - Ghc-Options: -threaded -Wall Main-Is: doctests.hs - other-modules: Data.JsonStream.CLexType + other-modules: Data.JsonStream.CLexType + , Data.JsonStream.Unescape + , Data.JsonStream.CLexer + , Data.JsonStream.Parser + , Data.JsonStream.TokenParser c-sources: c_lib/lexer.c, c_lib/unescape_string.c includes: c_lib/lexer.h include-dirs: c_lib - cc-options: -fPIC Build-Depends: base >= 4.11 && <5 , doctest >= 0.9.3 , bytestring @@ -84,6 +86,7 @@ , directory , QuickCheck , quickcheck-unicode + , primitive test-suite spec main-is: Spec.hs diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -44,7 +44,16 @@ loop (ParseFailed err) = error err loop (ParseYield _ np) = loop np +testRemainingChunks :: Parser a -> [BS.ByteString] -> BS.ByteString +testRemainingChunks parser = loop (runParser parser) + where + loop (ParseNeedData _) [] = error "Not enough data." + loop (ParseNeedData f) (x:rest) = loop (f x) rest + loop (ParseDone rem1) chunks = rem1 <> BS.concat chunks + loop (ParseFailed err) _ = error err + loop (ParseYield _ np) chunks = loop np chunks + specBase :: Spec specBase = describe "Basic parsing" $ do it "Parses null values" $ do @@ -213,6 +222,14 @@ let msg1 = "[{\"123\":[1,2,[3,4]]},11] \"aa\"" rem1 = testRemaining (pure "x" :: Parser String) msg1 rem1 `shouldBe` " \"aa\"" + it "Correctly returns unparsed data 5" $ do + let msg1 = "\"bb\"\"aa\"" + rem1 = testRemaining (pure "x" :: Parser String) msg1 + rem1 `shouldBe` "\"aa\"" + it "Correctly returns unparsed data 6" $ do + let msg1 = ["\"bb", "\"\"aa\""] + rem1 = testRemainingChunks (pure "x" :: Parser String) msg1 + rem1 `shouldBe` "\"aa\"" it "Handles values in interleaving order" $ do let msg1 = BL.fromChunks ["{\"err\":true,\"values\":[1,2,3", "4,5,6,7]}"]