@@ -169,8 +169,8 @@ module Streamly.Internal.Data.Parser.ParserD.Type
169 -- * Types
169 -- * Types
170 Initial (..)
170 Initial (..)
171 , Step (..)
171 , Step (..)
173 , extractStep
172 , extractStep
173+ , bimapOverrideCount
174 , Parser (..)
174 , Parser (..)
175 , ParseError (..)
175 , ParseError (..)
@@ -180,8 +180,6 @@ module Streamly.Internal.Data.Parser.ParserD.Type
180 , toParserK
180 , toParserK
182 -- * Constructors
182 -- * Constructors
186 , fromPure
184 , fromPure
187 , fromEffect
185 , fromEffect
@@ -201,8 +199,8 @@ module Streamly.Internal.Data.Parser.ParserD.Type
204− , noErrorUnsafeSplit_
205 , noErrorUnsafeSplitWith
202 , noErrorUnsafeSplitWith
203+ , noErrorUnsafeSplit_
206 , noErrorUnsafeConcatMap
204 , noErrorUnsafeConcatMap
@@ -215,7 +213,6 @@ import Control.Monad (MonadPlus(..), (>=>))
215import Control.Monad.IO.Class (MonadIO, liftIO)
213import Control.Monad.IO.Class (MonadIO, liftIO)
216import Control.Monad.Reader.Class (MonadReader, ask, local)
214import Control.Monad.Reader.Class (MonadReader, ask, local)
217import Control.Monad.State.Class (MonadState, get, put)
215import Control.Monad.State.Class (MonadState, get, put)
218−import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
219import Data.Bifunctor (Bifunctor(..))
216import Data.Bifunctor (Bifunctor(..))
220import Fusion.Plugin.Types (Fuse(..))
217import Fusion.Plugin.Types (Fuse(..))
221import Streamly.Internal.Data.Fold.Type (Fold(..), toList)
218import Streamly.Internal.Data.Fold.Type (Fold(..), toList)
@@ -230,6 +227,7 @@ import Prelude hiding (concatMap, filter)
231-- >>> :set -package streamly
228-- >>> :set -package streamly
232-- >>> import Control.Applicative ((<|>))
229-- >>> import Control.Applicative ((<|>))
230+-- >>> import Data.Bifunctor (second)
233-- >>> import Prelude hiding (concatMap)
231-- >>> import Prelude hiding (concatMap)
234-- >>> import qualified Streamly.Prelude as Stream
232-- >>> import qualified Streamly.Prelude as Stream
235-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)
233-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)
@@ -269,21 +267,9 @@ instance Bifunctor Initial where
269 bimap _ g (IDone b) = IDone (g b)
267 bimap _ g (IDone b) = IDone (g b)
270 bimap _ _ (IError err) = IError err
268 bimap _ _ (IError err) = IError err
272− {-# INLINE first #-}
273− first f (IPartial a) = IPartial (f a)
274− first _ (IDone x) = IDone x
275− first _ (IError err) = IError err
277− {-# INLINE second #-}
278− second _ (IPartial x) = IPartial x
279− second f (IDone a) = IDone (f a)
280− second _ (IError err) = IError err
282-- | Maps a function over the result held by 'IDone'.
270-- | Maps a function over the result held by 'IDone'.
285−-- fmap = 'second'
272+-- >>> fmap = second
288-- /Internal/
274-- /Internal/
@@ -297,7 +283,7 @@ instance Functor (Initial s) where
297-- Done Int (Either String b)
283-- Done Int (Either String b)
299-- In this case Error may also have a "leftover" return. This means that after
285-- In this case Error may also have a "leftover" return. This means that after
300−-- serveral successful partial results the last segment parsing failed and we
286+-- several successful partial results the last segment parsing failed and we
301-- are returning the leftover of that. The driver may choose to restart from
287-- are returning the leftover of that. The driver may choose to restart from
302-- the last segment where this parser failed or from the beginning.
288-- the last segment where this parser failed or from the beginning.
@@ -335,19 +321,20 @@ instance Functor (Initial s) where
335{-# ANN type Step Fuse #-}
321{-# ANN type Step Fuse #-}
336data Step s b =
322data Step s b =
337 Partial !Int !s
323 Partial !Int !s
338− -- ^ @Partial count state@. The following hold:
324+ -- ^ @Partial count state@. The following hold on Partial result:
340 -- 1. @extract@ on @state@ would succeed and give a result.
326 -- 1. @extract@ on @state@ would succeed and give a result.
341− -- 2. Current input stream position is reset to @current position - count@.
327+ -- 2. Input stream position is reset to @current position - count@.
342− -- 3. All input before the new current position is dropped. The parser can
328+ -- 3. All input before the new position is dropped. The parser can
343 -- never backtrack beyond this position.
329 -- never backtrack beyond this position.
345 | Continue !Int !s
331 | Continue !Int !s
346− -- ^ @Continue count state@. The following hold:
332+ -- ^ @Continue count state@. The following hold on a Continue result:
348− -- 1. @extract@ on @state@ would give the last 'Partial' result or throw
334+ -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would
349− -- 'ParseError' if there is none.
335+ -- give that result as 'Done' otherwise it may return 'Error' or
350− -- 2. Current input stream position is reset to @current position - count@.
337+ -- 2. Input stream position is reset to @current position - count@.
351 -- 3. the input is retained in a backtrack buffer.
338 -- 3. the input is retained in a backtrack buffer.
353 | Done !Int !b
340 | Done !Int !b
@@ -363,33 +350,50 @@ data Step s b =
363 -- The parsing operation may backtrack to the beginning and try another
350 -- The parsing operation may backtrack to the beginning and try another
364 -- alternative.
351 -- alternative.
353+-- | Map first function over the state and second over the result.
354+instance Bifunctor Step where
355+ {-# INLINE bimap #-}
358+ Partial n s -> Partial n (f s)
359+ Continue n s -> Continue n (f s)
360+ Done n b -> Done n (g b)
361+ Error err -> Error err
363+-- | Bimap discarding the count, and using the supplied count instead.
364+bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1
365+bimapOverrideCount n f g step =
367+ Partial _ s -> Partial n (f s)
368+ Continue _ s -> Continue n (f s)
369+ Done _ b -> Done n (g b)
370+ Error err -> Error err
366instance Functor (Step s) where
373instance Functor (Step s) where
367 {-# INLINE fmap #-}
374 {-# INLINE fmap #-}
368− fmap _ (Partial n s) = Partial n s
375+ fmap = second
369− fmap _ (Continue n s) = Continue n s
376+
370− fmap f (Done n b) = Done n (f b)
377+{-# INLINE assertStepCount #-}
371− fmap _ (Error err) = Error err
378+assertStepCount :: Int -> Step s b -> Step s b
379+assertStepCount i step =
381+ Partial n _ -> assert (i == n) step
382+ Continue n _ -> assert (i == n) step
383+ Done n _ -> assert (i == n) step
373-- | Map an extract function over the state of Step
386-- | Map an extract function over the state of Step
375{-# INLINE extractStep #-}
388{-# INLINE extractStep #-}
376−extractStep :: Monad m => (s -> m b) -> Step s b -> m (Step s1 b)
389+extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)
377extractStep f res =
390extractStep f res =
378 case res of
391 case res of
379− Partial n s1 -> Done n <$> f s1
392+ Partial n s1 -> assertStepCount n <$> f s1
380 Done n b -> return $ Done n b
393 Done n b -> return $ Done n b
381− Continue n s1 -> Done n <$> f s1
394+ Continue n s1 -> assertStepCount n <$> f s1
382 Error err -> return $ Error err
395 Error err -> return $ Error err
384−{-# INLINE mapStateStep #-}
385−mapStateStep :: (s -> s1) -> Step s b -> Step s1 b
388− Partial n s1 -> Partial n $ f s1
389− Done n b -> Done n b
390− Continue n s1 -> Continue n $ f s1
391− Error err -> Error err
393-- | Map a monadic function over the result @b@ in @Step s b@.
397-- | Map a monadic function over the result @b@ in @Step s b@.
395-- /Internal/
399-- /Internal/
@@ -415,13 +419,18 @@ mapMStep f res =
415-- /Pre-release/
419-- /Pre-release/
417data Parser m a b =
421data Parser m a b =
418− forall s. Parser (s -> a -> m (Step s b)) (m (Initial s b)) (s -> m b)
422+ forall s. Parser
419−
423+ (s -> a -> m (Step s b))
420−-- | This exception is used for two purposes:
424+ -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is
421−--
425+ -- same as Partial 0. In other words it cannot backtrack.
427+ -- Extract can only return Partial or Continue n. In other words it can
428+ -- only backtrack or return partial result/error. But we do not return
429+ -- result in Partial, therefore, we have to use Done instead of Partial.
422−-- * When a parser ultimately fails, the user of the parser is intimated via
432+-- | This exception is used when a parser ultimately fails, the user of the
423−-- this exception.
433+-- parser is intimated via this exception.
424−-- * When the "extract" function of a parser needs to throw an error.
426-- /Pre-release/
435-- /Pre-release/
@@ -434,13 +443,14 @@ instance Exception ParseError where
434instance Functor m => Functor (Parser m a) where
443instance Functor m => Functor (Parser m a) where
435 {-# INLINE fmap #-}
444 {-# INLINE fmap #-}
436 fmap f (Parser step1 initial1 extract) =
445 fmap f (Parser step1 initial1 extract) =
437− Parser step initial (fmap2 f extract)
446+ Parser step initial (fmap3 f extract)
441 initial = fmap2 f initial1
450 initial = fmap2 f initial1
442 step s b = fmap2 f (step1 s b)
451 step s b = fmap2 f (step1 s b)
443 fmap2 g = fmap (fmap g)
452 fmap2 g = fmap (fmap g)
453+ fmap3 g = fmap2 (fmap g)
445-------------------------------------------------------------------------------
455-------------------------------------------------------------------------------
446-- Convert direct style 'Parser' to CPS style 'K.Parser'
456-- Convert direct style 'Parser' to CPS style 'K.Parser'
@@ -457,40 +467,52 @@ instance Functor m => Functor (Parser m a) where
458{-# INLINE_NORMAL parseDToK #-}
468{-# INLINE_NORMAL parseDToK #-}
460− :: MonadCatch m
470+ :: Monad m
461 => (s -> a -> m (Step s b))
471 => (s -> a -> m (Step s b))
462 -> m (Initial s b)
472 -> m (Initial s b)
463− -> (s -> m b)
473+ -> (s -> m (Step s b))
465 -> (Int, Int)
475 -> (Int, Int)
466 -> ((Int, Int) -> K.Parse b -> m (K.Step m a r))
476 -> ((Int, Int) -> K.Parse b -> m (K.Step m a r))
467 -> m (K.Step m a r)
477 -> m (K.Step m a r)
479+-- Non 'Alternative' case.
469parseDToK pstep initial extract leftover (0, _) cont = do
480parseDToK pstep initial extract leftover (0, _) cont = do
470 res <- initial
481 res <- initial
471 case res of
482 case res of
472 IPartial r -> return $ K.Continue leftover (parseCont (return r))
483 IPartial r -> return $ K.Continue leftover (parseCont (return r))
473− IDone b -> cont (0,0) (K.Success 0 b)
484+ IDone b -> cont state (K.Success 0 b)
474− IError err -> cont (0,0) (K.Failure err)
485+ IError err -> cont state (K.Failure err)
489+ -- The continuation is called with (0,0) state i.e. Alternative level
490+ -- is 0 and the used count is 0. Alternative level is 0 because the level
491+ -- passed in the argument above is 0, the "used" count is 0 because it is
492+ -- not useful when Alternative level is 0. We should probably use a Maybe
493+ -- type for the state but that might impact performance, need to measure.
478 parseCont pst (Just x) = do
496 parseCont pst (Just x) = do
480 pRes <- pstep r x
498 pRes <- pstep r x
481 case pRes of
499 case pRes of
482− Done n b -> cont (0,0) (K.Success n b)
500+ Done n b -> cont state (K.Success n b)
483− Error err -> cont (0,0) (K.Failure err)
501+ Error err -> cont state (K.Failure err)
484 Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))
502 Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))
485 Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
503 Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
487 parseCont acc Nothing = do
505 parseCont acc Nothing = do
488 pst <- acc
506 pst <- acc
489− r <- try $ extract pst
507+ r <- extract pst
490 case r of
508 case r of
491− Left (e :: ParseError) -> cont (0,0) (K.Failure (displayException e))
492− Right b -> cont (0,0) (K.Success 0 b)
509+ Done n b -> cont state (K.Success n b)
510+ Error err -> cont state (K.Failure err)
511+ Partial _ _ -> error "Bug: parseDToK Partial unreachable"
512+ Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
514+-- 'Alternative' case. Used count needs to be maintained when inside an
494parseDToK pstep initial extract leftover (level, count) cont = do
516parseDToK pstep initial extract leftover (level, count) cont = do
495 res <- initial
517 res <- initial
496 case res of
518 case res of
@@ -518,18 +540,25 @@ parseDToK pstep initial extract leftover (level, count) cont = do
518 return $ K.Continue n (parseCont (cnt1 - n) (return pst1))
540 return $ K.Continue n (parseCont (cnt1 - n) (return pst1))
519 parseCont cnt acc Nothing = do
541 parseCont cnt acc Nothing = do
520 pst <- acc
542 pst <- acc
521− r <- try $ extract pst
543+ r <- extract pst
522 let s = (level, cnt)
544 let s = (level, cnt)
523 case r of
545 case r of
524− Left (e :: ParseError) -> cont s (K.Failure (displayException e))
546+ Done n b -> do
525− Right b -> cont s (K.Success 0 b)
548+ cont s (K.Success n b)
549+ Partial _ _ -> error "Bug: parseDToK Partial unreachable"
551+ cont s (K.Failure e)
552+ Continue n pst1 -> do
554+ return $ K.Continue n (parseCont (cnt - n) (return pst1))
527-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
556-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
529-- /Pre-release/
558-- /Pre-release/
531{-# INLINE_LATE toParserK #-}
560{-# INLINE_LATE toParserK #-}
532−toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
561+toParserK :: Monad m => Parser m a b -> K.Parser m a b
533toParserK (Parser step initial extract) =
562toParserK (Parser step initial extract) =
534 K.MkParser $ parseDToK step initial extract
563 K.MkParser $ parseDToK step initial extract
@@ -549,14 +578,14 @@ parserDone _ (K.Failure e) = return $ K.Error e
550-- /Pre-release/
579-- /Pre-release/
552−extractParse :: MonadThrow m => (Maybe a -> m (K.Step m a b)) -> m b
581+extractParse :: Monad m => (Maybe a -> m (K.Step m a b)) -> m (Step s b)
553extractParse cont = do
582extractParse cont = do
554 r <- cont Nothing
583 r <- cont Nothing
555 case r of
584 case r of
556− K.Done _ b -> return b
585+ K.Done n b -> return (Done n b)
557 K.Partial _ _ -> error "Bug: extractParse got Partial"
586 K.Partial _ _ -> error "Bug: extractParse got Partial"
558 K.Continue _ cont1 -> extractParse cont1
587 K.Continue _ cont1 -> extractParse cont1
559− K.Error e -> throwM $ ParseError e
588+ K.Error e -> return $ Error e
561data FromParserK b c = FPKDone !Int !b | FPKCont c
590data FromParserK b c = FPKDone !Int !b | FPKCont c
@@ -568,13 +597,13 @@ data FromParserK b c = FPKDone !Int !b | FPKCont c
568-- /Pre-release/
597-- /Pre-release/
570{-# INLINE_LATE fromParserK #-}
599{-# INLINE_LATE fromParserK #-}
571−fromParserK :: MonadThrow m => K.Parser m a b -> Parser m a b
600+fromParserK :: Monad m => K.Parser m a b -> Parser m a b
572−fromParserK parser0 = Parser step initial extract
601+fromParserK parser = Parser step initial extract
576 initial = do
605 initial = do
577− r <- K.runParser parser0 0 (0,0) parserDone
606+ r <- K.runParser parser 0 (0,0) parserDone
578 return $ case r of
607 return $ case r of
579 K.Done n b -> IPartial $ FPKDone n b
608 K.Done n b -> IPartial $ FPKDone n b
580 K.Error e -> IError e
609 K.Error e -> IError e
@@ -596,7 +625,7 @@ fromParserK parser0 = Parser step initial extract
596 K.Continue n cont1 -> Continue n (FPKCont cont1)
625 K.Continue n cont1 -> Continue n (FPKCont cont1)
598 -- Note, we can only reach FPKDone and FPKError from "initial".
627 -- Note, we can only reach FPKDone and FPKError from "initial".
599− extract (FPKDone _ b) = return b
628+ extract (FPKDone n b) = return (Done n b)
600 extract (FPKCont cont) = extractParse cont
629 extract (FPKCont cont) = extractParse cont
602#ifndef DISABLE_FUSION
631#ifndef DISABLE_FUSION
@@ -606,30 +635,6 @@ fromParserK parser0 = Parser step initial extract
606 forall s. fromParserK (toParserK s) = s #-}
635 forall s. fromParserK (toParserK s) = s #-}
609−------------------------------------------------------------------------------
610−-- General parser constructors
611−------------------------------------------------------------------------------
613−-- | Make a parser using a parsing step and a starting value.
617−{-# INLINE parser #-}
618−parser :: Monad m => (b -> a -> Step b b) -> Initial b b -> Parser m a b
619−parser step initial =
620− Parser (\s a -> return $ step s a) (return initial) return
622−-- | Like 'parser' but with a monadic step function.
624−-- >>> parserM step initial = ParserD.Parser step initial return
628−{-# INLINE parserM #-}
630− Monad m => (b -> a -> m (Step b b)) -> m (Initial b b) -> Parser m a b
631−parserM step initial = Parser step initial return
633------------------------------------------------------------------------------
638------------------------------------------------------------------------------
634-- Mapping on the output
639-- Mapping on the output
635------------------------------------------------------------------------------
640------------------------------------------------------------------------------
@@ -639,12 +644,14 @@ parserM step initial = Parser step initial return
639-- /Pre-release/
644-- /Pre-release/
640{-# INLINE rmapM #-}
645{-# INLINE rmapM #-}
641rmapM :: Monad m => (b -> m c) -> Parser m a b -> Parser m a c
646rmapM :: Monad m => (b -> m c) -> Parser m a b -> Parser m a c
642−rmapM f (Parser step initial extract) = Parser step1 initial1 (extract >=> f)
647+rmapM f (Parser step initial extract) =
648+ Parser step1 initial1 (extract >=> mapMStep f)
646 initial1 = do
652 initial1 = do
647 res <- initial
653 res <- initial
654+ -- this is mapM f over result
648 case res of
655 case res of
649 IPartial x -> return $ IPartial x
656 IPartial x -> return $ IPartial x
650 IDone a -> IDone <$> f a
657 IDone a -> IDone <$> f a
@@ -686,7 +693,7 @@ data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
686-- /Pre-release/
693-- /Pre-release/
688{-# INLINE serialWith #-}
695{-# INLINE serialWith #-}
689−serialWith :: MonadThrow m
696+serialWith :: Monad m
690 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
697 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
691serialWith func (Parser stepL initialL extractL)
698serialWith func (Parser stepL initialL extractL)
692 (Parser stepR initialR extractR) =
699 (Parser stepR initialR extractR) =
@@ -695,11 +702,13 @@ serialWith func (Parser stepL initialL extractL)
697 initial = do
704 initial = do
705+ -- XXX We can use bimap here if we make this a Step type
698 resL <- initialL
706 resL <- initialL
699 case resL of
707 case resL of
700 IPartial sl -> return $ IPartial $ SeqParseL sl
708 IPartial sl -> return $ IPartial $ SeqParseL sl
701 IDone bl -> do
709 IDone bl -> do
702 resR <- initialR
710 resR <- initialR
711+ -- XXX We can use bimap here if we make this a Step type
703 return $ case resR of
712 return $ case resR of
704 IPartial sr -> IPartial $ SeqParseR (func bl) sr
713 IPartial sr -> IPartial $ SeqParseR (func bl) sr
705 IDone br -> IDone (func bl br)
714 IDone br -> IDone (func bl br)
@@ -712,6 +721,7 @@ serialWith func (Parser stepL initialL extractL)
712 -- Important: Please do not use Applicative here. See
721 -- Important: Please do not use Applicative here. See
713 -- https://github.com/composewell/streamly/issues/1033 and the problem
722 -- https://github.com/composewell/streamly/issues/1033 and the problem
714 -- defined in split_ for more info.
723 -- defined in split_ for more info.
715 resL <- stepL st a
725 resL <- stepL st a
716 case resL of
726 case resL of
717 -- Note: We need to buffer the input for a possible Alternative
727 -- Note: We need to buffer the input for a possible Alternative
@@ -721,6 +731,8 @@ serialWith func (Parser stepL initialL extractL)
721 Partial n s -> return $ Continue n (SeqParseL s)
731 Partial n s -> return $ Continue n (SeqParseL s)
722 Continue n s -> return $ Continue n (SeqParseL s)
732 Continue n s -> return $ Continue n (SeqParseL s)
723 Done n b -> do
733 Done n b -> do
734+ -- XXX Use bimap if we make this a Step type
735+ -- fmap (bimap (SeqParseR (func b)) (func b)) initialR
724 initR <- initialR
736 initR <- initialR
725 return $ case initR of
737 return $ case initR of
726 IPartial sr -> Continue n $ SeqParseR (func b) sr
738 IPartial sr -> Continue n $ SeqParseR (func b) sr
@@ -728,26 +740,41 @@ serialWith func (Parser stepL initialL extractL)
728 IError err -> Error err
740 IError err -> Error err
729 Error err -> return $ Error err
741 Error err -> return $ Error err
731− step (SeqParseR f st) a = do
743+ step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)
733− return $ case resR of
734− Partial n s -> Partial n (SeqParseR f s)
735− Continue n s -> Continue n (SeqParseR f s)
736− Done n b -> Done n (f b)
737− Error err -> Error err
739− extract (SeqParseR f sR) = fmap f (extractR sR)
745+ extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)
740 extract (SeqParseL sL) = do
746 extract (SeqParseL sL) = do
747+ -- XXX Use bimap here
741 rL <- extractL sL
748 rL <- extractL sL
751+ -- XXX Use bimap here if we use Step type in Initial
742− res <- initialR
752+ iR <- initialR
743− case res of
753+ case iR of
744− IPartial sR -> do
754+ IPartial sR -> do
756+ (bimap (SeqParseR (func bL)) (func bL))
745− rR <- extractR sR
757+ (extractR sR)
747− IDone rR -> return $ func rL rR
758+ IDone bR -> return $ Done n $ func bL bR
748− IError err -> throwM $ ParseError err
759+ IError err -> return $ Error err
760+ Error err -> return $ Error err
761+ Partial _ _ -> error "Bug: serialWith extract 'Partial'"
762+ Continue n s -> return $ Continue n (SeqParseL s)
764+-------------------------------------------------------------------------------
765+-- Sequential applicative for backtracking folds
766+-------------------------------------------------------------------------------
768+-- XXX Create a newtype for nonfailing parsers and downgrade the parser to that
769+-- type before this operation and then upgrade.
771+-- We can do an inspection testing to reject unwanted constructors at compile
774+-- We can use the compiler to automatically annotate accumulators, terminating
775+-- folds, non-failing parsers and failing parsers.
750−-- | Works correctly only if the first parser is guaranteed to never fail.
777+-- | Works correctly only if both the parsers are guaranteed to never fail.
751{-# INLINE noErrorUnsafeSplitWith #-}
778{-# INLINE noErrorUnsafeSplitWith #-}
752noErrorUnsafeSplitWith :: Monad m
779noErrorUnsafeSplitWith :: Monad m
753 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
780 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
@@ -757,24 +784,23 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL)
787+ errMsg e = error $ "noErrorUnsafeSplitWith: unreachable: " ++ e
760 initial = do
789 initial = do
761 resL <- initialL
790 resL <- initialL
762 case resL of
791 case resL of
763 IPartial sl -> return $ IPartial $ SeqParseL sl
792 IPartial sl -> return $ IPartial $ SeqParseL sl
764 IDone bl -> do
793 IDone bl -> do
765 resR <- initialR
794 resR <- initialR
766− return $ case resR of
767− IPartial sr -> IPartial $ SeqParseR (func bl) sr
795+ return $ bimap (SeqParseR (func bl)) (func bl) resR
768− IDone br -> IDone (func bl br)
769− IError err -> IError err
770− IError err -> return $ IError err
796+ IError err -> errMsg err
772 -- Note: For the composed parse to terminate, the left parser has to be
798 -- Note: For the composed parse to terminate, the left parser has to be
773 -- a terminating parser returning a Done at some point.
799 -- a terminating parser returning a Done at some point.
774 step (SeqParseL st) a = do
800 step (SeqParseL st) a = do
775 r <- stepL st a
801 r <- stepL st a
776 case r of
802 case r of
777− -- Assume that the first parser can never fail, therefore we do not
803+ -- Assume that the parser can never fail, therefore, we do not
778 -- need to keep the input for backtracking.
804 -- need to keep the input for backtracking.
779 Partial n s -> return $ Partial n (SeqParseL s)
805 Partial n s -> return $ Partial n (SeqParseL s)
780 Continue n s -> return $ Continue n (SeqParseL s)
806 Continue n s -> return $ Continue n (SeqParseL s)
@@ -784,28 +810,29 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL)
784 $ case res of
810 $ case res of
785 IPartial sr -> Partial n $ SeqParseR (func b) sr
811 IPartial sr -> Partial n $ SeqParseR (func b) sr
786 IDone br -> Done n (func b br)
812 IDone br -> Done n (func b br)
787− IError err -> Error err
813+ IError err -> errMsg err
788− Error err -> return $ Error err
814+ Error err -> errMsg err
790− step (SeqParseR f st) a = do
816+ step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)
792− return $ case r of
818+ extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)
793− Partial n s -> Partial n (SeqParseR f s)
794− Continue n s -> Continue n (SeqParseR f s)
795− Done n b -> Done n (f b)
796− Error err -> Error err
798− extract (SeqParseR f sR) = fmap f (extractR sR)
799 extract (SeqParseL sL) = do
820 extract (SeqParseL sL) = do
800 rL <- extractL sL
821 rL <- extractL sL
801− res <- initialR
824+ iR <- initialR
802− case res of
825+ case iR of
803− IPartial sR -> do
826+ IPartial sR -> do
804− rR <- extractR sR
827+ rR <- extractR sR
805− return $ func rL rR
828+ return
829+ $ bimapOverrideCount
830+ n (SeqParseR (func bL)) (func bL) rR
806− IDone rR -> return $ func rL rR
831+ IDone bR -> return $ Done n $ func bL bR
807− IError err -> error $ "noErrorUnsafeSplitWith: cannot use a "
832+ IError err -> errMsg err
808− ++ "failing parser. Parser failed with: " ++ err
833+ Error err -> errMsg err
834+ Partial _ _ -> errMsg "Partial"
835+ Continue n s -> return $ Continue n (SeqParseL s)
810{-# ANN type SeqAState Fuse #-}
837{-# ANN type SeqAState Fuse #-}
811data SeqAState sl sr = SeqAL sl | SeqAR sr
838data SeqAState sl sr = SeqAL sl | SeqAR sr
@@ -816,7 +843,7 @@ data SeqAState sl sr = SeqAL sl | SeqAR sr
816-- /Pre-release/
843-- /Pre-release/
818{-# INLINE split_ #-}
845{-# INLINE split_ #-}
819−split_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b
846+split_ :: Monad m => Parser m x a -> Parser m x b -> Parser m x b
820split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
847split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
821 Parser step initial extract
848 Parser step initial extract
@@ -828,10 +855,7 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
828 IPartial sl -> return $ IPartial $ SeqAL sl
855 IPartial sl -> return $ IPartial $ SeqAL sl
829 IDone _ -> do
856 IDone _ -> do
830 resR <- initialR
857 resR <- initialR
831− return $ case resR of
858+ return $ first SeqAR resR
832− IPartial sr -> IPartial $ SeqAR sr
833− IDone br -> IDone br
834− IError err -> IError err
835 IError err -> return $ IError err
859 IError err -> return $ IError err
837 -- Note: For the composed parse to terminate, the left parser has to be
861 -- Note: For the composed parse to terminate, the left parser has to be
@@ -853,40 +877,43 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
853 IError err -> Error err
877 IError err -> Error err
854 Error err -> return $ Error err
878 Error err -> return $ Error err
856− step (SeqAR st) a =
880+ step (SeqAR st) a = first SeqAR <$> stepR st a
858− Partial n s -> Partial n (SeqAR s)
859− Continue n s -> Continue n (SeqAR s)
860− Done n b -> Done n b
861− Error err -> Error err) <$> stepR st a
863− extract (SeqAR sR) = extractR sR
882+ extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)
864 extract (SeqAL sL) = do
883 extract (SeqAL sL) = do
865− _ <- extractL sL
884+ rL <- extractL sL
866− res <- initialR
887+ iR <- initialR
888+ -- XXX For initial we can have a bimap with leftover.
867− case res of
889+ case iR of
868− IPartial sR -> extractR sR
890+ IPartial sR ->
891+ fmap (bimapOverrideCount n SeqAR id) (extractR sR)
869− IDone rR -> return rR
892+ IDone bR -> return $ Done n bR
870− IError err -> throwM $ ParseError err
893+ IError err -> return $ Error err
894+ Error err -> return $ Error err
895+ Partial _ _ -> error "split_: Partial"
896+ Continue n s -> return $ Continue n (SeqAL s)
898+-- For backtracking folds
872{-# INLINE noErrorUnsafeSplit_ #-}
899{-# INLINE noErrorUnsafeSplit_ #-}
873−noErrorUnsafeSplit_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b
900+noErrorUnsafeSplit_ :: Monad m => Parser m x a -> Parser m x b -> Parser m x b
874−noErrorUnsafeSplit_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
902+ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
875 Parser step initial extract
903 Parser step initial extract
907+ errMsg e = error $ "noErrorUnsafeSplit_: unreachable: " ++ e
879 initial = do
909 initial = do
880 resL <- initialL
910 resL <- initialL
881 case resL of
911 case resL of
882 IPartial sl -> return $ IPartial $ SeqAL sl
912 IPartial sl -> return $ IPartial $ SeqAL sl
883 IDone _ -> do
913 IDone _ -> do
884 resR <- initialR
914 resR <- initialR
885− return $ case resR of
915+ return $ first SeqAR resR
886− IPartial sr -> IPartial $ SeqAR sr
887− IDone br -> IDone br
888− IError err -> IError err
889− IError err -> return $ IError err
916+ IError err -> errMsg err
891 -- Note: For the composed parse to terminate, the left parser has to be
918 -- Note: For the composed parse to terminate, the left parser has to be
892 -- a terminating parser returning a Done at some point.
919 -- a terminating parser returning a Done at some point.
@@ -903,27 +930,28 @@ noErrorUnsafeSplit_ (Parser stepL initialL extractL) (Parser stepR initialR extr
903 return $ case initR of
930 return $ case initR of
904 IPartial s -> Partial n (SeqAR s)
931 IPartial s -> Partial n (SeqAR s)
905 IDone b -> Done n b
932 IDone b -> Done n b
906− IError err -> Error err
933+ IError err -> errMsg err
907− Error err -> return $ Error err
934+ Error err -> errMsg err
909− step (SeqAR st) a =
936+ step (SeqAR st) a = first SeqAR <$> stepR st a
911− Partial n s -> Partial n (SeqAR s)
912− Continue n s -> Continue n (SeqAR s)
913− Done n b -> Done n b
914− Error err -> Error err) <$> stepR st a
916− extract (SeqAR sR) = extractR sR
938+ extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)
917 extract (SeqAL sL) = do
939 extract (SeqAL sL) = do
918− _ <- extractL sL
940+ rL <- extractL sL
919− res <- initialR
943+ iR <- initialR
920− case res of
944+ case iR of
921− IPartial sR -> extractR sR
945+ IPartial sR -> do
946+ fmap (bimapOverrideCount n SeqAR id) (extractR sR)
922− IDone rR -> return rR
947+ IDone bR -> return $ Done n bR
923− IError err -> throwM $ ParseError err
948+ IError err -> errMsg err
949+ Error err -> errMsg err
950+ Partial _ _ -> error "split_: Partial"
951+ Continue n s -> return $ Continue n (SeqAL s)
925-- | 'Applicative' form of 'serialWith'.
953-- | 'Applicative' form of 'serialWith'.
926−instance MonadThrow m => Applicative (Parser m a) where
954+instance Monad m => Applicative (Parser m a) where
927 {-# INLINE pure #-}
955 {-# INLINE pure #-}
928 pure = fromPure
956 pure = fromPure
@@ -936,7 +964,6 @@ instance MonadThrow m => Applicative (Parser m a) where
936 {-# INLINE liftA2 #-}
964 {-# INLINE liftA2 #-}
937 liftA2 f x = (<*>) (fmap f x)
965 liftA2 f x = (<*>) (fmap f x)
940-------------------------------------------------------------------------------
967-------------------------------------------------------------------------------
941-- Sequential Alternative
968-- Sequential Alternative
942-------------------------------------------------------------------------------
969-------------------------------------------------------------------------------
@@ -948,9 +975,11 @@ data AltParseState sl sr = AltParseL Int sl | AltParseR sr
948-- quadratic time complexity, because each composition adds a new branch that
975-- quadratic time complexity, because each composition adds a new branch that
949-- each subsequent alternative's input element has to go through, therefore, it
976-- each subsequent alternative's input element has to go through, therefore, it
950-- cannot scale to a large number of compositions
977-- cannot scale to a large number of compositions
952-- | See 'Streamly.Internal.Data.Parser.alt'.
979-- | See 'Streamly.Internal.Data.Parser.alt'.
981+-- /Time Complexity:/ O(n^2) where n is the number of compositions.
954-- /Pre-release/
983-- /Pre-release/
956{-# INLINE alt #-}
985{-# INLINE alt #-}
@@ -1001,15 +1030,30 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
1001 Done n b -> Done n b
1030 Done n b -> Done n b
1002 Error err -> Error err
1031 Error err -> Error err
1004− extract (AltParseR sR) = extractR sR
1033+ extract (AltParseR sR) = fmap (first AltParseR) (extractR sR)
1005− extract (AltParseL _ sL) = extractL sL
1035+ extract (AltParseL cnt sL) = do
1038+ Done n b -> return $ Done n b
1043+ IPartial rR -> Continue cnt (AltParseR rR)
1044+ IDone b -> Done cnt b
1045+ IError err -> Error err
1046+ Partial _ _ -> error "Bug: serialWith extract 'Partial'"
1049+ return $ Continue n (AltParseL 0 s)
1007-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
1051-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
1009-- /Pre-release/
1053-- /Pre-release/
1011{-# INLINE splitMany #-}
1055{-# INLINE splitMany #-}
1012−splitMany :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1056+splitMany :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
1013splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1057splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1014 Parser step initial extract
1058 Parser step initial extract
@@ -1051,17 +1095,21 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1051 xs <- fextract fs
1095 xs <- fextract fs
1052 return $ Done cnt1 xs
1096 return $ Done cnt1 xs
1054− extract (Tuple3' _ 0 fs) = fextract fs
1098+ extract (Tuple3' _ 0 fs) = fmap (Done 0) (fextract fs)
1055− -- XXX The "try" may impact performance if this parser is used as a scan
1056− extract (Tuple3' s _ fs) = do
1099+ extract (Tuple3' s cnt fs) = do
1057− r <- try $ extract1 s
1100+ r <- extract1 s
1058 case r of
1101 case r of
1059− Left (_ :: ParseError) -> fextract fs
1102+ Error _ -> fmap (Done cnt) (fextract fs)
1060− Right b -> do
1103+ Done n b -> do
1061 fs1 <- fstep fs b
1105 fs1 <- fstep fs b
1062 case fs1 of
1106 case fs1 of
1063− FL.Partial s1 -> fextract s1
1107+ FL.Partial s1 -> fmap (Done n) (fextract s1)
1064− FL.Done b1 -> return b1
1108+ FL.Done b1 -> return (Done n b1)
1109+ Partial _ _ -> error "splitMany: Partial in extract"
1110+ Continue n s1 -> do
1112+ return (Continue n (Tuple3' s1 0 fs))
1066-- | Like splitMany, but inner fold emits an output at the end even if no input
1114-- | Like splitMany, but inner fold emits an output at the end even if no input
1067-- is received.
1115-- is received.
@@ -1069,7 +1117,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1069-- /Internal/
1117-- /Internal/
1071{-# INLINE splitManyPost #-}
1119{-# INLINE splitManyPost #-}
1072−splitManyPost :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1120+splitManyPost :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
1073splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1121splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1074 Parser step initial extract
1122 Parser step initial extract
@@ -1111,23 +1159,27 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1111 xs <- fextract fs
1159 xs <- fextract fs
1112 return $ Done cnt1 xs
1160 return $ Done cnt1 xs
1114− -- XXX The "try" may impact performance if this parser is used as a scan
1115− extract (Tuple3' s _ fs) = do
1162+ extract (Tuple3' s cnt fs) = do
1116− r <- try $ extract1 s
1163+ r <- extract1 s
1117 case r of
1164 case r of
1118− Left (_ :: ParseError) -> fextract fs
1165+ Error _ -> fmap (Done cnt) (fextract fs)
1119− Right b -> do
1166+ Done n b -> do
1120 fs1 <- fstep fs b
1168 fs1 <- fstep fs b
1121 case fs1 of
1169 case fs1 of
1122− FL.Partial s1 -> fextract s1
1170+ FL.Partial s1 -> fmap (Done n) (fextract s1)
1123− FL.Done b1 -> return b1
1171+ FL.Done b1 -> return (Done n b1)
1172+ Partial _ _ -> error "splitMany: Partial in extract"
1173+ Continue n s1 -> do
1175+ return (Continue n (Tuple3' s1 0 fs))
1125-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
1177-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
1127-- /Pre-release/
1179-- /Pre-release/
1129{-# INLINE splitSome #-}
1181{-# INLINE splitSome #-}
1130−splitSome :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1182+splitSome :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
1131splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1183splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1132 Parser step initial extract
1184 Parser step initial extract
@@ -1196,29 +1248,41 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =
1196 fstep fs b >>= handleCollect (Partial n) (Done n)
1248 fstep fs b >>= handleCollect (Partial n) (Done n)
1197 Error _ -> Done cnt1 <$> fextract fs
1249 Error _ -> Done cnt1 <$> fextract fs
1199− -- XXX The "try" may impact performance if this parser is used as a scan
1200− extract (Tuple3' s _ (Left fs)) = do
1251+ extract (Tuple3' s cnt (Left fs)) = do
1204− FL.Partial s1 -> fextract s1
1205− FL.Done b1 -> return b1
1206− extract (Tuple3' s _ (Right fs)) = do
1207− r <- try $ extract1 s
1252+ r <- extract1 s
1208 case r of
1253 case r of
1209− Left (_ :: ParseError) -> fextract fs
1254+ Error err -> return (Error err)
1210− Right b -> do
1255+ Done n b -> do
1211 fs1 <- fstep fs b
1257 fs1 <- fstep fs b
1212 case fs1 of
1258 case fs1 of
1213− FL.Partial s1 -> fextract s1
1259+ FL.Partial s1 -> fmap (Done n) (fextract s1)
1260+ FL.Done b1 -> return (Done n b1)
1261+ Partial _ _ -> error "splitSome: Partial in extract"
1262+ Continue n s1 -> do
1264+ return (Continue n (Tuple3' s1 0 (Left fs)))
1265+ extract (Tuple3' s cnt (Right fs)) = do
1268+ Error _ -> fmap (Done cnt) (fextract fs)
1273+ FL.Partial s1 -> fmap (Done n) (fextract s1)
1214− FL.Done b1 -> return b1
1274+ FL.Done b1 -> return (Done n b1)
1275+ Partial _ _ -> error "splitSome: Partial in extract"
1276+ Continue n s1 -> do
1278+ return (Continue n (Tuple3' s1 0 (Right fs)))
1216-- | See 'Streamly.Internal.Data.Parser.die'.
1280-- | See 'Streamly.Internal.Data.Parser.die'.
1218-- /Pre-release/
1282-- /Pre-release/
1220{-# INLINE_NORMAL die #-}
1284{-# INLINE_NORMAL die #-}
1221−die :: MonadThrow m => String -> Parser m a b
1285+die :: Monad m => String -> Parser m a b
1222die err = Parser undefined (pure (IError err)) undefined
1286die err = Parser undefined (pure (IError err)) undefined
1224-- | See 'Streamly.Internal.Data.Parser.dieM'.
1288-- | See 'Streamly.Internal.Data.Parser.dieM'.
@@ -1226,7 +1290,7 @@ die err = Parser undefined (pure (IError err)) undefined
1226-- /Pre-release/
1290-- /Pre-release/
1228{-# INLINE dieM #-}
1292{-# INLINE dieM #-}
1229−dieM :: MonadThrow m => m String -> Parser m a b
1293+dieM :: Monad m => m String -> Parser m a b
1230dieM err = Parser undefined (IError <$> err) undefined
1294dieM err = Parser undefined (IError <$> err) undefined
1232-- Note: The default implementations of "some" and "many" loop infinitely
1296-- Note: The default implementations of "some" and "many" loop infinitely
@@ -1245,7 +1309,7 @@ dieM err = Parser undefined (IError <$> err) undefined
1245-- >>> Stream.parse (Parser.satisfy (> 0) <|> undefined) $ Stream.fromList [1..10]
1309-- >>> Stream.parse (Parser.satisfy (> 0) <|> undefined) $ Stream.fromList [1..10]
1248−instance MonadCatch m => Alternative (Parser m a) where
1312+instance Monad m => Alternative (Parser m a) where
1249 {-# INLINE empty #-}
1313 {-# INLINE empty #-}
1250 empty = die "empty"
1314 empty = die "empty"
@@ -1261,14 +1325,14 @@ instance MonadCatch m => Alternative (Parser m a) where
1261{-# ANN type ConcatParseState Fuse #-}
1325{-# ANN type ConcatParseState Fuse #-}
1262data ConcatParseState sl m a b =
1326data ConcatParseState sl m a b =
1263 ConcatParseL sl
1327 ConcatParseL sl
1264− | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m b)
1328+ | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Step s b))
1266-- | See 'Streamly.Internal.Data.Parser.concatMap'.
1330-- | See 'Streamly.Internal.Data.Parser.concatMap'.
1268-- /Pre-release/
1332-- /Pre-release/
1270{-# INLINE concatMap #-}
1334{-# INLINE concatMap #-}
1271−concatMap :: MonadThrow m =>
1335+concatMap :: Monad m =>
1272 (b -> Parser m a c) -> Parser m a b -> Parser m a c
1336 (b -> Parser m a c) -> Parser m a b -> Parser m a c
1273concatMap func (Parser stepL initialL extractL) = Parser step initial extract
1337concatMap func (Parser stepL initialL extractL) = Parser step initial extract
@@ -1314,18 +1378,28 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract
1314 Error err -> Error err
1378 Error err -> Error err
1316 {-# INLINE extractP #-}
1380 {-# INLINE extractP #-}
1317− extractP (Parser _ initialR extractR) = do
1381+ extractP n (Parser stepR initialR extractR) = do
1318 res <- initialR
1382 res <- initialR
1319 case res of
1383 case res of
1320− IPartial s -> extractR s
1384+ IPartial s ->
1386+ (first (\s1 -> ConcatParseR stepR s1 extractR))
1321− IDone b -> return b
1388+ IDone b -> return (Done n b)
1322− IError err -> throwM $ ParseError err
1389+ IError err -> return $ Error err
1324− extract (ConcatParseR _ s extractR) = extractR s
1391+ extract (ConcatParseR stepR s extractR) =
1392+ fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)
1325− extract (ConcatParseL sL) = extractL sL >>= extractP . func
1393+ extract (ConcatParseL sL) = do
1396+ Error err -> return $ Error err
1397+ Done n b -> extractP n $ func b
1398+ Partial _ _ -> error "concatMap: extract Partial"
1399+ Continue n s -> return $ Continue n (ConcatParseL s)
1327{-# INLINE noErrorUnsafeConcatMap #-}
1401{-# INLINE noErrorUnsafeConcatMap #-}
1328−noErrorUnsafeConcatMap :: MonadThrow m =>
1402+noErrorUnsafeConcatMap :: Monad m =>
1329 (b -> Parser m a c) -> Parser m a b -> Parser m a c
1403 (b -> Parser m a c) -> Parser m a b -> Parser m a c
1330noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =
1404noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =
1331 Parser step initial extract
1405 Parser step initial extract
@@ -1372,15 +1446,25 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =
1372 Error err -> Error err
1446 Error err -> Error err
1374 {-# INLINE extractP #-}
1448 {-# INLINE extractP #-}
1375− extractP (Parser _ initialR extractR) = do
1449+ extractP n (Parser stepR initialR extractR) = do
1376 res <- initialR
1450 res <- initialR
1377 case res of
1451 case res of
1378− IPartial s -> extractR s
1452+ IPartial s ->
1454+ (first (\s1 -> ConcatParseR stepR s1 extractR))
1379− IDone b -> return b
1456+ IDone b -> return (Done n b)
1380− IError err -> throwM $ ParseError err
1457+ IError err -> return $ Error err
1382− extract (ConcatParseR _ s extractR) = extractR s
1459+ extract (ConcatParseR stepR s extractR) =
1460+ fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)
1383− extract (ConcatParseL sL) = extractL sL >>= extractP . func
1461+ extract (ConcatParseL sL) = do
1464+ Error err -> return $ Error err
1465+ Done n b -> extractP n $ func b
1466+ Partial _ _ -> error "concatMap: extract Partial"
1467+ Continue n s -> return $ Continue n (ConcatParseL s)
1385-- Note: The monad instance has quadratic performance complexity. It works fine
1469-- Note: The monad instance has quadratic performance complexity. It works fine
1386-- for small number of compositions but for a scalable implementation we need a
1470-- for small number of compositions but for a scalable implementation we need a
@@ -1388,7 +1472,7 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =
1389-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
1473-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
1391−instance MonadThrow m => Monad (Parser m a) where
1475+instance Monad m => Monad (Parser m a) where
1392 {-# INLINE return #-}
1476 {-# INLINE return #-}
1393 return = pure
1477 return = pure
@@ -1400,14 +1484,14 @@ instance MonadThrow m => Monad (Parser m a) where
1401-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
1485-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
1403−instance MonadCatch m => MonadPlus (Parser m a) where
1487+instance Monad m => MonadPlus (Parser m a) where
1404 {-# INLINE mzero #-}
1488 {-# INLINE mzero #-}
1405 mzero = die "mzero"
1489 mzero = die "mzero"
1407 {-# INLINE mplus #-}
1491 {-# INLINE mplus #-}
1408 mplus = alt
1492 mplus = alt
1410−instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where
1494+instance (Monad m, MonadReader r m) => MonadReader r (Parser m a) where
1411 {-# INLINE ask #-}
1495 {-# INLINE ask #-}
1412 ask = fromEffect ask
1496 ask = fromEffect ask
@@ -1417,14 +1501,14 @@ instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser
1417 (local f init')
1501 (local f init')
1418 (local f . extract)
1502 (local f . extract)
1420−instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
1504+instance (Monad m, MonadState s m) => MonadState s (Parser m a) where
1421 {-# INLINE get #-}
1505 {-# INLINE get #-}
1422 get = fromEffect get
1506 get = fromEffect get
1424 {-# INLINE put #-}
1508 {-# INLINE put #-}
1425 put = fromEffect . put
1509 put = fromEffect . put
1427−instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
1511+instance (Monad m, MonadIO m) => MonadIO (Parser m a) where
1428 {-# INLINE liftIO #-}
1512 {-# INLINE liftIO #-}
1429 liftIO = fromEffect . liftIO
1513 liftIO = fromEffect . liftIO