From 38f5c2c58eacef7c44eb614205b87e62d378cb0d Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Sun, 6 Oct 2024 18:08:06 +0530 Subject: [PATCH] Track the absolute position in the drivers of Parser --- benchmark/Streamly/Benchmark/Data/Parser.hs | 2 +- benchmark/Streamly/Benchmark/Data/ParserK.hs | 2 +- .../Streamly/Benchmark/Unicode/Parser.hs | 2 +- core/src/Streamly/Internal/Data/Array.hs | 48 ++-- .../Streamly/Internal/Data/Array/Stream.hs | 22 +- .../src/Streamly/Internal/Data/Parser/Type.hs | 5 +- .../Streamly/Internal/Data/Producer/Source.hs | 56 ++-- .../Internal/Data/Stream/Eliminate.hs | 76 +++--- .../Streamly/Internal/Data/Stream/Nesting.hs | 250 +++++++++--------- core/src/Streamly/Internal/Data/StreamK.hs | 48 ++-- test/Streamly/Test/Data/Parser.hs | 29 +- test/Streamly/Test/Unicode/Parser.hs | 10 +- 12 files changed, 277 insertions(+), 273 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Parser.hs b/benchmark/Streamly/Benchmark/Data/Parser.hs index f4ed6da2a5..a20a8a07d7 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser.hs @@ -709,7 +709,7 @@ moduleName = "Data.Parser" instance NFData ParseError where {-# INLINE rnf #-} - rnf (ParseError x) = rnf x + rnf (ParseError i x) = rnf i `seq` rnf x o_1_space_serial :: Int -> [Benchmark] o_1_space_serial value = diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index cc44c7c75e..be4bb6c40d 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -370,7 +370,7 @@ moduleName = MODULE_NAME instance NFData ParseError where {-# INLINE rnf #-} - rnf (ParseError x) = rnf x + rnf (ParseError i x) = rnf i `seq` rnf x o_1_space_serial :: Int -> [Benchmark] o_1_space_serial value = diff --git a/benchmark/Streamly/Benchmark/Unicode/Parser.hs b/benchmark/Streamly/Benchmark/Unicode/Parser.hs index 88c7db94b9..9283df1507 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Parser.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Parser.hs @@ -72,7 +72,7 @@ moduleName = "Unicode.Parser" instance NFData ParseError where {-# INLINE rnf #-} - rnf (ParseError x) = rnf x + rnf (ParseError i x) = rnf i `seq` rnf x o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 3fcf7225c7..f7e052b345 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -907,9 +907,9 @@ parseBreakChunksK :: parseBreakChunksK (Parser pstep initial extract) stream = do res <- initial case res of - IPartial s -> go s stream [] + IPartial s -> go s stream [] 0 IDone b -> return (Right b, stream) - IError err -> return (Left (ParseError err), stream) + IError err -> return (Left (ParseError 0 err), stream) where @@ -919,37 +919,37 @@ parseBreakChunksK (Parser pstep initial extract) stream = do -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - go !pst st backBuf = do - let stop = goStop pst backBuf -- (, K.nil) <$> extract pst + go !pst st backBuf i = do + let stop = goStop pst backBuf i -- (, K.nil) <$> extract pst single a = yieldk a StreamK.nil - yieldk arr r = goArray pst backBuf r arr + yieldk arr r = goArray pst backBuf r arr i in StreamK.foldStream defState yieldk single stop st -- Use strictness on "cur" to keep it unboxed - goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf - goArray !pst backBuf st (Array contents cur end) = do + goArray !pst backBuf st (Array _ cur end) i | cur == end = go pst st backBuf i + goArray !pst backBuf st (Array contents cur end) i = do x <- liftIO $ peekAt cur contents pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of Parser.Partial 0 s -> - goArray s [] st (Array contents next end) + goArray s [] st (Array contents next end) (i + 1) Parser.Partial n s -> do assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 - goArray s [] st src + goArray s [] st src (i + 1 - n) Parser.Continue 0 s -> - goArray s (x:backBuf) st (Array contents next end) + goArray s (x:backBuf) st (Array contents next end) (i + 1) Parser.Continue n s -> do assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 - goArray s buf1 st src + goArray s buf1 st src (i + 1 - n) Parser.Done 0 b -> do let arr = Array contents next end return (Right b, StreamK.cons arr st) @@ -967,34 +967,34 @@ parseBreakChunksK (Parser pstep initial extract) stream = do arr0 = fromListN n (Prelude.reverse backBuf) arr1 = Array contents cur end str = StreamK.cons arr0 (StreamK.cons arr1 st) - return (Left (ParseError err), str) + return (Left (ParseError (i + 1) err), str) -- This is a simplified goArray - goExtract !pst backBuf (Array _ cur end) - | cur == end = goStop pst backBuf - goExtract !pst backBuf (Array contents cur end) = do + goExtract !pst backBuf (Array _ cur end) i + | cur == end = goStop pst backBuf i + goExtract !pst backBuf (Array contents cur end) i = do x <- liftIO $ peekAt cur contents pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of Parser.Partial 0 s -> - goExtract s [] (Array contents next end) + goExtract s [] (Array contents next end) (i + 1) Parser.Partial n s -> do assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 - goExtract s [] src + goExtract s [] src (i + 1 - n) Parser.Continue 0 s -> - goExtract s backBuf (Array contents next end) + goExtract s backBuf (Array contents next end) (i + 1) Parser.Continue n s -> do assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 - goExtract s buf1 src + goExtract s buf1 src (i + 1 - n) Parser.Done 0 b -> do let arr = Array contents next end return (Right b, StreamK.fromPure arr) @@ -1012,21 +1012,21 @@ parseBreakChunksK (Parser pstep initial extract) stream = do arr0 = fromListN n (Prelude.reverse backBuf) arr1 = Array contents cur end str = StreamK.cons arr0 (StreamK.fromPure arr1) - return (Left (ParseError err), str) + return (Left (ParseError (i + 1) err), str) -- This is a simplified goExtract {-# INLINE goStop #-} - goStop !pst backBuf = do + goStop !pst backBuf i = do pRes <- extract pst case pRes of Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract" Parser.Continue 0 s -> - goStop s backBuf + goStop s backBuf i Parser.Continue n s -> do assert (n <= Prelude.length backBuf) (return ()) let (src0, buf1) = Prelude.splitAt n backBuf arr = fromListN n (Prelude.reverse src0) - goExtract s buf1 arr + goExtract s buf1 arr (i - n) Parser.Done 0 b -> return (Right b, StreamK.nil) Parser.Done n b -> do @@ -1039,4 +1039,4 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.Error err -> do let n = Prelude.length backBuf arr0 = fromListN n (Prelude.reverse backBuf) - return (Left (ParseError err), StreamK.fromPure arr0) + return (Left (ParseError i err), StreamK.fromPure arr0) diff --git a/core/src/Streamly/Internal/Data/Array/Stream.hs b/core/src/Streamly/Internal/Data/Array/Stream.hs index 6d22f61915..552897d6d8 100644 --- a/core/src/Streamly/Internal/Data/Array/Stream.hs +++ b/core/src/Streamly/Internal/Data/Array/Stream.hs @@ -321,7 +321,7 @@ runArrayParserDBreak case res of PRD.IPartial s -> go SPEC state (List []) s PRD.IDone b -> return (Right b, stream) - PRD.IError err -> return (Left (ParseError err), stream) + PRD.IError err -> return (Left (ParseError (-1) err), stream) where @@ -374,7 +374,7 @@ runArrayParserDBreak let src0 = x:getList backBuf src = Prelude.reverse src0 ++ x:xs strm = D.append (D.fromList src) (D.Stream step s) - return (Left (ParseError err), strm) + return (Left (ParseError (-1) err), strm) -- This is a simplified gobuf goExtract _ [] backBuf !pst = goStop backBuf pst @@ -411,7 +411,7 @@ runArrayParserDBreak PR.Error err -> do let src0 = getList backBuf src = Prelude.reverse src0 ++ x:xs - return (Left (ParseError err), D.fromList src) + return (Left (ParseError (-1) err), D.fromList src) -- This is a simplified goExtract {-# INLINE goStop #-} @@ -439,7 +439,7 @@ runArrayParserDBreak PR.Error err -> do let src0 = getList backBuf src = Prelude.reverse src0 - return (Left (ParseError err), D.fromList src) + return (Left (ParseError (-1) err), D.fromList src) {- -- | Parse an array stream using the supplied 'Parser'. Returns the parse @@ -517,7 +517,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next D.Skip s -> return $ D.Skip $ ParseChunksInit [] s D.Stop -> return D.Stop @@ -534,7 +534,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- This is a simplified ParseChunksInit stepOuter _ (ParseChunksInitBuf src) = do @@ -549,7 +549,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- XXX we just discard any leftover input at the end stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop @@ -596,7 +596,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst @@ -638,7 +638,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- This is a simplified ParseChunksBuf stepOuter _ (ParseChunksExtract [] buf pst) = @@ -676,7 +676,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- This is a simplified ParseChunksExtract @@ -706,7 +706,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 8a9e56a518..8fbf9b872c 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -455,11 +455,12 @@ data Fold m a b = -- -- /Pre-release/ -- -newtype ParseError = ParseError String +data ParseError = ParseError Int String deriving (Eq, Show) instance Exception ParseError where - displayException (ParseError err) = err + -- XXX Append the index in the error message here? + displayException (ParseError _ err) = err -- | Map a function on the result i.e. on @b@ in @Parser a m b@. instance Functor m => Functor (Parser a m) where diff --git a/core/src/Streamly/Internal/Data/Producer/Source.hs b/core/src/Streamly/Internal/Data/Producer/Source.hs index 62e7a8bfb2..052dc494fb 100644 --- a/core/src/Streamly/Internal/Data/Producer/Source.hs +++ b/core/src/Streamly/Internal/Data/Producer/Source.hs @@ -125,33 +125,33 @@ parse case res of ParserD.IPartial s -> do state <- uinject seed - go SPEC state (List []) s + go SPEC state (List []) s 0 ParserD.IDone b -> return (Right b, seed) - ParserD.IError err -> return (Left (ParseError err), seed) + ParserD.IError err -> return (Left (ParseError 0 err), seed) where -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - go !_ st buf !pst = do + go !_ st buf !pst i = do r <- ustep st case r of Yield x s -> do pRes <- pstep pst x case pRes of - Partial 0 pst1 -> go SPEC s (List []) pst1 + Partial 0 pst1 -> go SPEC s (List []) pst1 i Partial n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 - gobuf SPEC s (List []) (List src) pst1 - Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) + Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 (i + 1) Continue n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 - gobuf SPEC s (List buf1) (List src) pst1 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -162,30 +162,30 @@ parse s1 <- uextract s let src = Prelude.reverse (getList buf) return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , unread (src ++ [x]) s1 ) - Skip s -> go SPEC s buf pst - Stop -> goStop buf pst + Skip s -> go SPEC s buf pst i + Stop -> goStop buf pst i - gobuf !_ s buf (List []) !pst = go SPEC s buf pst - gobuf !_ s buf (List (x:xs)) !pst = do + gobuf !_ s buf (List []) !pst i = go SPEC s buf pst i + gobuf !_ s buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of Partial 0 pst1 -> - gobuf SPEC s (List []) (List xs) pst1 + gobuf SPEC s (List []) (List xs) pst1 (i + 1) Partial n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs - gobuf SPEC s (List []) (List src) pst1 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) Continue 0 pst1 -> - gobuf SPEC s (List (x:getList buf)) (List xs) pst1 + gobuf SPEC s (List (x:getList buf)) (List xs) pst1 (i + 1) Continue n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs - gobuf SPEC s (List buf1) (List src) pst1 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -196,29 +196,29 @@ parse s1 <- uextract s let src = Prelude.reverse (getList buf) return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , unread (src ++ (x:xs)) s1 ) -- This is a simplified gobuf - goExtract !_ buf (List []) !pst = goStop buf pst - goExtract !_ buf (List (x:xs)) !pst = do + goExtract !_ buf (List []) !pst i = goStop buf pst i + goExtract !_ buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of Partial 0 pst1 -> - goExtract SPEC (List []) (List xs) pst1 + goExtract SPEC (List []) (List xs) pst1 (i + 1) Partial n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs - goExtract SPEC (List []) (List src) pst1 + goExtract SPEC (List []) (List src) pst1 (i + 1 - n) Continue 0 pst1 -> - goExtract SPEC (List (x:getList buf)) (List xs) pst1 + goExtract SPEC (List (x:getList buf)) (List xs) pst1 (i + 1) Continue n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs - goExtract SPEC (List buf1) (List src) pst1 + goExtract SPEC (List buf1) (List src) pst1 (i + 1 - n) Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -227,23 +227,23 @@ parse Error err -> do let src = Prelude.reverse (getList buf) return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , unread (src ++ (x:xs)) (source Nothing) ) -- This is a simplified goExtract {-# INLINE goStop #-} - goStop buf pst = do + goStop buf pst i = do pRes <- extract pst case pRes of Partial _ _ -> error "Bug: parseD: Partial in extract" Continue 0 pst1 -> - goStop buf pst1 + goStop buf pst1 i Continue n pst1 -> do assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 - goExtract SPEC (List buf1) (List src) pst1 + goExtract SPEC (List buf1) (List src) pst1 (i - n) Done 0 b -> return (Right b, source Nothing) Done n b -> do assert (n <= length (getList buf)) (return ()) @@ -252,7 +252,7 @@ parse return (Right b, unread src (source Nothing)) Error err -> do let src = Prelude.reverse (getList buf) - return (Left (ParseError err), unread src (source Nothing)) + return (Left (ParseError i err), unread src (source Nothing)) {- -- | Parse a buffered source using a parser, returning the parsed value and the diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index 95bc957a02..2c0c528f8a 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -176,9 +176,9 @@ parseBreakD parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do res <- initial case res of - PRD.IPartial s -> go SPEC state (List []) s + PRD.IPartial s -> go SPEC state (List []) s 0 PRD.IDone b -> return (Right b, stream) - PRD.IError err -> return (Left (ParseError err), stream) + PRD.IError err -> return (Left (ParseError 0 err), stream) where @@ -188,26 +188,26 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - go !_ st buf !pst = do + go !_ st buf !pst i = do r <- step defState st case r of Yield x s -> do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> go SPEC s (List []) pst1 - PR.Partial 1 pst1 -> go1 SPEC s x pst1 + PR.Partial 0 pst1 -> go SPEC s (List []) pst1 (i + 1) + PR.Partial 1 pst1 -> go1 SPEC s x pst1 i PR.Partial n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 - gobuf SPEC s (List []) (List src) pst1 - PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 - PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) + PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 (i + 1) + PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1 i PR.Continue n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 - gobuf SPEC s (List buf1) (List src) pst1 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) PR.Done 0 b -> return (Right b, Stream step s) PR.Done n b -> do assert (n <= length (x:getList buf)) (return ()) @@ -221,26 +221,26 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do PR.Error err -> do let src = Prelude.reverse $ x:getList buf return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , Nesting.append (fromList src) (Stream step s) ) - Skip s -> go SPEC s buf pst - Stop -> goStop SPEC buf pst + Skip s -> go SPEC s buf pst i + Stop -> goStop SPEC buf pst i - go1 _ s x !pst = do + go1 _ s x !pst i = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - go SPEC s (List []) pst1 + go SPEC s (List []) pst1 (i + 1) PR.Partial 1 pst1 -> do - go1 SPEC s x pst1 + go1 SPEC s x pst1 i PR.Partial n _ -> error $ "parseBreak: parser bug, go1: Partial n = " ++ show n PR.Continue 0 pst1 -> - go SPEC s (List [x]) pst1 + go SPEC s (List [x]) pst1 (i + 1) PR.Continue 1 pst1 -> - go1 SPEC s x pst1 + go1 SPEC s x pst1 i PR.Continue n _ -> do error $ "parseBreak: parser bug, go1: Continue n = " ++ show n PR.Done 0 b -> do @@ -251,30 +251,30 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do error $ "parseBreak: parser bug, go1: Done n = " ++ show n PR.Error err -> return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , Nesting.append (fromPure x) (Stream step s) ) - gobuf !_ s buf (List []) !pst = go SPEC s buf pst - gobuf !_ s buf (List (x:xs)) !pst = do + gobuf !_ s buf (List []) !pst i = go SPEC s buf pst i + gobuf !_ s buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - gobuf SPEC s (List []) (List xs) pst1 + gobuf SPEC s (List []) (List xs) pst1 (i + 1) PR.Partial n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs - gobuf SPEC s (List []) (List src) pst1 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) PR.Continue 0 pst1 -> - gobuf SPEC s (List (x:getList buf)) (List xs) pst1 + gobuf SPEC s (List (x:getList buf)) (List xs) pst1 (i + 1) PR.Continue 1 pst1 -> - gobuf SPEC s buf (List (x:xs)) pst1 + gobuf SPEC s buf (List (x:xs)) pst1 i PR.Continue n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs - gobuf SPEC s (List buf1) (List src) pst1 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) PR.Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -283,31 +283,31 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do PR.Error err -> do let src = Prelude.reverse (getList buf) ++ x:xs return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , Nesting.append (fromList src) (Stream step s) ) -- This is simplified gobuf - goExtract !_ buf (List []) !pst = goStop SPEC buf pst - goExtract !_ buf (List (x:xs)) !pst = do + goExtract !_ buf (List []) !pst i = goStop SPEC buf pst i + goExtract !_ buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - goExtract SPEC (List []) (List xs) pst1 + goExtract SPEC (List []) (List xs) pst1 (i + 1) PR.Partial n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs - goExtract SPEC (List []) (List src) pst1 + goExtract SPEC (List []) (List src) pst1 (i + 1 - n) PR.Continue 0 pst1 -> - goExtract SPEC (List (x:getList buf)) (List xs) pst1 + goExtract SPEC (List (x:getList buf)) (List xs) pst1 (i + 1) PR.Continue 1 pst1 -> - goExtract SPEC buf (List (x:xs)) pst1 + goExtract SPEC buf (List (x:xs)) pst1 i PR.Continue n pst1 -> do assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs - goExtract SPEC (List buf1) (List src) pst1 + goExtract SPEC (List buf1) (List src) pst1 (i + 1 - n) PR.Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -315,21 +315,21 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do return (Right b, fromList src) PR.Error err -> do let src = Prelude.reverse (getList buf) ++ x:xs - return (Left (ParseError err), fromList src) + return (Left (ParseError (i + 1) err), fromList src) -- This is simplified goExtract -- XXX Use SPEC? {-# INLINE goStop #-} - goStop _ buf pst = do + goStop _ buf pst i = do pRes <- extract pst case pRes of PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract" - PR.Continue 0 pst1 -> goStop SPEC buf pst1 + PR.Continue 0 pst1 -> goStop SPEC buf pst1 i PR.Continue n pst1 -> do assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 - goExtract SPEC (List buf1) (List src) pst1 + goExtract SPEC (List buf1) (List src) pst1 (i - n) PR.Done 0 b -> return (Right b, StreamD.nil) PR.Done n b -> do assert (n <= length (getList buf)) (return ()) @@ -338,7 +338,7 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do return (Right b, fromList src) PR.Error err -> do let src = Prelude.reverse $ getList buf - return (Left (ParseError err), fromList src) + return (Left (ParseError i err), fromList src) -- | Parse a stream using the supplied 'Parser'. -- diff --git a/core/src/Streamly/Internal/Data/Stream/Nesting.hs b/core/src/Streamly/Internal/Data/Stream/Nesting.hs index 5516d09106..56a312b30e 100644 --- a/core/src/Streamly/Internal/Data/Stream/Nesting.hs +++ b/core/src/Streamly/Internal/Data/Stream/Nesting.hs @@ -1554,13 +1554,13 @@ foldIterateM func seed0 (Stream step state) = {-# ANN type ParseChunksState Fuse #-} data ParseChunksState x inpBuf st pst = - ParseChunksInit inpBuf st - | ParseChunksInitBuf inpBuf - | ParseChunksInitLeftOver inpBuf - | ParseChunksStream st inpBuf !pst - | ParseChunksStop inpBuf !pst - | ParseChunksBuf inpBuf st inpBuf !pst - | ParseChunksExtract inpBuf inpBuf !pst + ParseChunksInit Int inpBuf st + | ParseChunksInitBuf Int inpBuf + | ParseChunksInitLeftOver Int inpBuf + | ParseChunksStream Int st inpBuf !pst + | ParseChunksStop Int inpBuf !pst + | ParseChunksBuf Int inpBuf st inpBuf !pst + | ParseChunksExtract Int inpBuf inpBuf !pst | ParseChunksYield x (ParseChunksState x inpBuf st pst) -- XXX return the remaining stream as part of the error. @@ -1588,208 +1588,208 @@ parseMany -> Stream m a -> Stream m (Either ParseError b) parseMany (PRD.Parser pstep initial extract) (Stream step state) = - Stream stepOuter (ParseChunksInit [] state) + Stream stepOuter (ParseChunksInit 0 [] state) where {-# INLINE_LATE stepOuter #-} -- Buffer is empty, get the first element from the stream, initialize the -- fold and then go to stream processing loop. - stepOuter gst (ParseChunksInit [] st) = do + stepOuter gst (ParseChunksInit i [] st) = do r <- step (adaptState gst) st case r of Yield x s -> do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ParseChunksBuf [x] s [] ps + return $ Skip $ ParseChunksBuf i [x] s [] ps PRD.IDone pb -> - let next = ParseChunksInit [x] s + let next = ParseChunksInit i [x] s in return $ Skip $ ParseChunksYield (Right pb) next PRD.IError err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) - Skip s -> return $ Skip $ ParseChunksInit [] s + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) + Skip s -> return $ Skip $ ParseChunksInit i [] s Stop -> return Stop -- Buffer is not empty, go to buffered processing loop - stepOuter _ (ParseChunksInit src st) = do + stepOuter _ (ParseChunksInit i src st) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ParseChunksBuf src st [] ps + return $ Skip $ ParseChunksBuf i src st [] ps PRD.IDone pb -> - let next = ParseChunksInit src st + let next = ParseChunksInit i src st in return $ Skip $ ParseChunksYield (Right pb) next PRD.IError err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) -- This is simplified ParseChunksInit - stepOuter _ (ParseChunksInitBuf src) = do + stepOuter _ (ParseChunksInitBuf i src) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ParseChunksExtract src [] ps + return $ Skip $ ParseChunksExtract i src [] ps PRD.IDone pb -> - let next = ParseChunksInitBuf src + let next = ParseChunksInitBuf i src in return $ Skip $ ParseChunksYield (Right pb) next PRD.IError err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) -- XXX we just discard any leftover input at the end - stepOuter _ (ParseChunksInitLeftOver _) = return Stop + stepOuter _ (ParseChunksInitLeftOver _ _) = return Stop -- Buffer is empty, process elements from the stream - stepOuter gst (ParseChunksStream st buf pst) = do + stepOuter gst (ParseChunksStream i st buf pst) = do r <- step (adaptState gst) st case r of Yield x s -> do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ParseChunksStream s [] pst1 + return $ Skip $ ParseChunksStream (i + 1) s [] pst1 PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 - return $ Skip $ ParseChunksBuf src s [] pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s [] pst1 PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksStream s (x:buf) pst1 + return $ Skip $ ParseChunksStream (i + 1) s (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 - return $ Skip $ ParseChunksBuf src s buf1 pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s buf1 pst1 PR.Done 0 b -> do return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInit [] s) + ParseChunksYield (Right b) (ParseChunksInit (i + 1) [] s) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInit src s) + ParseChunksYield (Right b) (ParseChunksInit (i + 1 - n) src s) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) - Skip s -> return $ Skip $ ParseChunksStream s buf pst - Stop -> return $ Skip $ ParseChunksStop buf pst + (Left (ParseError (i + 1) err)) + (ParseChunksInitLeftOver (i + 1) []) + Skip s -> return $ Skip $ ParseChunksStream i s buf pst + Stop -> return $ Skip $ ParseChunksStop i buf pst -- go back to stream processing mode - stepOuter _ (ParseChunksBuf [] s buf pst) = - return $ Skip $ ParseChunksStream s buf pst + stepOuter _ (ParseChunksBuf i [] s buf pst) = + return $ Skip $ ParseChunksStream i s buf pst -- buffered processing loop - stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do + stepOuter _ (ParseChunksBuf i (x:xs) s buf pst) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ParseChunksBuf xs s [] pst1 + return $ Skip $ ParseChunksBuf (i + 1) xs s [] pst1 PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksBuf src s [] pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s [] pst1 PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksBuf xs s (x:buf) pst1 + return $ Skip $ ParseChunksBuf (i + 1) xs s (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksBuf src s buf1 pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s buf1 pst1 PR.Done 0 b -> return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInit xs s) + $ ParseChunksYield (Right b) (ParseChunksInit (i + 1) xs s) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInit src s) + $ ParseChunksYield (Right b) (ParseChunksInit (i + 1 - n) src s) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ParseChunksInitLeftOver (i + 1) []) -- This is simplified ParseChunksBuf - stepOuter _ (ParseChunksExtract [] buf pst) = - return $ Skip $ ParseChunksStop buf pst + stepOuter _ (ParseChunksExtract i [] buf pst) = + return $ Skip $ ParseChunksStop i buf pst - stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do + stepOuter _ (ParseChunksExtract i (x:xs) buf pst) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ParseChunksExtract xs [] pst1 + return $ Skip $ ParseChunksExtract (i + 1) xs [] pst1 PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksExtract src [] pst1 + return $ Skip $ ParseChunksExtract (i + 1 - n) src [] pst1 PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksExtract xs (x:buf) pst1 + return $ Skip $ ParseChunksExtract (i + 1) xs (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksExtract src buf1 pst1 + return $ Skip $ ParseChunksExtract (i + 1 - n) src buf1 pst1 PR.Done 0 b -> return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInitBuf xs) + $ ParseChunksYield (Right b) (ParseChunksInitBuf (i + 1) xs) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInitBuf src) + $ ParseChunksYield (Right b) (ParseChunksInitBuf (i + 1 - n) src) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ParseChunksInitLeftOver (i + 1) []) -- This is simplified ParseChunksExtract - stepOuter _ (ParseChunksStop buf pst) = do + stepOuter _ (ParseChunksStop i buf pst) = do pRes <- extract pst case pRes of PR.Partial _ _ -> error "Bug: parseMany: Partial in extract" PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksStop buf pst1 + return $ Skip $ ParseChunksStop i buf pst1 PR.Continue n pst1 -> do assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 - return $ Skip $ ParseChunksExtract src buf1 pst1 + return $ Skip $ ParseChunksExtract (i - n) src buf1 pst1 PR.Done 0 b -> do return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInitLeftOver []) + ParseChunksYield (Right b) (ParseChunksInitLeftOver i []) PR.Done n b -> do assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInitBuf src) + ParseChunksYield (Right b) (ParseChunksInitBuf (i - n) src) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) stepOuter _ (ParseChunksYield a next) = return $ Yield a next @@ -1836,16 +1836,16 @@ parseManyTill = undefined {-# ANN type ConcatParseState Fuse #-} data ConcatParseState c b inpBuf st p m a = - ConcatParseInit inpBuf st p - | ConcatParseInitBuf inpBuf p - | ConcatParseInitLeftOver inpBuf - | forall s. ConcatParseStop + ConcatParseInit Int inpBuf st p + | ConcatParseInitBuf Int inpBuf p + | ConcatParseInitLeftOver Int inpBuf + | forall s. ConcatParseStop Int inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) - | forall s. ConcatParseStream + | forall s. ConcatParseStream Int st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) - | forall s. ConcatParseBuf + | forall s. ConcatParseBuf Int inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) - | forall s. ConcatParseExtract + | forall s. ConcatParseExtract Int inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) | ConcatParseYield c (ConcatParseState c b inpBuf st p m a) @@ -1873,194 +1873,194 @@ parseIterate -> Stream m a -> Stream m (Either ParseError b) parseIterate func seed (Stream step state) = - Stream stepOuter (ConcatParseInit [] state (func seed)) + Stream stepOuter (ConcatParseInit 0 [] state (func seed)) where {-# INLINE_LATE stepOuter #-} -- Buffer is empty, go to stream processing loop - stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do + stepOuter _ (ConcatParseInit i [] st (PRD.Parser pstep initial extract)) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ConcatParseStream st [] pstep ps extract + return $ Skip $ ConcatParseStream i st [] pstep ps extract PRD.IDone pb -> - let next = ConcatParseInit [] st (func pb) + let next = ConcatParseInit i [] st (func pb) in return $ Skip $ ConcatParseYield (Right pb) next PRD.IError err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) -- Buffer is not empty, go to buffered processing loop - stepOuter _ (ConcatParseInit src st + stepOuter _ (ConcatParseInit i src st (PRD.Parser pstep initial extract)) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ConcatParseBuf src st [] pstep ps extract + return $ Skip $ ConcatParseBuf i src st [] pstep ps extract PRD.IDone pb -> - let next = ConcatParseInit src st (func pb) + let next = ConcatParseInit i src st (func pb) in return $ Skip $ ConcatParseYield (Right pb) next PRD.IError err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) -- This is simplified ConcatParseInit - stepOuter _ (ConcatParseInitBuf src + stepOuter _ (ConcatParseInitBuf i src (PRD.Parser pstep initial extract)) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ConcatParseExtract src [] pstep ps extract + return $ Skip $ ConcatParseExtract i src [] pstep ps extract PRD.IDone pb -> - let next = ConcatParseInitBuf src (func pb) + let next = ConcatParseInitBuf i src (func pb) in return $ Skip $ ConcatParseYield (Right pb) next PRD.IError err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) -- XXX we just discard any leftover input at the end - stepOuter _ (ConcatParseInitLeftOver _) = return Stop + stepOuter _ (ConcatParseInitLeftOver _ _) = return Stop -- Buffer is empty process elements from the stream - stepOuter gst (ConcatParseStream st buf pstep pst extract) = do + stepOuter gst (ConcatParseStream i st buf pstep pst extract) = do r <- step (adaptState gst) st case r of Yield x s -> do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ConcatParseStream s [] pstep pst1 extract + return $ Skip $ ConcatParseStream (i + 1) s [] pstep pst1 extract PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 - return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract + return $ Skip $ ConcatParseBuf (i + 1 - n) src s [] pstep pst1 extract -- PR.Continue 0 pst1 -> -- return $ Skip $ ConcatParseStream s (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 - return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract + return $ Skip $ ConcatParseBuf (i + 1 - n) src s buf1 pstep pst1 extract -- XXX Specialize for Stop 0 common case? PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) return $ Skip $ - ConcatParseYield (Right b) (ConcatParseInit src s (func b)) + ConcatParseYield (Right b) (ConcatParseInit (i + 1 - n) src s (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) - Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract - Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract + (Left (ParseError (i + 1) err)) + (ConcatParseInitLeftOver (i + 1) []) + Skip s -> return $ Skip $ ConcatParseStream i s buf pstep pst extract + Stop -> return $ Skip $ ConcatParseStop i buf pstep pst extract -- go back to stream processing mode - stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) = - return $ Skip $ ConcatParseStream s buf pstep ps extract + stepOuter _ (ConcatParseBuf i [] s buf pstep ps extract) = + return $ Skip $ ConcatParseStream i s buf pstep ps extract -- buffered processing loop - stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do + stepOuter _ (ConcatParseBuf i (x:xs) s buf pstep pst extract) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract + return $ Skip $ ConcatParseBuf (i + 1) xs s [] pstep pst1 extract PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract + return $ Skip $ ConcatParseBuf (i + 1 - n) src s [] pstep pst1 extract -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract + return $ Skip $ ConcatParseBuf (i + 1 - n) src s buf1 pstep pst1 extract -- XXX Specialize for Stop 0 common case? PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip $ ConcatParseYield (Right b) - (ConcatParseInit src s (func b)) + (ConcatParseInit (i + 1 - n) src s (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ConcatParseInitLeftOver (i + 1) []) -- This is simplified ConcatParseBuf - stepOuter _ (ConcatParseExtract [] buf pstep pst extract) = - return $ Skip $ ConcatParseStop buf pstep pst extract + stepOuter _ (ConcatParseExtract i [] buf pstep pst extract) = + return $ Skip $ ConcatParseStop i buf pstep pst extract - stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do + stepOuter _ (ConcatParseExtract i (x:xs) buf pstep pst extract) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract + return $ Skip $ ConcatParseExtract (i + 1) xs [] pstep pst1 extract PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ConcatParseExtract src [] pstep pst1 extract + return $ Skip $ ConcatParseExtract (i + 1 - n) src [] pstep pst1 extract PR.Continue 0 pst1 -> - return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract + return $ Skip $ ConcatParseExtract (i + 1) xs (x:buf) pstep pst1 extract PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract + return $ Skip $ ConcatParseExtract (i + 1 - n) src buf1 pstep pst1 extract PR.Done 0 b -> - return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b)) + return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf (i + 1) xs (func b)) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs - return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b)) + return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf (i + 1 - n) src (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ConcatParseInitLeftOver (i + 1) []) -- This is simplified ConcatParseExtract - stepOuter _ (ConcatParseStop buf pstep pst extract) = do + stepOuter _ (ConcatParseStop i buf pstep pst extract) = do pRes <- extract pst case pRes of PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract" PR.Continue 0 pst1 -> - return $ Skip $ ConcatParseStop buf pstep pst1 extract + return $ Skip $ ConcatParseStop i buf pstep pst1 extract PR.Continue n pst1 -> do assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 - return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract + return $ Skip $ ConcatParseExtract (i - n) src buf1 pstep pst1 extract PR.Done 0 b -> do return $ Skip $ - ConcatParseYield (Right b) (ConcatParseInitLeftOver []) + ConcatParseYield (Right b) (ConcatParseInitLeftOver i []) PR.Done n b -> do assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ - ConcatParseYield (Right b) (ConcatParseInitBuf src (func b)) + ConcatParseYield (Right b) (ConcatParseInitBuf (i - n) src (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) stepOuter _ (ConcatParseYield a next) = return $ Yield a next diff --git a/core/src/Streamly/Internal/Data/StreamK.hs b/core/src/Streamly/Internal/Data/StreamK.hs index 78c0891057..d12ccb00b8 100644 --- a/core/src/Streamly/Internal/Data/StreamK.hs +++ b/core/src/Streamly/Internal/Data/StreamK.hs @@ -1182,9 +1182,9 @@ parseDBreak parseDBreak (PR.Parser pstep initial extract) stream = do res <- initial case res of - PR.IPartial s -> goStream stream [] s + PR.IPartial s -> goStream stream [] s 0 PR.IDone b -> return (Right b, stream) - PR.IError err -> return (Left (ParseError err), stream) + PR.IError err -> return (Left (ParseError 0 err), stream) where @@ -1194,41 +1194,41 @@ parseDBreak (PR.Parser pstep initial extract) stream = do -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - goStream st buf !pst = + goStream st buf !pst i = let stop = do r <- extract pst case r of PR.Error err -> do let src = Prelude.reverse buf - return (Left (ParseError err), fromList src) + return (Left (ParseError i err), fromList src) PR.Done n b -> do assertM(n <= length buf) let src0 = Prelude.take n buf src = Prelude.reverse src0 return (Right b, fromList src) PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract" - PR.Continue 0 s -> goStream nil buf s + PR.Continue 0 s -> goStream nil buf s i PR.Continue n s -> do assertM(n <= length buf) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 - goBuf nil buf1 src s + goBuf nil buf1 src s (i - n) single x = yieldk x nil yieldk x r = do res <- pstep pst x case res of - PR.Partial 0 s -> goStream r [] s + PR.Partial 0 s -> goStream r [] s (i + 1) PR.Partial n s -> do assertM(n <= length (x:buf)) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 - goBuf r [] src s - PR.Continue 0 s -> goStream r (x:buf) s + goBuf r [] src s (i + 1 - n) + PR.Continue 0 s -> goStream r (x:buf) s (i + 1) PR.Continue n s -> do assertM(n <= length (x:buf)) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 - goBuf r buf1 src s + goBuf r buf1 src s (i + 1 - n) PR.Done 0 b -> return (Right b, r) PR.Done n b -> do assertM(n <= length (x:buf)) @@ -1237,25 +1237,25 @@ parseDBreak (PR.Parser pstep initial extract) stream = do return (Right b, append (fromList src) r) PR.Error err -> do let src = Prelude.reverse (x:buf) - return (Left (ParseError err), append (fromList src) r) + return (Left (ParseError (i + 1) err), append (fromList src) r) in foldStream defState yieldk single stop st - goBuf st buf [] !pst = goStream st buf pst - goBuf st buf (x:xs) !pst = do + goBuf st buf [] !pst i = goStream st buf pst i + goBuf st buf (x:xs) !pst i = do pRes <- pstep pst x case pRes of - PR.Partial 0 s -> goBuf st [] xs s + PR.Partial 0 s -> goBuf st [] xs s (i + 1) PR.Partial n s -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - goBuf st [] src s - PR.Continue 0 s -> goBuf st (x:buf) xs s + goBuf st [] src s (i + 1 - n) + PR.Continue 0 s -> goBuf st (x:buf) xs s (i + 1) PR.Continue n s -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - goBuf st buf1 src s + goBuf st buf1 src s (i + 1 - n) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) @@ -1263,7 +1263,7 @@ parseDBreak (PR.Parser pstep initial extract) stream = do return (Right b, append (fromList src) st) PR.Error err -> do let src = Prelude.reverse buf ++ x:xs - return (Left (ParseError err), append (fromList src) st) + return (Left (ParseError (i + 1) err), append (fromList src) st) -- Using ParserD or ParserK on StreamK may not make much difference. We should -- perhaps use only chunked parsing on StreamK. We can always convert a stream @@ -1360,7 +1360,7 @@ parseBreakChunks parser input = do in return (Right b, s1) ParserK.Error _ err -> do let (s1, _) = backTrack maxBound backBuf nil - return (Left (ParseError err), s1) + return (Left (ParseError (-1) err), s1) seekErr n len = error $ "parseBreak: Partial: forward seek not implemented n = " @@ -1405,7 +1405,7 @@ parseBreakChunks parser input = do in return (Right b, s1) ParserK.Error _ err -> do let (s1, _) = backTrack maxBound (arr:backBuf) stream - return (Left (ParseError err), s1) + return (Left (ParseError (-1) err), s1) go backBuf parserk stream = do let stop = goStop backBuf parserk @@ -1481,7 +1481,7 @@ parseBreak parser input = do assertM(n1 >= 0 && n1 <= length backBuf) let (s1, _) = backTrackSingular n1 backBuf nil in return (Right b, s1) - ParserK.Error _ err -> return (Left (ParseError err), nil) + ParserK.Error _ err -> return (Left (ParseError (-1) err), nil) seekErr n = error $ "parseBreak: Partial: forward seek not implemented n = " @@ -1529,7 +1529,7 @@ parseBreak parser input = do assertM(n1 >= 0 && n1 <= bufLen) let (s1, _) = backTrackSingular n1 backBuf s pure (Right b, s1) - ParserK.Error _ err -> return (Left (ParseError err), nil) + ParserK.Error _ err -> return (Left (ParseError (-1) err), nil) go :: [a] @@ -1622,7 +1622,7 @@ parseBreakChunksGeneric parser input = do assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf)) let (s1, _) = backTrackGenericChunks n1 backBuf nil in return (Right b, s1) - ParserK.Error _ err -> return (Left (ParseError err), nil) + ParserK.Error _ err -> return (Left (ParseError (-1) err), nil) seekErr n len = error $ "parseBreak: Partial: forward seek not implemented n = " @@ -1672,7 +1672,7 @@ parseBreakChunksGeneric parser input = do assertM(n1 <= sum (Prelude.map GenArr.length (arr:backBuf))) let (s1, _) = backTrackGenericChunks n1 (arr:backBuf) stream in return (Right b, s1) - ParserK.Error _ err -> return (Left (ParseError err), nil) + ParserK.Error _ err -> return (Left (ParseError (-1) err), nil) go :: [GenArr.Array a] diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 6bb7b9294d..05557b8008 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -111,7 +111,7 @@ parserFail = property $ case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of Right _ -> False - Left (ParseError e) -> err == e + Left (ParseError _ e) -> err == e where err = "Testing MonadFail.fail." @@ -1358,7 +1358,7 @@ expectedResult moves inp = go 0 0 [] moves -- j = Minimum index of inp head go i j ys [] = (Right ys, slice_ (max i j) inp) go i j ys ((Consume n):xs) - | i + n > inpLen = (Left (ParseError "INCOMPLETE"), drop j inp) + | i + n > inpLen = (Left (ParseError inpLen "INCOMPLETE"), drop j inp) | otherwise = go (i + n) j (ys ++ slice i n inp) xs go i j ys ((Custom step):xs) @@ -1370,22 +1370,27 @@ expectedResult moves inp = go 0 0 [] moves P.Partial n () -> go (i - n) (max j (i - n)) ys xs P.Continue n () -> go (i - n) j ys xs P.Done n () -> (Right ys, slice_ (max (i - n) j) inp) - P.Error err -> (Left (ParseError err), slice_ j inp) + P.Error err -> (Left (ParseError i err), slice_ j inp) | otherwise = case step of P.Partial n () -> go (i + 1 - n) (max j (i + 1 - n)) ys xs P.Continue n () -> go (i + 1 - n) j ys xs P.Done n () -> (Right ys, slice_ (max (i - n + 1) j) inp) - P.Error err -> (Left (ParseError err), slice_ j inp) + P.Error err -> (Left (ParseError (i + 1) err), slice_ j inp) expectedResultMany :: [Move] -> [Int] -> [Either ParseError [Int]] -expectedResultMany _ [] = [] -expectedResultMany moves inp = - let (res, rest) = expectedResult moves inp - in - case res of - Left err -> [Left err] - Right val -> Right val : expectedResultMany moves rest +expectedResultMany m input = go m input + where + go _ [] = [] + go moves inp = + let lenInput = length input + (res, rest) = expectedResult moves inp + off = lenInput - length inp + in + case res of + Left (ParseError pos errTxt) + -> [Left (ParseError (off + pos) errTxt)] + Right val -> Right val : go moves rest createPaths :: [a] -> [[a]] createPaths xs = @@ -1470,8 +1475,6 @@ TODO: Add sanity tests for - Producer.parse - Producer.parseMany -- Stream.parseMany -- Stream.parseIterate -} sanityParseBreak :: [Move] -> SpecWith () diff --git a/test/Streamly/Test/Unicode/Parser.hs b/test/Streamly/Test/Unicode/Parser.hs index df4fdbf883..29eb2031bf 100644 --- a/test/Streamly/Test/Unicode/Parser.hs +++ b/test/Streamly/Test/Unicode/Parser.hs @@ -80,7 +80,7 @@ double s d = monadicIO $ do Right val -> if val == d then assert (val == d) else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d)) - Left (ParseError _) -> assert False + Left (ParseError _ _) -> assert False numberP :: Monad m => Parser Char m Double numberP = uncurry Parser.mkDouble <$> Parser.number @@ -95,16 +95,16 @@ number s d = monadicIO $ do Right val -> if val == d then assert (val == d) else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d)) - Left (ParseError _) -> assert False + Left (ParseError _ _) -> assert False doubleErr :: (String -> IO (Either ParseError Double)) -> String -> String -> Property doubleErr f s msg = monadicIO $ do x <- run $ f s case x of Right _ -> assert False - Left (ParseError err) -> if err == msg - then assert (err == msg) - else trace err (assert (err == msg)) + Left (ParseError _ err) -> if err == msg + then assert (err == msg) + else trace err (assert (err == msg)) remainingStreamDouble :: String -> [String] remainingStreamDouble x =