git.iko.soy/streamly
on master help sign in
Move toParserK and fromParserK routines from ParserK to the ParserD module
f31f28cRanjeet Kumar Ranjan
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+3−3
compare with master
unifiedsplit
@@ -60,18 +60,18 @@ benchIOSink value name f =
60-------------------------------------------------------------------------------
60-------------------------------------------------------------------------------
61
61
62#ifdef FROM_PARSERK
62#ifdef FROM_PARSERK
63−#define PARSE_OP (IP.parseD . PR.fromParserK)
63+#define PARSE_OP (IP.parseD . PRD.fromParserK)
64#else
64#else
65#define PARSE_OP IP.parseK
65#define PARSE_OP IP.parseK
66#endif
66#endif
67
67
68{-# INLINE satisfy #-}
68{-# INLINE satisfy #-}
69satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
69satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
70−satisfy = PR.toParserK . PRD.satisfy
70+satisfy = PRD.toParserK . PRD.satisfy
71
71
72{-# INLINE takeWhile #-}
72{-# INLINE takeWhile #-}
73takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
73takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
74−takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
74+takeWhile p = PRD.toParserK $ PRD.takeWhile p FL.drain
75
75
76{-# INLINE takeWhileK #-}
76{-# INLINE takeWhileK #-}
77takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
77takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
core/src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs+1−2
@@ -70,7 +70,6 @@ import qualified Streamly.Internal.Data.Array.Foreign as Array
70import qualified Streamly.Internal.Data.Fold as Fold
70import qualified Streamly.Internal.Data.Fold as Fold
71import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
71import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
72import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD
72import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD
73−import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK
74import qualified Streamly.Internal.Data.Parser as Parser
73import qualified Streamly.Internal.Data.Parser as Parser
75
74
76import Prelude hiding (concatMap, take)
75import Prelude hiding (concatMap, take)
@@ -180,7 +179,7 @@ fromParserD (ParserD.Parser step1 initial1 extract1) =
180{-# INLINE fromParser #-}
179{-# INLINE fromParser #-}
181fromParser :: forall m a b. (MonadThrow m, MonadIO m, Storable a) =>
180fromParser :: forall m a b. (MonadThrow m, MonadIO m, Storable a) =>
182 Parser.Parser m a b -> Fold m a b
181 Parser.Parser m a b -> Fold m a b
183−fromParser = fromParserD . ParserK.fromParserK
182+fromParser = fromParserD . ParserD.fromParserK
184
183
185-- | Adapt an array stream fold.
184-- | Adapt an array stream fold.
186--
185--
core/src/Streamly/Internal/Data/Parser.hs+47−47
@@ -237,7 +237,7 @@ import qualified Streamly.Internal.Data.Parser.ParserK.Type as K
237--
237--
238{-# INLINE toFold #-}
238{-# INLINE toFold #-}
239toFold :: MonadThrow m => Parser m a b -> Fold m a b
239toFold :: MonadThrow m => Parser m a b -> Fold m a b
240−toFold p = D.toFold $ K.fromParserK p
240+toFold p = D.toFold $ D.fromParserK p
241
241
242-------------------------------------------------------------------------------
242-------------------------------------------------------------------------------
243-- Upgrade folds to parses
243-- Upgrade folds to parses
@@ -249,7 +249,7 @@ toFold p = D.toFold $ K.fromParserK p
249--
249--
250{-# INLINE fromFold #-}
250{-# INLINE fromFold #-}
251fromFold :: MonadCatch m => Fold m a b -> Parser m a b
251fromFold :: MonadCatch m => Fold m a b -> Parser m a b
252−fromFold = K.toParserK . D.fromFold
252+fromFold = D.toParserK . D.fromFold
253
253
254-------------------------------------------------------------------------------
254-------------------------------------------------------------------------------
255-- Terminating but not failing folds
255-- Terminating but not failing folds
@@ -263,9 +263,9 @@ fromFold = K.toParserK . D.fromFold
263--
263--
264{-# INLINE [3] fromPure #-}
264{-# INLINE [3] fromPure #-}
265fromPure :: MonadCatch m => b -> Parser m a b
265fromPure :: MonadCatch m => b -> Parser m a b
266−fromPure = K.toParserK . D.fromPure
266+fromPure = D.toParserK . D.fromPure
267{-# RULES "fromPure fallback to CPS" [2]
267{-# RULES "fromPure fallback to CPS" [2]
268− forall a. K.toParserK (D.fromPure a) = K.fromPure a #-}
268+ forall a. D.toParserK (D.fromPure a) = K.fromPure a #-}
269
269
270-- This is the dual of stream "fromEffect".
270-- This is the dual of stream "fromEffect".
271--
271--
@@ -276,7 +276,7 @@ fromPure = K.toParserK . D.fromPure
276--
276--
277{-# INLINE fromEffect #-}
277{-# INLINE fromEffect #-}
278fromEffect :: MonadCatch m => m b -> Parser m a b
278fromEffect :: MonadCatch m => m b -> Parser m a b
279−fromEffect = K.fromEffect -- K.toParserK . D.fromEffect
279+fromEffect = K.fromEffect -- D.toParserK . D.fromEffect
280
280
281-- This is the dual of "nil".
281-- This is the dual of "nil".
282--
282--
@@ -287,9 +287,9 @@ fromEffect = K.fromEffect -- K.toParserK . D.fromEffect
287--
287--
288{-# INLINE [3] die #-}
288{-# INLINE [3] die #-}
289die :: MonadCatch m => String -> Parser m a b
289die :: MonadCatch m => String -> Parser m a b
290−die = K.toParserK . D.die
290+die = D.toParserK . D.die
291{-# RULES "die fallback to CPS" [2]
291{-# RULES "die fallback to CPS" [2]
292− forall a. K.toParserK (D.die a) = K.die a #-}
292+ forall a. D.toParserK (D.die a) = K.die a #-}
293
293
294-- This is the dual of "nilM".
294-- This is the dual of "nilM".
295--
295--
@@ -300,7 +300,7 @@ die = K.toParserK . D.die
300--
300--
301{-# INLINE dieM #-}
301{-# INLINE dieM #-}
302dieM :: MonadCatch m => m String -> Parser m a b
302dieM :: MonadCatch m => m String -> Parser m a b
303−dieM = K.toParserK . D.dieM
303+dieM = D.toParserK . D.dieM
304
304
305-------------------------------------------------------------------------------
305-------------------------------------------------------------------------------
306-- Failing Parsers
306-- Failing Parsers
@@ -320,7 +320,7 @@ dieM = K.toParserK . D.dieM
320--
320--
321{-# INLINE peek #-}
321{-# INLINE peek #-}
322peek :: MonadCatch m => Parser m a a
322peek :: MonadCatch m => Parser m a a
323−peek = K.toParserK D.peek
323+peek = D.toParserK D.peek
324
324
325-- | Succeeds if we are at the end of input, fails otherwise.
325-- | Succeeds if we are at the end of input, fails otherwise.
326--
326--
@@ -331,7 +331,7 @@ peek = K.toParserK D.peek
331--
331--
332{-# INLINE eof #-}
332{-# INLINE eof #-}
333eof :: MonadCatch m => Parser m a ()
333eof :: MonadCatch m => Parser m a ()
334−eof = K.toParserK D.eof
334+eof = D.toParserK D.eof
335
335
336-- | Returns the next element if it passes the predicate, fails otherwise.
336-- | Returns the next element if it passes the predicate, fails otherwise.
337--
337--
@@ -342,7 +342,7 @@ eof = K.toParserK D.eof
342--
342--
343{-# INLINE satisfy #-}
343{-# INLINE satisfy #-}
344satisfy :: MonadCatch m => (a -> Bool) -> Parser m a a
344satisfy :: MonadCatch m => (a -> Bool) -> Parser m a a
345−satisfy = K.toParserK . D.satisfy
345+satisfy = D.toParserK . D.satisfy
346
346
347-- | Return the next element of the input. Returns 'Nothing'
347-- | Return the next element of the input. Returns 'Nothing'
348-- on end of input. Also known as 'head'.
348-- on end of input. Also known as 'head'.
@@ -351,7 +351,7 @@ satisfy = K.toParserK . D.satisfy
351--
351--
352{-# INLINE next #-}
352{-# INLINE next #-}
353next :: MonadCatch m => Parser m a (Maybe a)
353next :: MonadCatch m => Parser m a (Maybe a)
354−next = K.toParserK D.next
354+next = D.toParserK D.next
355
355
356-- | Map a 'Maybe' returning function on the next element in the stream. The
356-- | Map a 'Maybe' returning function on the next element in the stream. The
357-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
357-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
@@ -361,7 +361,7 @@ next = K.toParserK D.next
361--
361--
362{-# INLINE maybe #-}
362{-# INLINE maybe #-}
363maybe :: MonadCatch m => (a -> Maybe b) -> Parser m a b
363maybe :: MonadCatch m => (a -> Maybe b) -> Parser m a b
364−maybe = K.toParserK . D.maybe
364+maybe = D.toParserK . D.maybe
365
365
366-- | Map an 'Either' returning function on the next element in the stream. If
366-- | Map an 'Either' returning function on the next element in the stream. If
367-- the function returns 'Left err', the parser fails with the error message
367-- the function returns 'Left err', the parser fails with the error message
@@ -371,7 +371,7 @@ maybe = K.toParserK . D.maybe
371--
371--
372{-# INLINE either #-}
372{-# INLINE either #-}
373either :: MonadCatch m => (a -> Either String b) -> Parser m a b
373either :: MonadCatch m => (a -> Either String b) -> Parser m a b
374−either = K.toParserK . D.either
374+either = D.toParserK . D.either
375
375
376-------------------------------------------------------------------------------
376-------------------------------------------------------------------------------
377-- Taking elements
377-- Taking elements
@@ -423,7 +423,7 @@ either = K.toParserK . D.either
423{-# INLINE takeBetween #-}
423{-# INLINE takeBetween #-}
424takeBetween :: MonadCatch m =>
424takeBetween :: MonadCatch m =>
425 Int -> Int -> Fold m a b -> Parser m a b
425 Int -> Int -> Fold m a b -> Parser m a b
426−takeBetween m n = K.toParserK . D.takeBetween m n
426+takeBetween m n = D.toParserK . D.takeBetween m n
427
427
428-- | Stops after taking exactly @n@ input elements.
428-- | Stops after taking exactly @n@ input elements.
429--
429--
@@ -438,7 +438,7 @@ takeBetween m n = K.toParserK . D.takeBetween m n
438--
438--
439{-# INLINE takeEQ #-}
439{-# INLINE takeEQ #-}
440takeEQ :: MonadCatch m => Int -> Fold m a b -> Parser m a b
440takeEQ :: MonadCatch m => Int -> Fold m a b -> Parser m a b
441−takeEQ n = K.toParserK . D.takeEQ n
441+takeEQ n = D.toParserK . D.takeEQ n
442
442
443-- | Take at least @n@ input elements, but can collect more.
443-- | Take at least @n@ input elements, but can collect more.
444--
444--
@@ -456,7 +456,7 @@ takeEQ n = K.toParserK . D.takeEQ n
456--
456--
457{-# INLINE takeGE #-}
457{-# INLINE takeGE #-}
458takeGE :: MonadCatch m => Int -> Fold m a b -> Parser m a b
458takeGE :: MonadCatch m => Int -> Fold m a b -> Parser m a b
459−takeGE n = K.toParserK . D.takeGE n
459+takeGE n = D.toParserK . D.takeGE n
460
460
461-- $takeWhile
461-- $takeWhile
462-- Note: This is called @takeWhileP@ and @munch@ in some parser libraries.
462-- Note: This is called @takeWhileP@ and @munch@ in some parser libraries.
@@ -480,7 +480,7 @@ takeGE n = K.toParserK . D.takeGE n
480{-# INLINE takeWhileP #-}
480{-# INLINE takeWhileP #-}
481takeWhileP :: -- MonadCatch m =>
481takeWhileP :: -- MonadCatch m =>
482 (a -> Bool) -> Parser m a b -> Parser m a b
482 (a -> Bool) -> Parser m a b -> Parser m a b
483−takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond
483+takeWhileP _cond = undefined -- D.toParserK . D.takeWhileP cond
484
484
485-- | Collect stream elements until an element fails the predicate. The element
485-- | Collect stream elements until an element fails the predicate. The element
486-- on which the predicate fails is returned back to the input stream.
486-- on which the predicate fails is returned back to the input stream.
@@ -501,7 +501,7 @@ takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond
501--
501--
502{-# INLINE takeWhile #-}
502{-# INLINE takeWhile #-}
503takeWhile :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
503takeWhile :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
504−takeWhile cond = K.toParserK . D.takeWhile cond
504+takeWhile cond = D.toParserK . D.takeWhile cond
505
505
506-- | Like 'takeWhile' but takes at least one element otherwise fails.
506-- | Like 'takeWhile' but takes at least one element otherwise fails.
507--
507--
@@ -509,7 +509,7 @@ takeWhile cond = K.toParserK . D.takeWhile cond
509--
509--
510{-# INLINE takeWhile1 #-}
510{-# INLINE takeWhile1 #-}
511takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
511takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
512−takeWhile1 cond = K.toParserK . D.takeWhile1 cond
512+takeWhile1 cond = D.toParserK . D.takeWhile1 cond
513
513
514-- | Drain the input as long as the predicate succeeds, running the effects and
514-- | Drain the input as long as the predicate succeeds, running the effects and
515-- discarding the results.
515-- discarding the results.
@@ -539,7 +539,7 @@ drainWhile p = takeWhile p FL.drain
539sliceSepByP ::
539sliceSepByP ::
540 MonadCatch m =>
540 MonadCatch m =>
541 (a -> Bool) -> Parser m a b -> Parser m a b
541 (a -> Bool) -> Parser m a b -> Parser m a b
542−sliceSepByP cond = K.toParserK . D.sliceSepByP cond . K.fromParserK
542+sliceSepByP cond = D.toParserK . D.sliceSepByP cond . D.fromParserK
543
543
544-- | Like 'sliceSepBy' but does not drop the separator element, instead
544-- | Like 'sliceSepBy' but does not drop the separator element, instead
545-- separator is emitted as a separate element in the output.
545-- separator is emitted as a separate element in the output.
@@ -548,7 +548,7 @@ sliceSepByP cond = K.toParserK . D.sliceSepByP cond . K.fromParserK
548{-# INLINE sliceSepWith #-}
548{-# INLINE sliceSepWith #-}
549sliceSepWith :: -- MonadCatch m =>
549sliceSepWith :: -- MonadCatch m =>
550 (a -> Bool) -> Fold m a b -> Parser m a b
550 (a -> Bool) -> Fold m a b -> Parser m a b
551−sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
551+sliceSepWith _cond = undefined -- D.toParserK . D.sliceSepBy cond
552
552
553-- | Collect stream elements until an elements passes the predicate, return the
553-- | Collect stream elements until an elements passes the predicate, return the
554-- last element on which the predicate succeeded back to the input stream. If
554-- last element on which the predicate succeeded back to the input stream. If
@@ -588,7 +588,7 @@ sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
588sliceBeginWith ::
588sliceBeginWith ::
589 MonadCatch m =>
589 MonadCatch m =>
590 (a -> Bool) -> Fold m a b -> Parser m a b
590 (a -> Bool) -> Fold m a b -> Parser m a b
591−sliceBeginWith cond = K.toParserK . D.sliceBeginWith cond
591+sliceBeginWith cond = D.toParserK . D.sliceBeginWith cond
592
592
593-- | Like 'sliceSepBy' but the separator elements can be escaped using an
593-- | Like 'sliceSepBy' but the separator elements can be escaped using an
594-- escape char determined by the second predicate.
594-- escape char determined by the second predicate.
@@ -598,7 +598,7 @@ sliceBeginWith cond = K.toParserK . D.sliceBeginWith cond
598escapedSliceSepBy :: -- MonadCatch m =>
598escapedSliceSepBy :: -- MonadCatch m =>
599 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
599 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
600escapedSliceSepBy _cond _esc = undefined
600escapedSliceSepBy _cond _esc = undefined
601− -- K.toParserK . D.escapedSliceSepBy cond esc
601+ -- D.toParserK . D.escapedSliceSepBy cond esc
602
602
603-- | @escapedFrameBy begin end escape@ parses a string framed using @begin@ and
603-- | @escapedFrameBy begin end escape@ parses a string framed using @begin@ and
604-- @end@ as the frame begin and end marker elements and @escape@ as an escaping
604-- @end@ as the frame begin and end marker elements and @escape@ as an escaping
@@ -627,7 +627,7 @@ escapedSliceSepBy _cond _esc = undefined
627escapedFrameBy :: -- MonadCatch m =>
627escapedFrameBy :: -- MonadCatch m =>
628 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
628 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
629escapedFrameBy _begin _end _escape _p = undefined
629escapedFrameBy _begin _end _escape _p = undefined
630− -- K.toParserK . D.frameBy begin end escape p
630+ -- D.toParserK . D.frameBy begin end escape p
631
631
632-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
632-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
633-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
633-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
@@ -643,7 +643,7 @@ escapedFrameBy _begin _end _escape _p = undefined
643--
643--
644{-# INLINE wordBy #-}
644{-# INLINE wordBy #-}
645wordBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
645wordBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
646−wordBy f = K.toParserK . D.wordBy f
646+wordBy f = D.toParserK . D.wordBy f
647
647
648-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
648-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
649-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
649-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
@@ -675,7 +675,7 @@ wordBy f = K.toParserK . D.wordBy f
675--
675--
676{-# INLINE groupBy #-}
676{-# INLINE groupBy #-}
677groupBy :: MonadCatch m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
677groupBy :: MonadCatch m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
678−groupBy eq = K.toParserK . D.groupBy eq
678+groupBy eq = D.toParserK . D.groupBy eq
679
679
680-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
680-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
681-- successive elements in the input stream. Assuming the input stream to the
681-- successive elements in the input stream. Assuming the input stream to the
@@ -709,7 +709,7 @@ groupBy eq = K.toParserK . D.groupBy eq
709--
709--
710{-# INLINE groupByRolling #-}
710{-# INLINE groupByRolling #-}
711groupByRolling :: MonadCatch m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
711groupByRolling :: MonadCatch m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
712−groupByRolling eq = K.toParserK . D.groupByRolling eq
712+groupByRolling eq = D.toParserK . D.groupByRolling eq
713
713
714-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
714-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
715-- the first fold as long as the predicate holds 'True', if the predicate is
715-- the first fold as long as the predicate holds 'True', if the predicate is
@@ -724,7 +724,7 @@ groupByRolling eq = K.toParserK . D.groupByRolling eq
724{-# INLINE groupByRollingEither #-}
724{-# INLINE groupByRollingEither #-}
725groupByRollingEither :: MonadCatch m =>
725groupByRollingEither :: MonadCatch m =>
726 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
726 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
727−groupByRollingEither eq f1 = K.toParserK . D.groupByRollingEither eq f1
727+groupByRollingEither eq f1 = D.toParserK . D.groupByRollingEither eq f1
728
728
729-- | Match the given sequence of elements using the given comparison function.
729-- | Match the given sequence of elements using the given comparison function.
730--
730--
@@ -737,7 +737,7 @@ groupByRollingEither eq f1 = K.toParserK . D.groupByRollingEither eq f1
737--
737--
738{-# INLINE eqBy #-}
738{-# INLINE eqBy #-}
739eqBy :: MonadCatch m => (a -> a -> Bool) -> [a] -> Parser m a ()
739eqBy :: MonadCatch m => (a -> a -> Bool) -> [a] -> Parser m a ()
740−eqBy cmp = K.toParserK . D.eqBy cmp
740+eqBy cmp = D.toParserK . D.eqBy cmp
741
741
742-------------------------------------------------------------------------------
742-------------------------------------------------------------------------------
743-- nested parsers
743-- nested parsers
@@ -789,7 +789,7 @@ eqBy cmp = K.toParserK . D.eqBy cmp
789serialWith :: MonadCatch m
789serialWith :: MonadCatch m
790 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
790 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
791serialWith f p1 p2 =
791serialWith f p1 p2 =
792− K.toParserK $ D.serialWith f (K.fromParserK p1) (K.fromParserK p2)
792+ D.toParserK $ D.serialWith f (D.fromParserK p1) (D.fromParserK p2)
793
793
794-- | Sequential parser application ignoring the output of the first parser.
794-- | Sequential parser application ignoring the output of the first parser.
795-- Apply two parsers sequentially to an input stream. The input is provided to
795-- Apply two parsers sequentially to an input stream. The input is provided to
@@ -813,7 +813,7 @@ serialWith f p1 p2 =
813--
813--
814{-# INLINE split_ #-}
814{-# INLINE split_ #-}
815split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b
815split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b
816−split_ p1 p2 = K.toParserK $ D.split_ (K.fromParserK p1) (K.fromParserK p2)
816+split_ p1 p2 = D.toParserK $ D.split_ (D.fromParserK p1) (D.fromParserK p2)
817
817
818-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both
818-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both
819-- of them succeed or anyone of them fails and combines their output using @f@.
819-- of them succeed or anyone of them fails and combines their output using @f@.
@@ -825,7 +825,7 @@ split_ p1 p2 = K.toParserK $ D.split_ (K.fromParserK p1) (K.fromParserK p2)
825teeWith :: MonadCatch m
825teeWith :: MonadCatch m
826 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
826 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
827teeWith f p1 p2 =
827teeWith f p1 p2 =
828− K.toParserK $ D.teeWith f (K.fromParserK p1) (K.fromParserK p2)
828+ D.toParserK $ D.teeWith f (D.fromParserK p1) (D.fromParserK p2)
829
829
830-- | Like 'teeWith' but ends parsing and zips the results, if available,
830-- | Like 'teeWith' but ends parsing and zips the results, if available,
831-- whenever the first parser ends.
831-- whenever the first parser ends.
@@ -836,7 +836,7 @@ teeWith f p1 p2 =
836teeWithFst :: MonadCatch m
836teeWithFst :: MonadCatch m
837 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
837 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
838teeWithFst f p1 p2 =
838teeWithFst f p1 p2 =
839− K.toParserK $ D.teeWithFst f (K.fromParserK p1) (K.fromParserK p2)
839+ D.toParserK $ D.teeWithFst f (D.fromParserK p1) (D.fromParserK p2)
840
840
841-- | Like 'teeWith' but ends parsing and zips the results, if available,
841-- | Like 'teeWith' but ends parsing and zips the results, if available,
842-- whenever any of the parsers ends or fails.
842-- whenever any of the parsers ends or fails.
@@ -847,7 +847,7 @@ teeWithFst f p1 p2 =
847teeWithMin :: MonadCatch m
847teeWithMin :: MonadCatch m
848 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
848 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
849teeWithMin f p1 p2 =
849teeWithMin f p1 p2 =
850− K.toParserK $ D.teeWithMin f (K.fromParserK p1) (K.fromParserK p2)
850+ D.toParserK $ D.teeWithMin f (D.fromParserK p1) (D.fromParserK p2)
851
851
852-- | Sequential alternative. Apply the input to the first parser and return the
852-- | Sequential alternative. Apply the input to the first parser and return the
853-- result if the parser succeeds. If the first parser fails then backtrack and
853-- result if the parser succeeds. If the first parser fails then backtrack and
@@ -868,7 +868,7 @@ teeWithMin f p1 p2 =
868--
868--
869{-# INLINE alt #-}
869{-# INLINE alt #-}
870alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a
870alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a
871−alt p1 p2 = K.toParserK $ D.alt (K.fromParserK p1) (K.fromParserK p2)
871+alt p1 p2 = D.toParserK $ D.alt (D.fromParserK p1) (D.fromParserK p2)
872
872
873-- | Shortest alternative. Apply both parsers in parallel but choose the result
873-- | Shortest alternative. Apply both parsers in parallel but choose the result
874-- from the one which consumed least input i.e. take the shortest succeeding
874-- from the one which consumed least input i.e. take the shortest succeeding
@@ -879,7 +879,7 @@ alt p1 p2 = K.toParserK $ D.alt (K.fromParserK p1) (K.fromParserK p2)
879{-# INLINE shortest #-}
879{-# INLINE shortest #-}
880shortest :: MonadCatch m
880shortest :: MonadCatch m
881 => Parser m x a -> Parser m x a -> Parser m x a
881 => Parser m x a -> Parser m x a -> Parser m x a
882−shortest p1 p2 = K.toParserK $ D.shortest (K.fromParserK p1) (K.fromParserK p2)
882+shortest p1 p2 = D.toParserK $ D.shortest (D.fromParserK p1) (D.fromParserK p2)
883
883
884-- | Longest alternative. Apply both parsers in parallel but choose the result
884-- | Longest alternative. Apply both parsers in parallel but choose the result
885-- from the one which consumed more input i.e. take the longest succeeding
885-- from the one which consumed more input i.e. take the longest succeeding
@@ -890,7 +890,7 @@ shortest p1 p2 = K.toParserK $ D.shortest (K.fromParserK p1) (K.fromParserK p2)
890{-# INLINE longest #-}
890{-# INLINE longest #-}
891longest :: MonadCatch m
891longest :: MonadCatch m
892 => Parser m x a -> Parser m x a -> Parser m x a
892 => Parser m x a -> Parser m x a -> Parser m x a
893−longest p1 p2 = K.toParserK $ D.longest (K.fromParserK p1) (K.fromParserK p2)
893+longest p1 p2 = D.toParserK $ D.longest (D.fromParserK p1) (D.fromParserK p2)
894
894
895-- | Run a parser without consuming the input.
895-- | Run a parser without consuming the input.
896--
896--
@@ -898,7 +898,7 @@ longest p1 p2 = K.toParserK $ D.longest (K.fromParserK p1) (K.fromParserK p2)
898--
898--
899{-# INLINE lookAhead #-}
899{-# INLINE lookAhead #-}
900lookAhead :: MonadCatch m => Parser m a b -> Parser m a b
900lookAhead :: MonadCatch m => Parser m a b -> Parser m a b
901−lookAhead p = K.toParserK $ D.lookAhead $ K.fromParserK p
901+lookAhead p = D.toParserK $ D.lookAhead $ D.fromParserK p
902
902
903-- | Takes at-most @n@ input elements.
903-- | Takes at-most @n@ input elements.
904--
904--
@@ -914,7 +914,7 @@ lookAhead p = K.toParserK $ D.lookAhead $ K.fromParserK p
914-- /Internal/
914-- /Internal/
915{-# INLINE takeP #-}
915{-# INLINE takeP #-}
916takeP :: MonadCatch m => Int -> Parser m a b -> Parser m a b
916takeP :: MonadCatch m => Int -> Parser m a b -> Parser m a b
917−takeP i p = K.toParserK $ D.takeP i $ K.fromParserK p
917+takeP i p = D.toParserK $ D.takeP i $ D.fromParserK p
918
918
919-------------------------------------------------------------------------------
919-------------------------------------------------------------------------------
920-- Interleaving
920-- Interleaving
@@ -982,7 +982,7 @@ concatSequence _f _p = undefined
982{-# INLINE concatMap #-}
982{-# INLINE concatMap #-}
983concatMap :: MonadCatch m
983concatMap :: MonadCatch m
984 => (b -> Parser m a c) -> Parser m a b -> Parser m a c
984 => (b -> Parser m a c) -> Parser m a b -> Parser m a c
985−concatMap f p = K.toParserK $ D.concatMap (K.fromParserK . f) (K.fromParserK p)
985+concatMap f p = D.toParserK $ D.concatMap (D.fromParserK . f) (D.fromParserK p)
986
986
987-------------------------------------------------------------------------------
987-------------------------------------------------------------------------------
988-- Alternative Collection
988-- Alternative Collection
@@ -998,7 +998,7 @@ concatMap f p = K.toParserK $ D.concatMap (K.fromParserK . f) (K.fromParserK p)
998{-# INLINE choice #-}
998{-# INLINE choice #-}
999choice ::
999choice ::
1000 (Functor t, Foldable t, MonadCatch m) => t (Parser m a b) -> Parser m a b
1000 (Functor t, Foldable t, MonadCatch m) => t (Parser m a b) -> Parser m a b
1001−choice ps = K.toParserK $ D.choice $ K.fromParserK <$> ps
1001+choice ps = D.toParserK $ D.choice $ D.fromParserK <$> ps
1002
1002
1003-------------------------------------------------------------------------------
1003-------------------------------------------------------------------------------
1004-- Sequential Repetition
1004-- Sequential Repetition
@@ -1017,7 +1017,7 @@ choice ps = K.toParserK $ D.choice $ K.fromParserK <$> ps
1017{-# INLINE manyP #-}
1017{-# INLINE manyP #-}
1018manyP :: -- MonadCatch m =>
1018manyP :: -- MonadCatch m =>
1019 Parser m a b -> Parser m b c -> Parser m a c
1019 Parser m a b -> Parser m b c -> Parser m a c
1020−manyP _p _f = undefined -- K.toParserK $ D.manyP (K.fromParserK p) f
1020+manyP _p _f = undefined -- D.toParserK $ D.manyP (D.fromParserK p) f
1021
1021
1022-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
1022-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
1023-- input stream and push the parse results to a downstream fold.
1023-- input stream and push the parse results to a downstream fold.
@@ -1031,7 +1031,7 @@ manyP _p _f = undefined -- K.toParserK $ D.manyP (K.fromParserK p) f
1031--
1031--
1032{-# INLINE many #-}
1032{-# INLINE many #-}
1033many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1033many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1034−many p f = K.toParserK $ D.many (K.fromParserK p) f
1034+many p f = D.toParserK $ D.many (D.fromParserK p) f
1035-- many = countBetween 0 maxBound
1035-- many = countBetween 0 maxBound
1036
1036
1037-- Note: many1 would perhaps be a better name for this and consistent with
1037-- Note: many1 would perhaps be a better name for this and consistent with
@@ -1052,7 +1052,7 @@ many p f = K.toParserK $ D.many (K.fromParserK p) f
1052--
1052--
1053{-# INLINE some #-}
1053{-# INLINE some #-}
1054some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1054some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1055−some p f = K.toParserK $ D.some (K.fromParserK p) f
1055+some p f = D.toParserK $ D.some (D.fromParserK p) f
1056-- some p f = manyP p (takeGE 1 f)
1056-- some p f = manyP p (takeGE 1 f)
1057-- many = countBetween 1 maxBound
1057-- many = countBetween 1 maxBound
1058
1058
@@ -1097,7 +1097,7 @@ count n = countBetween n n
1097manyTillP :: -- MonadCatch m =>
1097manyTillP :: -- MonadCatch m =>
1098 Parser m a b -> Parser m a x -> Parser m b c -> Parser m a c
1098 Parser m a b -> Parser m a x -> Parser m b c -> Parser m a c
1099manyTillP _p1 _p2 _f = undefined
1099manyTillP _p1 _p2 _f = undefined
1100− -- K.toParserK $ D.manyTillP (K.fromParserK p1) (K.fromParserK p2) f
1100+ -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f
1101
1101
1102-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
1102-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
1103-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
1103-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
@@ -1113,7 +1113,7 @@ manyTillP _p1 _p2 _f = undefined
1113manyTill :: MonadCatch m
1113manyTill :: MonadCatch m
1114 => Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
1114 => Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
1115manyTill p1 p2 f =
1115manyTill p1 p2 f =
1116− K.toParserK $ D.manyTill f (K.fromParserK p1) (K.fromParserK p2)
1116+ D.toParserK $ D.manyTill f (D.fromParserK p1) (D.fromParserK p2)
1117
1117
1118-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
1118-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
1119-- collects the output in the supplied fold. If the the parser @collect@ fails,
1119-- collects the output in the supplied fold. If the the parser @collect@ fails,
core/src/Streamly/Internal/Data/Parser/ParserD.hs+4
@@ -18,6 +18,10 @@ module Streamly.Internal.Data.Parser.ParserD
18 , Initial (..)
18 , Initial (..)
19 , rmapM
19 , rmapM
20
20
21+ -- * Conversion to/from ParserK
22+ , fromParserK
23+ , toParserK
24+
21 -- * Downgrade to Fold
25 -- * Downgrade to Fold
22 , toFold
26 , toFold
23
27
core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+172−2
@@ -119,6 +119,10 @@ module Streamly.Internal.Data.Parser.ParserD.Type
119 , ParseError (..)
119 , ParseError (..)
120 , rmapM
120 , rmapM
121
121
122+ -- * Conversion to/from ParserK
123+ , fromParserK
124+ , toParserK
125+
122 -- * Constructors
126 -- * Constructors
123 , parser
127 , parser
124 , parserM
128 , parserM
@@ -151,10 +155,12 @@ import Control.Monad.State.Class (MonadState, get, put)
151import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
155import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
152import Data.Bifunctor (Bifunctor(..))
156import Data.Bifunctor (Bifunctor(..))
153import Fusion.Plugin.Types (Fuse(..))
157import Fusion.Plugin.Types (Fuse(..))
158+import Streamly.Internal.Control.Exception (assertM)
154import Streamly.Internal.Data.Fold.Type (Fold(..), toList)
159import Streamly.Internal.Data.Fold.Type (Fold(..), toList)
155import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))
160import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))
156
161
157import qualified Streamly.Internal.Data.Fold.Type as FL
162import qualified Streamly.Internal.Data.Fold.Type as FL
163+import qualified Streamly.Internal.Data.Parser.ParserK.Type as K
158
164
159import Prelude hiding (concatMap)
165import Prelude hiding (concatMap)
160--
166--
@@ -355,6 +361,170 @@ instance Functor m => Functor (Parser m a) where
355 step s b = fmap2 f (step1 s b)
361 step s b = fmap2 f (step1 s b)
356 fmap2 g = fmap (fmap g)
362 fmap2 g = fmap (fmap g)
357
363
364+-------------------------------------------------------------------------------
365+-- Convert direct style 'Parser' to CPS style 'K.Parser'
366+-------------------------------------------------------------------------------
367+
368+-- XXX Unlike the direct style folds/parsers, the initial action in CPS parsers
369+-- is not performed when the fold is initialized. It is performed when the
370+-- first element is processed by the fold or if no elements are processed then
371+-- at the extraction. We should either make the direct folds like this or make
372+-- the CPS folds behavior also like the direct ones.
373+--
374+-- | Convert a direct style parser ('D.Parser') to a CPS style parser
375+-- ('Parser').
376+--
377+{-# INLINE_NORMAL parseDToK #-}
378+parseDToK
379+ :: MonadCatch m
380+ => (s -> a -> m (Step s b))
381+ -> m (Initial s b)
382+ -> (s -> m b)
383+ -> Int
384+ -> (Int, Int)
385+ -> ((Int, Int) -> K.Parse b -> m (K.Driver m a r))
386+ -> m (K.Driver m a r)
387+
388+parseDToK pstep initial extract leftover (0, _) cont = do
389+ res <- initial
390+ case res of
391+ IPartial r -> return $ K.Continue leftover (parseCont (return r))
392+ IDone b -> cont (0,0) (K.Done 0 b)
393+ IError err -> cont (0,0) (K.Error err)
394+
395+ where
396+
397+ parseCont pst (Just x) = do
398+ r <- pst
399+ pRes <- pstep r x
400+ case pRes of
401+ Done n b -> cont (0,0) (K.Done n b)
402+ Error err -> cont (0,0) (K.Error err)
403+ Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))
404+ Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
405+
406+ parseCont acc Nothing = do
407+ pst <- acc
408+ r <- try $ extract pst
409+ case r of
410+ Left (e :: ParseError) -> cont (0,0) (K.Error (displayException e))
411+ Right b -> cont (0,0) (K.Done 0 b)
412+
413+parseDToK pstep initial extract leftover (level, count) cont = do
414+ res <- initial
415+ case res of
416+ IPartial r -> return $ K.Continue leftover (parseCont count (return r))
417+ IDone b -> cont (level,count) (K.Done 0 b)
418+ IError err -> cont (level,count) (K.Error err)
419+
420+ where
421+
422+ parseCont !cnt pst (Just x) = do
423+ let !cnt1 = cnt + 1
424+ r <- pst
425+ pRes <- pstep r x
426+ case pRes of
427+ Done n b -> do
428+ assert (n <= cnt1) (return ())
429+ cont (level, cnt1 - n) (K.Done n b)
430+ Error err ->
431+ cont (level, cnt1) (K.Error err)
432+ Partial n pst1 -> do
433+ assert (n <= cnt1) (return ())
434+ return $ K.Partial n (parseCont (cnt1 - n) (return pst1))
435+ Continue n pst1 -> do
436+ assert (n <= cnt1) (return ())
437+ return $ K.Continue n (parseCont (cnt1 - n) (return pst1))
438+ parseCont cnt acc Nothing = do
439+ pst <- acc
440+ r <- try $ extract pst
441+ let s = (level, cnt)
442+ case r of
443+ Left (e :: ParseError) -> cont s (K.Error (displayException e))
444+ Right b -> cont s (K.Done 0 b)
445+
446+-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
447+--
448+-- /Pre-release/
449+--
450+{-# INLINE_LATE toParserK #-}
451+toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
452+toParserK (Parser step initial extract) =
453+ K.MkParser $ parseDToK step initial extract
454+
455+-------------------------------------------------------------------------------
456+-- Convert CPS style 'Parser' to direct style 'D.Parser'
457+-------------------------------------------------------------------------------
458+
459+-- | A continuation to extract the result when a CPS parser is done.
460+{-# INLINE parserDone #-}
461+parserDone :: Monad m => (Int, Int) -> K.Parse b -> m (K.Driver m a b)
462+parserDone (0,_) (K.Done n b) = return $ K.Stop n b
463+parserDone st (K.Done _ _) =
464+ error $ "Bug: fromParserK: inside alternative: " ++ show st
465+parserDone _ (K.Error e) = return $ K.Failed e
466+
467+-- | When there is no more input to feed, extract the result from the Parser.
468+--
469+-- /Pre-release/
470+--
471+extractParse :: MonadThrow m => (Maybe a -> m (K.Driver m a b)) -> m b
472+extractParse cont = do
473+ r <- cont Nothing
474+ case r of
475+ K.Stop _ b -> return b
476+ K.Partial _ _ -> error "Bug: extractParse got Partial"
477+ K.Continue _ cont1 -> extractParse cont1
478+ K.Failed e -> throwM $ ParseError e
479+
480+data FromParserK b c = FPKDone !Int !b | FPKCont c
481+
482+-- | Convert a CPS style 'K.Parser' to a direct style 'Parser'.
483+--
484+-- "initial" returns a continuation which can be called one input at a time
485+-- using the "step" function.
486+--
487+-- /Pre-release/
488+--
489+{-# INLINE_LATE fromParserK #-}
490+fromParserK :: MonadThrow m => K.Parser m a b -> Parser m a b
491+fromParserK parser0 = Parser step initial extract
492+
493+ where
494+
495+ initial = do
496+ r <- K.runParser parser0 0 (0,0) parserDone
497+ return $ case r of
498+ K.Stop n b -> IPartial $ FPKDone n b
499+ K.Failed e -> IError e
500+ K.Partial _ cont -> IPartial $ FPKCont cont -- XXX can we get this?
501+ K.Continue _ cont -> IPartial $ FPKCont cont
502+
503+ -- Note, we can only reach FPKDone and FPKError from "initial". FPKCont
504+ -- always transitions to only FPKCont. The input remains unconsumed in
505+ -- this case so we use "n + 1".
506+ step (FPKDone n b) _ = do
507+ assertM (n == 0)
508+ return $ Done (n + 1) b
509+ step (FPKCont cont) a = do
510+ r <- cont (Just a)
511+ return $ case r of
512+ K.Stop n b -> Done n b
513+ K.Failed e -> Error e
514+ K.Partial n cont1 -> Partial n (FPKCont cont1)
515+ K.Continue n cont1 -> Continue n (FPKCont cont1)
516+
517+ -- Note, we can only reach FPKDone and FPKError from "initial".
518+ extract (FPKDone _ b) = return b
519+ extract (FPKCont cont) = extractParse cont
520+
521+#ifndef DISABLE_FUSION
522+{-# RULES "fromParserK/toParserK fusion" [2]
523+ forall s. toParserK (fromParserK s) = s #-}
524+{-# RULES "toParserK/fromParserK fusion" [2]
525+ forall s. fromParserK (toParserK s) = s #-}
526+#endif
527+
358------------------------------------------------------------------------------
528------------------------------------------------------------------------------
359-- General parser constructors
529-- General parser constructors
360------------------------------------------------------------------------------
530------------------------------------------------------------------------------
@@ -1160,20 +1330,20 @@ instance MonadCatch m => MonadPlus (Parser m a) where
1160instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where
1330instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where
1161 {-# INLINE ask #-}
1331 {-# INLINE ask #-}
1162 ask = fromEffect ask
1332 ask = fromEffect ask
1333+
1163 {-# INLINE local #-}
1334 {-# INLINE local #-}
1164 local f (Parser step init' extract) =
1335 local f (Parser step init' extract) =
1165 Parser ((local f .) . step)
1336 Parser ((local f .) . step)
1166 (local f init')
1337 (local f init')
1167 (local f . extract)
1338 (local f . extract)
1168
1339
1169−
1170instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
1340instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
1171 {-# INLINE get #-}
1341 {-# INLINE get #-}
1172 get = fromEffect get
1342 get = fromEffect get
1343+
1173 {-# INLINE put #-}
1344 {-# INLINE put #-}
1174 put = fromEffect . put
1345 put = fromEffect . put
1175
1346
1176−
1177instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
1347instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
1178 {-# INLINE liftIO #-}
1348 {-# INLINE liftIO #-}
1179 liftIO = fromEffect . liftIO
1349 liftIO = fromEffect . liftIO
core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+12−179
@@ -21,21 +21,18 @@
21
21
22module Streamly.Internal.Data.Parser.ParserK.Type
22module Streamly.Internal.Data.Parser.ParserK.Type
23 (
23 (
24+ Driver (..)
25+ , Parse (..)
24− Parser (..)
26+ , Parser (..)
25 , fromPure
27 , fromPure
26 , fromEffect
28 , fromEffect
27 , die
29 , die
28−
29− -- * Conversion
30− , toParserK
31− , fromParserK
32 )
30 )
33where
31where
34
32
35import Control.Applicative (Alternative(..), liftA2)
33import Control.Applicative (Alternative(..), liftA2)
36−import Control.Exception (assert, Exception(..))
37import Control.Monad (MonadPlus(..), ap)
34import Control.Monad (MonadPlus(..), ap)
38−import Control.Monad.Catch (MonadCatch, MonadThrow(..), try)
35+import Control.Monad.Catch (MonadCatch, MonadThrow(..))
39import Control.Monad.IO.Class (MonadIO, liftIO)
36import Control.Monad.IO.Class (MonadIO, liftIO)
40import Control.Monad.Reader.Class (MonadReader, ask, local)
37import Control.Monad.Reader.Class (MonadReader, ask, local)
41import Control.Monad.State.Class (MonadState, get, put)
38import Control.Monad.State.Class (MonadState, get, put)
@@ -45,9 +42,6 @@ import qualified Control.Monad.Fail as Fail
45#if !(MIN_VERSION_base(4,10,0))
42#if !(MIN_VERSION_base(4,10,0))
46import Data.Semigroup ((<>))
43import Data.Semigroup ((<>))
47#endif
44#endif
48−import Streamly.Internal.Control.Exception
49−
50−import qualified Streamly.Internal.Data.Parser.ParserD.Type as D
51
45
52-- | The parse driver result. The driver may stop with a final result, pause
46-- | The parse driver result. The driver may stop with a final result, pause
53-- with a continuation to resume, or fail with an error.
47-- with a continuation to resume, or fail with an error.
@@ -103,170 +97,6 @@ newtype Parser m a b = MkParser
103 -> m (Driver m a r)
97 -> m (Driver m a r)
104 }
98 }
105
99
106−-------------------------------------------------------------------------------
107−-- Convert direct style 'D.Parser' to CPS style 'Parser'
108−-------------------------------------------------------------------------------
109−
110−-- XXX Unlike the direct style folds/parsers, the initial action in CPS parsers
111−-- is not performed when the fold is initialized. It is performed when the
112−-- first element is processed by the fold or if no elements are processed then
113−-- at the extraction. We should either make the direct folds like this or make
114−-- the CPS folds behavior also like the direct ones.
115−--
116−-- | Convert a direct style parser ('D.Parser') to a CPS style parser
117−-- ('Parser').
118−--
119−{-# INLINE_NORMAL parseDToK #-}
120−parseDToK
121− :: MonadCatch m
122− => (s -> a -> m (D.Step s b))
123− -> m (D.Initial s b)
124− -> (s -> m b)
125− -> Int
126− -> (Int, Int)
127− -> ((Int, Int) -> Parse b -> m (Driver m a r))
128− -> m (Driver m a r)
129−
130−parseDToK pstep initial extract leftover (0, _) cont = do
131− res <- initial
132− case res of
133− D.IPartial r -> return $ Continue leftover (parseCont (return r))
134− D.IDone b -> cont (0,0) (Done 0 b)
135− D.IError err -> cont (0,0) (Error err)
136−
137− where
138−
139− parseCont pst (Just x) = do
140− r <- pst
141− pRes <- pstep r x
142− case pRes of
143− D.Done n b -> cont (0,0) (Done n b)
144− D.Error err -> cont (0,0) (Error err)
145− D.Partial n pst1 -> return $ Partial n (parseCont (return pst1))
146− D.Continue n pst1 -> return $ Continue n (parseCont (return pst1))
147−
148− parseCont acc Nothing = do
149− pst <- acc
150− r <- try $ extract pst
151− case r of
152− Left (e :: D.ParseError) -> cont (0,0) (Error (displayException e))
153− Right b -> cont (0,0) (Done 0 b)
154−
155−parseDToK pstep initial extract leftover (level, count) cont = do
156− res <- initial
157− case res of
158− D.IPartial r -> return $ Continue leftover (parseCont count (return r))
159− D.IDone b -> cont (level,count) (Done 0 b)
160− D.IError err -> cont (level,count) (Error err)
161−
162− where
163−
164− parseCont !cnt pst (Just x) = do
165− let !cnt1 = cnt + 1
166− r <- pst
167− pRes <- pstep r x
168− case pRes of
169− D.Done n b -> do
170− assert (n <= cnt1) (return ())
171− cont (level, cnt1 - n) (Done n b)
172− D.Error err ->
173− cont (level, cnt1) (Error err)
174− D.Partial n pst1 -> do
175− assert (n <= cnt1) (return ())
176− return $ Partial n (parseCont (cnt1 - n) (return pst1))
177− D.Continue n pst1 -> do
178− assert (n <= cnt1) (return ())
179− return $ Continue n (parseCont (cnt1 - n) (return pst1))
180− parseCont cnt acc Nothing = do
181− pst <- acc
182− r <- try $ extract pst
183− let s = (level, cnt)
184− case r of
185− Left (e :: D.ParseError) -> cont s (Error (displayException e))
186− Right b -> cont s (Done 0 b)
187−
188−-- | Convert a direct style 'D.Parser' to a CPS style 'Parser'.
189−--
190−-- /Pre-release/
191−--
192−{-# INLINE_LATE toParserK #-}
193−toParserK :: MonadCatch m => D.Parser m a b -> Parser m a b
194−toParserK (D.Parser step initial extract) =
195− MkParser $ parseDToK step initial extract
196−
197−-------------------------------------------------------------------------------
198−-- Convert CPS style 'Parser' to direct style 'D.Parser'
199−-------------------------------------------------------------------------------
200−
201−-- | A continuation to extract the result when a CPS parser is done.
202−{-# INLINE parserDone #-}
203−parserDone :: Monad m => (Int, Int) -> Parse b -> m (Driver m a b)
204−parserDone (0,_) (Done n b) = return $ Stop n b
205−parserDone st (Done _ _) =
206− error $ "Bug: fromParserK: inside alternative: " ++ show st
207−parserDone _ (Error e) = return $ Failed e
208−
209−-- | When there is no more input to feed, extract the result from the Parser.
210−--
211−-- /Pre-release/
212−--
213−extractParse :: MonadThrow m => (Maybe a -> m (Driver m a b)) -> m b
214−extractParse cont = do
215− r <- cont Nothing
216− case r of
217− Stop _ b -> return b
218− Partial _ _ -> error "Bug: extractParse got Partial"
219− Continue _ cont1 -> extractParse cont1
220− Failed e -> throwM $ D.ParseError e
221−
222−data FromParserK b c = FPKDone !Int !b | FPKCont c
223−
224−-- | Convert a CPS style 'Parser' to a direct style 'D.Parser'.
225−--
226−-- "initial" returns a continuation which can be called one input at a time
227−-- using the "step" function.
228−--
229−-- /Pre-release/
230−--
231−{-# INLINE_LATE fromParserK #-}
232−fromParserK :: MonadThrow m => Parser m a b -> D.Parser m a b
233−fromParserK parser = D.Parser step initial extract
234−
235− where
236−
237− initial = do
238− r <- runParser parser 0 (0,0) parserDone
239− return $ case r of
240− Stop n b -> D.IPartial $ FPKDone n b
241− Failed e -> D.IError e
242− Partial _ cont -> D.IPartial $ FPKCont cont -- XXX can we get this?
243− Continue _ cont -> D.IPartial $ FPKCont cont
244−
245− -- Note, we can only reach FPKDone and FPKError from "initial". FPKCont
246− -- always transitions to only FPKCont. The input remains unconsumed in
247− -- this case so we use "n + 1".
248− step (FPKDone n b) _ = do
249− assertM (n == 0)
250− return $ D.Done (n + 1) b
251− step (FPKCont cont) a = do
252− r <- cont (Just a)
253− return $ case r of
254− Stop n b -> D.Done n b
255− Failed e -> D.Error e
256− Partial n cont1 -> D.Partial n (FPKCont cont1)
257− Continue n cont1 -> D.Continue n (FPKCont cont1)
258−
259− -- Note, we can only reach FPKDone and FPKError from "initial".
260− extract (FPKDone _ b) = return b
261− extract (FPKCont cont) = extractParse cont
262−
263−#ifndef DISABLE_FUSION
264−{-# RULES "fromParserK/toParserK fusion" [2]
265− forall s. toParserK (fromParserK s) = s #-}
266−{-# RULES "toParserK/fromParserK fusion" [2]
267− forall s. fromParserK (toParserK s) = s #-}
268−#endif
269−
270-------------------------------------------------------------------------------
100-------------------------------------------------------------------------------
271-- Functor
101-- Functor
272-------------------------------------------------------------------------------
102-------------------------------------------------------------------------------
@@ -415,21 +245,24 @@ instance Monad m => Fail.MonadFail (Parser m a) where
415 fail = die
245 fail = die
416#endif
246#endif
417
247
418−instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where
248+instance (MonadThrow m, MonadReader r m, MonadCatch m) =>
249+ MonadReader r (Parser m a) where
250+
419 {-# INLINE ask #-}
251 {-# INLINE ask #-}
420 ask = fromEffect ask
252 ask = fromEffect ask
421− {-# INLINE local #-}
422− local f (fromParserK -> dp) =
423− toParserK $ local f dp
424
253
254+ {-# INLINE local #-}
255+ local f dp =
256+ MkParser $ \lo st yieldk ->
257+ local f $ runParser dp lo st yieldk
425
258
426instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
259instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
427 {-# INLINE get #-}
260 {-# INLINE get #-}
428 get = fromEffect get
261 get = fromEffect get
262+
429 {-# INLINE put #-}
263 {-# INLINE put #-}
430 put = fromEffect . put
264 put = fromEffect . put
431
265
432−
433instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
266instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
434 {-# INLINE liftIO #-}
267 {-# INLINE liftIO #-}
435 liftIO = fromEffect . liftIO
268 liftIO = fromEffect . liftIO
core/src/Streamly/Internal/Data/Producer/Source.hs+2−2
@@ -202,7 +202,7 @@ parse
202 -> Producer m (Source s a) a
202 -> Producer m (Source s a) a
203 -> Source s a
203 -> Source s a
204 -> m (b, Source s a)
204 -> m (b, Source s a)
205−parse = parseD . ParserK.fromParserK
205+parse = parseD . ParserD.fromParserK
206
206
207-------------------------------------------------------------------------------
207-------------------------------------------------------------------------------
208-- Nested parsing
208-- Nested parsing
@@ -234,4 +234,4 @@ parseMany :: MonadThrow m =>
234 ParserK.Parser m a b
234 ParserK.Parser m a b
235 -> Producer m (Source x a) a
235 -> Producer m (Source x a) a
236 -> Producer m (Source x a) b
236 -> Producer m (Source x a) b
237−parseMany parser = parseManyD (ParserK.fromParserK parser)
237+parseMany parser = parseManyD (ParserD.fromParserK parser)
src/Streamly/Internal/Data/Binary/Decode.hs+6−7
@@ -35,7 +35,6 @@ import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))
35import qualified Streamly.Internal.Data.Array.Foreign as A
35import qualified Streamly.Internal.Data.Array.Foreign as A
36import qualified Streamly.Internal.Data.Parser as PR
36import qualified Streamly.Internal.Data.Parser as PR
37import qualified Streamly.Internal.Data.Parser.ParserD as PRD
37import qualified Streamly.Internal.Data.Parser.ParserD as PRD
38−import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK
39
38
40-- | A value of type '()' is encoded as @0@ in binary encoding.
39-- | A value of type '()' is encoded as @0@ in binary encoding.
41--
40--
@@ -131,7 +130,7 @@ word16beD = PRD.Parser step initial extract
131--
130--
132{-# INLINE word16be #-}
131{-# INLINE word16be #-}
133word16be :: MonadCatch m => Parser m Word8 Word16
132word16be :: MonadCatch m => Parser m Word8 Word16
134−word16be = PRK.toParserK word16beD
133+word16be = PRD.toParserK word16beD
135
134
136-- | Little endian (LSB first) Word16
135-- | Little endian (LSB first) Word16
137{-# INLINE word16leD #-}
136{-# INLINE word16leD #-}
@@ -156,7 +155,7 @@ word16leD = PRD.Parser step initial extract
156--
155--
157{-# INLINE word16le #-}
156{-# INLINE word16le #-}
158word16le :: MonadCatch m => Parser m Word8 Word16
157word16le :: MonadCatch m => Parser m Word8 Word16
159−word16le = PRK.toParserK word16leD
158+word16le = PRD.toParserK word16leD
160
159
161-- | Big endian (MSB first) Word32
160-- | Big endian (MSB first) Word32
162{-# INLINE word32beD #-}
161{-# INLINE word32beD #-}
@@ -183,7 +182,7 @@ word32beD = PRD.Parser step initial extract
183--
182--
184{-# INLINE word32be #-}
183{-# INLINE word32be #-}
185word32be :: MonadCatch m => Parser m Word8 Word32
184word32be :: MonadCatch m => Parser m Word8 Word32
186−word32be = PRK.toParserK word32beD
185+word32be = PRD.toParserK word32beD
187
186
188-- | Little endian (LSB first) Word32
187-- | Little endian (LSB first) Word32
189{-# INLINE word32leD #-}
188{-# INLINE word32leD #-}
@@ -209,7 +208,7 @@ word32leD = PRD.Parser step initial extract
209--
208--
210{-# INLINE word32le #-}
209{-# INLINE word32le #-}
211word32le :: MonadCatch m => Parser m Word8 Word32
210word32le :: MonadCatch m => Parser m Word8 Word32
212−word32le = PRK.toParserK word32leD
211+word32le = PRD.toParserK word32leD
213
212
214-- | Big endian (MSB first) Word64
213-- | Big endian (MSB first) Word64
215{-# INLINE word64beD #-}
214{-# INLINE word64beD #-}
@@ -236,7 +235,7 @@ word64beD = PRD.Parser step initial extract
236--
235--
237{-# INLINE word64be #-}
236{-# INLINE word64be #-}
238word64be :: MonadCatch m => Parser m Word8 Word64
237word64be :: MonadCatch m => Parser m Word8 Word64
239−word64be = PRK.toParserK word64beD
238+word64be = PRD.toParserK word64beD
240
239
241-- | Little endian (LSB first) Word64
240-- | Little endian (LSB first) Word64
242{-# INLINE word64leD #-}
241{-# INLINE word64leD #-}
@@ -262,7 +261,7 @@ word64leD = PRD.Parser step initial extract
262--
261--
263{-# INLINE word64le #-}
262{-# INLINE word64le #-}
264word64le :: MonadCatch m => Parser m Word8 Word64
263word64le :: MonadCatch m => Parser m Word8 Word64
265−word64le = PRK.toParserK word64leD
264+word64le = PRD.toParserK word64leD
266
265
267-------------------------------------------------------------------------------
266-------------------------------------------------------------------------------
268-- Host byte order
267-- Host byte order
src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+2−2
@@ -403,7 +403,7 @@ parseK = parse
403--
403--
404{-# INLINE [3] parse #-}
404{-# INLINE [3] parse #-}
405parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
405parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
406−parse = parseD . PRK.fromParserK
406+parse = parseD . PRD.fromParserK
407
407
408{-# INLINE_NORMAL parseD_ #-}
408{-# INLINE_NORMAL parseD_ #-}
409parseD_ :: MonadThrow m => PRD.Parser m a b -> SerialT m a -> m (b, SerialT m a)
409parseD_ :: MonadThrow m => PRD.Parser m a b -> SerialT m a -> m (b, SerialT m a)
@@ -417,7 +417,7 @@ parseD_ parser strm = do
417--
417--
418{-# INLINE [3] parse_ #-}
418{-# INLINE [3] parse_ #-}
419parse_ :: MonadThrow m => Parser m a b -> SerialT m a -> m (b, SerialT m a)
419parse_ :: MonadThrow m => Parser m a b -> SerialT m a -> m (b, SerialT m a)
420−parse_ = parseD_ . PRK.fromParserK
420+parse_ = parseD_ . PRD.fromParserK
421
421
422------------------------------------------------------------------------------
422------------------------------------------------------------------------------
423-- Specific Fold Functions
423-- Specific Fold Functions
src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+2−3
@@ -180,7 +180,6 @@ import qualified Data.Heap as H
180import qualified Data.Map.Strict as Map
180import qualified Data.Map.Strict as Map
181import qualified Streamly.Internal.Data.Array.Foreign.Type as A
181import qualified Streamly.Internal.Data.Array.Foreign.Type as A
182import qualified Streamly.Internal.Data.Fold as FL
182import qualified Streamly.Internal.Data.Fold as FL
183−import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK
184import qualified Streamly.Internal.Data.Parser.ParserD as PRD
183import qualified Streamly.Internal.Data.Parser.ParserD as PRD
185import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
184import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
186import qualified Streamly.Internal.Data.Stream.StreamD as D
185import qualified Streamly.Internal.Data.Stream.StreamD as D
@@ -384,7 +383,7 @@ parseMany
384 -> t m a
383 -> t m a
385 -> t m b
384 -> t m b
386parseMany p m =
385parseMany p m =
387− fromStreamD $ D.parseMany (PRK.fromParserK p) (toStreamD m)
386+ fromStreamD $ D.parseMany (PRD.fromParserK p) (toStreamD m)
388
387
389{-# INLINE parseManyD #-}
388{-# INLINE parseManyD #-}
390parseManyD
389parseManyD
@@ -448,7 +447,7 @@ parseIterate
448 -> t m a
447 -> t m a
449 -> t m b
448 -> t m b
450parseIterate f i m = fromStreamD $
449parseIterate f i m = fromStreamD $
451− D.parseIterate (PRK.fromParserK . f) i (toStreamD m)
450+ D.parseIterate (PRD.fromParserK . f) i (toStreamD m)
452
451
453------------------------------------------------------------------------------
452------------------------------------------------------------------------------
454-- Generalized grouping
453-- Generalized grouping
src/Streamly/Internal/Unicode/Stream.hs+1−2
@@ -107,7 +107,6 @@ import Streamly.Internal.System.IO (unsafeInlineIO)
107import qualified Streamly.Internal.Data.Unfold as Unfold
107import qualified Streamly.Internal.Data.Unfold as Unfold
108import qualified Streamly.Internal.Data.Parser as Parser
108import qualified Streamly.Internal.Data.Parser as Parser
109import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
109import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
110−import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK
111import qualified Streamly.Internal.Data.Stream.Serial as Serial
110import qualified Streamly.Internal.Data.Stream.Serial as Serial
112import qualified Streamly.Internal.Data.Array.Foreign as Array
111import qualified Streamly.Internal.Data.Array.Foreign as Array
113import qualified Streamly.Internal.Data.Array.Foreign.Type as A
112import qualified Streamly.Internal.Data.Array.Foreign.Type as A
@@ -518,7 +517,7 @@ writeCharUtf8' = ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)
518{-# INLINE parseCharUtf8With #-}
517{-# INLINE parseCharUtf8With #-}
519parseCharUtf8With ::
518parseCharUtf8With ::
520 MonadCatch m => CodingFailureMode -> Parser.Parser m Word8 Char
519 MonadCatch m => CodingFailureMode -> Parser.Parser m Word8 Char
521−parseCharUtf8With = ParserK.toParserK . parseCharUtf8WithD
520+parseCharUtf8With = ParserD.toParserK . parseCharUtf8WithD
522
521
523-- XXX write it as a parser and use parseMany to decode a stream, need to check
522-- XXX write it as a parser and use parseMany to decode a stream, need to check
524-- if that preserves the same performance. Or we can use a resumable parser
523-- if that preserves the same performance. Or we can use a resumable parser