diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 3ee5986611..f157ba3f90 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -1048,28 +1048,31 @@ parseBreak parser input = do -- If we stop in an alternative, it will try calling the next -- parser, the next parser may call initial returning Partial and -- then immediately we have to call extract on it. - ParserK.Partial 0 cont1 -> + ParserK.SPartial (-1) cont1 -> go [] cont1 StreamK.nil - ParserK.Partial n cont1 -> do - let n1 = negate n + ParserK.SPartial m cont1 -> do + let n = m + 1 + n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 - ParserK.Continue 0 cont1 -> + ParserK.SContinue (-1) cont1 -> go backBuf cont1 StreamK.nil - ParserK.Continue n cont1 -> do - let n1 = negate n + ParserK.SContinue m cont1 -> do + let n = m + 1 + n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 - ParserK.Done 0 b -> + ParserK.SDone (-1) b -> return (Right b, StreamK.nil) - ParserK.Done n b -> do - let n1 = negate n + ParserK.SDone m b -> do + let n = m + 1 + n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) let (s1, _) = backTrack n1 backBuf StreamK.nil in return (Right b, s1) - ParserK.Error _ err -> do + ParserK.SError _ err -> do let (s1, _) = backTrack maxBound backBuf StreamK.nil return (Left (ParseError err), s1) @@ -1081,7 +1084,8 @@ parseBreak parser input = do pRes <- parserk (ParserK.Chunk arr) let len = length arr case pRes of - ParserK.Partial n cont1 -> + ParserK.SPartial m cont1 -> do + let n = m + 1 case compare n len of EQ -> go [] cont1 stream LT -> do @@ -1095,7 +1099,8 @@ parseBreak parser input = do let (s1, _) = backTrack n1 backBuf s go [] cont1 s1 GT -> seekErr n len - ParserK.Continue n cont1 -> + ParserK.SContinue m cont1 -> do + let n = m + 1 case compare n len of EQ -> go (arr:backBuf) cont1 stream LT -> do @@ -1109,12 +1114,13 @@ parseBreak parser input = do let (s1, backBuf1) = backTrack n1 backBuf s go backBuf1 cont1 s1 GT -> seekErr n len - ParserK.Done n b -> do - let n1 = len - n + ParserK.SDone m b -> do + let n = m + 1 + n1 = len - n assertM(n1 <= sum (Prelude.map length (arr:backBuf))) let (s1, _) = backTrack n1 (arr:backBuf) stream in return (Right b, s1) - ParserK.Error _ err -> do + ParserK.SError _ err -> do let (s1, _) = backTrack maxBound (arr:backBuf) stream return (Left (ParseError err), s1) diff --git a/core/src/Streamly/Internal/Data/ParserK/Type.hs b/core/src/Streamly/Internal/Data/ParserK/Type.hs index 41da376ee3..18c589af0b 100644 --- a/core/src/Streamly/Internal/Data/ParserK/Type.hs +++ b/core/src/Streamly/Internal/Data/ParserK/Type.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Streamly.Internal.Data.Parser.ParserK.Type -- Copyright : (c) 2020 Composewell Technologies @@ -23,7 +25,7 @@ module Streamly.Internal.Data.ParserK.Type ( - Step (..) + Step(Partial, Continue, Done, Error, SPartial, SContinue, SDone, SError) , Input (..) , ParseResult (..) , ParserK (..) @@ -121,12 +123,40 @@ type StepParser a m r = Input a -> m (Step a m r) -- /Pre-release/ -- data Step a m r = - -- The Int is the current stream position index wrt to the start of the - -- array. - Done !Int r - | Partial !Int (StepParser a m r) - | Continue !Int (StepParser a m r) - | Error !Int String + SDone !Int r + | SPartial !Int (StepParser a m r) + | SContinue !Int (StepParser a m r) + | SError !Int String + +-------------------------------------------------------------------------------- +-- Custom Patterns +-------------------------------------------------------------------------------- + +incrIndex :: Step a m r -> Step a m r +incrIndex (SPartial i s) = SPartial (i + 1) s +incrIndex (SContinue i s) = SContinue (i + 1) s +incrIndex (SDone i b) = SDone (i + 1) b +incrIndex (SError i s) = SError (i + 1) s + +pattern Partial :: Int -> StepParser a m r -> Step a m r +pattern Partial i s <- (incrIndex -> SPartial i s) + where Partial i s = SPartial (i - 1) s + +pattern Continue :: Int -> StepParser a m r -> Step a m r +pattern Continue i s <- (incrIndex -> SContinue i s) + where Continue i s = SContinue (i - 1) s + +pattern Done :: Int -> r -> Step a m r +pattern Done i b <- (incrIndex -> SDone i b) + where Done i b = SDone (i - 1) b + +pattern Error :: Int -> String -> Step a m r +pattern Error i b <- (incrIndex -> SError i b) + where Error i b = SError (i - 1) b + +-------------------------------------------------------------------------------- +-- Code +-------------------------------------------------------------------------------- instance Functor m => Functor (Step a m) where fmap f (Done n r) = Done n (f r)