git.iko.soy/streamly
on 326b055 help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
2248 lines 70 kB history raw
1#include "inline.hs"
3-- |
4-- Module : Streamly.Internal.Data.Parser.ParserD
5-- Copyright : (c) 2020 Composewell Technologies
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
10--
11-- Direct style parser implementation with stream fusion.
13module Streamly.Internal.Data.Parser.ParserD
14 (
15 Parser (..)
16 , ParseError (..)
17 , Step (..)
18 , Initial (..)
19 , rmapM
21 -- * Conversion to/from ParserK
22 , fromParserK
23 , toParserK
25 -- * Downgrade to Fold
26 , toFold
28 -- First order parsers
29 -- * Accumulators
30 , fromFold
31 , fromFoldMaybe
32 , fromPure
33 , fromEffect
34 , die
35 , dieM
37 -- * Map on input
38 , lmap
39 , lmapM
40 , postscan
41 , filter
43 -- * Element parsers
44 , peek
45 , eof
46 , satisfy
47 , next
48 , maybe
49 , either
51 -- * Sequence parsers
52 --
53 -- Parsers chained in series, if one parser terminates the composition
54 -- terminates. Currently we are using folds to collect the output of the
55 -- parsers but we can use Parsers instead of folds to make the composition
56 -- more powerful. For example, we can do:
57 --
58 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
59 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
60 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
62 -- Grab a sequence of input elements without inspecting them
63 , takeBetween
64 -- , take -- take -- takeBetween 0 n
65 , takeEQ -- takeBetween n n
66 , takeGE -- takeBetween n maxBound
67 -- , takeGE1 -- take1 -- takeBetween 1 n
68 , takeP
70 -- Grab a sequence of input elements by inspecting them
71 , lookAhead
72 , takeWhile
73 , takeWhileP
74 , takeWhile1
76 -- Separators
77 , takeEndBy
78 , takeEndBy_
79 , takeEndByEsc
80 , takeStartBy
81 , takeFramedBy_
82 , takeFramedByEsc_
83 , takeFramedByGeneric
85 -- Words and grouping
86 , wordBy
87 , wordFramedBy
88 , wordQuotedBy
89 , groupBy
90 , groupByRolling
91 , groupByRollingEither
93 -- Matching strings
94 , listEqBy
95 , eqBy
96 -- , prefixOf -- match any prefix of a given string
97 -- , suffixOf -- match any suffix of a given string
98 -- , infixOf -- match any substring of a given string
100 -- ** Spanning
101 , span
102 , spanBy
103 , spanByRolling
105 -- Second order parsers (parsers using parsers)
106 -- * Binary Combinators
108 -- ** Sequential Applicative
109 , serialWith
110 , split_
112 {-
113 -- ** Parallel Applicatives
114 , teeWith
115 , teeWithFst
116 , teeWithMin
117 -- , teeTill -- like manyTill but parallel
118 -}
120 -- ** Sequential Interleaving
121 -- Use two folds, run a primary parser, its rejected values go to the
122 -- secondary parser.
123 , deintercalate
124 , sepBy
126 -- ** Sequential Alternative
127 , alt
129 {-
130 -- ** Parallel Alternatives
131 , shortest
132 , longest
133 -- , fastest
134 -}
135 -- * N-ary Combinators
136 -- ** Sequential Collection
137 , sequence
138 , concatMap
140 -- ** Sequential Repetition
141 , count
142 , countBetween
143 -- , countBetweenTill
145 , many
146 , manyP
147 , some
148 , manyTill
150 -- -- ** Special cases
151 -- XXX traditional implmentations of these may be of limited use. For
152 -- example, consider parsing lines separated by "\r\n". The main parser
153 -- will have to detect and exclude the sequence "\r\n" anyway so that we
154 -- can apply the "sep" parser.
155 --
156 -- We can instead implement these as special cases of deintercalate.
157 --
158 -- , endBy
159 -- , sepBy
160 -- , sepEndBy
161 -- , beginBy
162 -- , sepBeginBy
163 -- , sepAroundBy
165 -- -- * Distribution
166 --
167 -- A simple and stupid impl would be to just convert the stream to an array
168 -- and give the array reference to all consumers. The array can be grown on
169 -- demand by any consumer and truncated when nonbody needs it.
170 --
171 -- -- ** Distribute to collection
172 -- -- ** Distribute to repetition
174 -- -- ** Interleaved collection
175 -- Round robin
176 -- Priority based
177 -- -- ** Interleaved repetition
178 -- repeat one parser and when it fails run an error recovery parser
179 -- e.g. to find a key frame in the stream after an error
181 -- ** Collection of Alternatives
182 -- , shortestN
183 -- , longestN
184 -- , fastestN -- first N successful in time
185 -- , choiceN -- first N successful in position
186 -- , choice -- first successful in position
188 -- -- ** Repeated Alternatives
189 -- , retryMax -- try N times
190 -- , retryUntil -- try until successful
191 -- , retryUntilN -- try until successful n times
193 -- ** Zipping Input
194 , zipWithM
195 , zip
196 , indexed
197 , makeIndexFilter
198 , sampleFromthen
199 )
200where
202#include "assert.hs"
204import Control.Monad (when)
205import Data.Bifunctor (first)
206import Fusion.Plugin.Types (Fuse(..))
207import Streamly.Internal.Data.Fold.Type (Fold(..))
208import Streamly.Internal.Data.SVar.Type (defState)
209import Streamly.Internal.Data.Either.Strict (Either'(..))
210import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
211import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
213import qualified Streamly.Internal.Data.Fold.Type as FL
214import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
215import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
217import Prelude hiding
218 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
219 , zip, filter)
220-- import Streamly.Internal.Data.Parser.ParserD.Tee
221import Streamly.Internal.Data.Parser.ParserD.Type
223--
224-- $setup
225-- >>> :m
226-- >>> :set -package streamly
227-- >>> import Prelude hiding ()
228-- >>> import qualified Data.Maybe as Maybe
229-- >>> import qualified Streamly.Data.Stream as Stream
230-- >>> import qualified Streamly.Internal.Data.Stream as Stream
231-- >>> import qualified Streamly.Data.Fold as Fold
232-- >>> import qualified Streamly.Internal.Data.Parser as Parser
234-------------------------------------------------------------------------------
235-- Downgrade a parser to a Fold
236-------------------------------------------------------------------------------
238-- | See 'Streamly.Internal.Data.Parser.toFold'.
239--
240-- /Internal/
241--
242{-# INLINE toFold #-}
243toFold :: Monad m => Parser m a b -> Fold m a b
244toFold (Parser pstep pinitial pextract) = Fold step initial extract
246 where
248 initial = do
249 r <- pinitial
250 case r of
251 IPartial s -> return $ FL.Partial s
252 IDone b -> return $ FL.Done b
253 IError err ->
254 error $ "toFold: parser throws error in initial" ++ err
256 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
257 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
258 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
259 eerror err = error $ "toFold: parser throws error: " ++ err
261 step st a = do
262 r <- pstep st a
263 case r of
264 Partial 0 s -> return $ FL.Partial s
265 Continue 0 s -> return $ FL.Partial s
266 Done 0 b -> return $ FL.Done b
267 Partial n _ -> perror n
268 Continue n _ -> cerror n
269 Done n _ -> derror n
270 Error err -> eerror err
272 extract st = do
273 r <- pextract st
274 case r of
275 Done 0 b -> return b
276 Partial n _ -> perror n
277 Continue n _ -> cerror n
278 Done n _ -> derror n
279 Error err -> eerror err
281-------------------------------------------------------------------------------
282-- Upgrade folds to parses
283-------------------------------------------------------------------------------
284--
285-- | See 'Streamly.Internal.Data.Parser.fromFold'.
286--
287-- /Pre-release/
288--
289{-# INLINE fromFold #-}
290fromFold :: Monad m => Fold m a b -> Parser m a b
291fromFold (Fold fstep finitial fextract) = Parser step initial extract
293 where
295 initial = do
296 res <- finitial
297 return
298 $ case res of
299 FL.Partial s1 -> IPartial s1
300 FL.Done b -> IDone b
302 step s a = do
303 res <- fstep s a
304 return
305 $ case res of
306 FL.Partial s1 -> Partial 0 s1
307 FL.Done b -> Done 0 b
309 extract = fmap (Done 0) . fextract
311-- | Convert Maybe returning folds to error returning parsers.
312--
313-- /Pre-release/
314--
315{-# INLINE fromFoldMaybe #-}
316fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser m a b
317fromFoldMaybe errMsg (Fold fstep finitial fextract) =
318 Parser step initial extract
320 where
322 initial = do
323 res <- finitial
324 return
325 $ case res of
326 FL.Partial s1 -> IPartial s1
327 FL.Done b ->
328 case b of
329 Just x -> IDone x
330 Nothing -> IError errMsg
332 step s a = do
333 res <- fstep s a
334 return
335 $ case res of
336 FL.Partial s1 -> Partial 0 s1
337 FL.Done b ->
338 case b of
339 Just x -> Done 0 x
340 Nothing -> Error errMsg
342 extract s = do
343 res <- fextract s
344 case res of
345 Just x -> return $ Done 0 x
346 Nothing -> return $ Error errMsg
348-------------------------------------------------------------------------------
349-- Failing Parsers
350-------------------------------------------------------------------------------
352-- | See 'Streamly.Internal.Data.Parser.peek'.
353--
354-- /Pre-release/
355--
356{-# INLINE peek #-}
357peek :: Monad m => Parser m a a
358peek = Parser step initial extract
360 where
362 initial = return $ IPartial ()
364 step () a = return $ Done 1 a
366 extract () = return $ Error "peek: end of input"
368-- | See 'Streamly.Internal.Data.Parser.eof'.
369--
370-- /Pre-release/
371--
372{-# INLINE eof #-}
373eof :: Monad m => Parser m a ()
374eof = Parser step initial extract
376 where
378 initial = return $ IPartial ()
380 step () _ = return $ Error "eof: not at end of input"
382 extract () = return $ Done 0 ()
384-- | See 'Streamly.Internal.Data.Parser.next'.
385--
386-- /Pre-release/
387--
388{-# INLINE next #-}
389next :: Monad m => Parser m a (Maybe a)
390next = Parser step initial extract
392 where
394 initial = pure $ IPartial ()
396 step () a = pure $ Done 0 (Just a)
398 extract () = pure $ Done 0 Nothing
400-- | See 'Streamly.Internal.Data.Parser.either'.
401--
402-- /Pre-release/
403--
404{-# INLINE either #-}
405either :: Monad m => (a -> Either String b) -> Parser m a b
406either f = Parser step initial extract
408 where
410 initial = return $ IPartial ()
412 step () a = return $
413 case f a of
414 Right b -> Done 0 b
415 Left err -> Error err
417 extract () = return $ Error "end of input"
419-- | See 'Streamly.Internal.Data.Parser.maybe'.
420--
421-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
422-- >>> maybe f = Parser.either (toEither . f)
423--
424-- /Pre-release/
425--
426{-# INLINE maybe #-}
427maybe :: Monad m => (a -> Maybe b) -> Parser m a b
428-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
429maybe parserF = Parser step initial extract
431 where
433 initial = return $ IPartial ()
435 step () a = return $
436 case parserF a of
437 Just b -> Done 0 b
438 Nothing -> Error "maybe: predicate failed"
440 extract () = return $ Error "maybe: end of input"
442-- | See 'Streamly.Internal.Data.Parser.satisfy'.
443--
444-- >>> toMaybe f x = if f x then Just x else Nothing
445-- >>> satisfy f = Parser.maybe (toMaybe f)
446--
447-- /Pre-release/
448--
449{-# INLINE satisfy #-}
450satisfy :: Monad m => (a -> Bool) -> Parser m a a
451-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
452satisfy predicate = Parser step initial extract
454 where
456 initial = return $ IPartial ()
458 step () a = return $
459 if predicate a
460 then Done 0 a
461 else Error "satisfy: predicate failed"
463 extract () = return $ Error "satisfy: end of input"
465-------------------------------------------------------------------------------
466-- Taking elements
467-------------------------------------------------------------------------------
469-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
470{-# ANN type Tuple'Fused Fuse #-}
471data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
473-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
474--
475-- /Pre-release/
476--
477{-# INLINE takeBetween #-}
478takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser m a b
479takeBetween low high (Fold fstep finitial fextract) =
481 Parser step initial (extract streamErr)
483 where
485 streamErr i =
486 "takeBetween: Expecting alteast " ++ show low
487 ++ " elements, got " ++ show i
489 invalidRange =
490 "takeBetween: lower bound - " ++ show low
491 ++ " is greater than higher bound - " ++ show high
493 foldErr :: Int -> String
494 foldErr i =
495 "takeBetween: the collecting fold terminated after"
496 ++ " consuming" ++ show i ++ " elements"
497 ++ " minimum" ++ show low ++ " elements needed"
499 -- Exactly the same as snext except different constructors, we can possibly
500 -- deduplicate the two.
501 {-# INLINE inext #-}
502 inext i res =
503 let i1 = i + 1
504 in case res of
505 FL.Partial s -> do
506 let s1 = Tuple'Fused i1 s
507 if i1 < high
508 -- XXX ideally this should be a Continue instead
509 then return $ IPartial s1
510 else iextract foldErr s1
511 FL.Done b ->
512 return
513 $ if i1 >= low
514 then IDone b
515 else IError (foldErr i1)
517 initial = do
518 when (low >= 0 && high >= 0 && low > high)
519 $ error invalidRange
521 finitial >>= inext (-1)
523 -- Keep the impl same as inext
524 {-# INLINE snext #-}
525 snext i res =
526 let i1 = i + 1
527 in case res of
528 FL.Partial s -> do
529 let s1 = Tuple'Fused i1 s
530 if i1 < high
531 then return $ Continue 0 s1
532 else extract foldErr s1
533 FL.Done b ->
534 return
535 $ if i1 >= low
536 then Done 0 b
537 else Error (foldErr i1)
539 step (Tuple'Fused i s) a = fstep s a >>= snext i
541 extract f (Tuple'Fused i s)
542 | i >= low && i <= high = fmap (Done 0) (fextract s)
543 | otherwise = return $ Error (f i)
545 -- XXX Need to make Initial return type Step to deduplicate this
546 iextract f (Tuple'Fused i s)
547 | i >= low && i <= high = fmap IDone (fextract s)
548 | otherwise = return $ IError (f i)
550-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
551--
552-- /Pre-release/
553--
554{-# INLINE takeEQ #-}
555takeEQ :: Monad m => Int -> Fold m a b -> Parser m a b
556takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
558 where
560 cnt = max n 0
562 initial = do
563 res <- finitial
564 return $ case res of
565 FL.Partial s -> IPartial $ Tuple' 0 s
566 FL.Done b ->
567 if cnt == 0
568 then IDone b
569 else IError
570 $ "takeEQ: Expecting exactly " ++ show cnt
571 ++ " elements, fold terminated without"
572 ++ " consuming any elements"
574 step (Tuple' i r) a
575 | i1 < cnt = do
576 res <- fstep r a
577 return
578 $ case res of
579 FL.Partial s -> Continue 0 $ Tuple' i1 s
580 FL.Done _ ->
581 Error
582 $ "takeEQ: Expecting exactly " ++ show cnt
583 ++ " elements, fold terminated on " ++ show i1
584 | i1 == cnt = do
585 res <- fstep r a
586 Done 0
587 <$> case res of
588 FL.Partial s -> fextract s
589 FL.Done b -> return b
590 -- XXX we should not reach here when initial returns Step type
591 -- reachable only when n == 0
592 | otherwise = Done 1 <$> fextract r
594 where
596 i1 = i + 1
598 extract (Tuple' i r)
599 | i == 0 && cnt == 0 = fmap (Done 0) $ fextract r
600 | otherwise =
601 return
602 $ Error
603 $ "takeEQ: Expecting exactly " ++ show cnt
604 ++ " elements, input terminated on " ++ show i
606-- | See 'Streamly.Internal.Data.Parser.takeGE'.
607--
608-- /Pre-release/
609--
610{-# INLINE takeGE #-}
611takeGE :: Monad m => Int -> Fold m a b -> Parser m a b
612takeGE n (Fold fstep finitial fextract) = Parser step initial extract
614 where
616 cnt = max n 0
618 initial = do
619 res <- finitial
620 return $ case res of
621 FL.Partial s -> IPartial $ Tuple' 0 s
622 FL.Done b ->
623 if cnt == 0
624 then IDone b
625 else IError
626 $ "takeGE: Expecting at least " ++ show cnt
627 ++ " elements, fold terminated without"
628 ++ " consuming any elements"
630 step (Tuple' i r) a
631 | i1 < cnt = do
632 res <- fstep r a
633 return
634 $ case res of
635 FL.Partial s -> Continue 0 $ Tuple' i1 s
636 FL.Done _ ->
637 Error
638 $ "takeGE: Expecting at least " ++ show cnt
639 ++ " elements, fold terminated on " ++ show i1
640 | otherwise = do
641 res <- fstep r a
642 return
643 $ case res of
644 FL.Partial s -> Partial 0 $ Tuple' i1 s
645 FL.Done b -> Done 0 b
647 where
649 i1 = i + 1
651 extract (Tuple' i r)
652 | i >= cnt = fmap (Done 0) $ fextract r
653 | otherwise =
654 return
655 $ Error
656 $ "takeGE: Expecting at least " ++ show cnt
657 ++ " elements, input terminated on " ++ show i
659-------------------------------------------------------------------------------
660-- Conditional splitting
661-------------------------------------------------------------------------------
663-- | See 'Streamly.Internal.Data.Parser.takeWhileP'.
664--
665-- /Pre-release/
666--
667{-# INLINE takeWhileP #-}
668takeWhileP :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b
669takeWhileP predicate (Parser pstep pinitial pextract) =
670 Parser step pinitial pextract
672 where
674 step s a =
675 if predicate a
676 then pstep s a
677 else do
678 r <- pextract s
679 -- XXX need a map on count
680 case r of
681 Error err -> return $ Error err
682 Done n s1 -> return $ Done (n + 1) s1
683 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
684 Continue n s1 -> return $ Continue (n + 1) s1
686-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
687--
688-- /Pre-release/
689--
690{-# INLINE takeWhile #-}
691takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
692takeWhile predicate (Fold fstep finitial fextract) =
693 Parser step initial extract
695 where
697 initial = do
698 res <- finitial
699 return $ case res of
700 FL.Partial s -> IPartial s
701 FL.Done b -> IDone b
703 step s a =
704 if predicate a
705 then do
706 fres <- fstep s a
707 return
708 $ case fres of
709 FL.Partial s1 -> Partial 0 s1
710 FL.Done b -> Done 0 b
711 else Done 1 <$> fextract s
713 extract s = fmap (Done 0) (fextract s)
715-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
716--
717-- /Pre-release/
718--
719{-# INLINE takeWhile1 #-}
720takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
721takeWhile1 predicate (Fold fstep finitial fextract) =
722 Parser step initial extract
724 where
726 initial = do
727 res <- finitial
728 return $ case res of
729 FL.Partial s -> IPartial (Left' s)
730 FL.Done _ ->
731 IError
732 $ "takeWhile1: fold terminated without consuming:"
733 ++ " any element"
735 {-# INLINE process #-}
736 process s a = do
737 res <- fstep s a
738 return
739 $ case res of
740 FL.Partial s1 -> Partial 0 (Right' s1)
741 FL.Done b -> Done 0 b
743 step (Left' s) a =
744 if predicate a
745 then process s a
746 else return $ Error "takeWhile1: predicate failed on first element"
747 step (Right' s) a =
748 if predicate a
749 then process s a
750 else do
751 b <- fextract s
752 return $ Done 1 b
754 extract (Left' _) = return $ Error "takeWhile1: end of input"
755 extract (Right' s) = fmap (Done 0) (fextract s)
757-------------------------------------------------------------------------------
758-- Separators
759-------------------------------------------------------------------------------
761data FramedEscState s =
762 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
764{-# INLINE takeFramedByGeneric #-}
765takeFramedByGeneric :: Monad m =>
766 Maybe (a -> Bool)
767 -> Maybe (a -> Bool)
768 -> Maybe (a -> Bool)
769 -> Fold m a b
770 -> Parser m a b
771takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
773 Parser step initial extract
775 where
777 initial = do
778 res <- finitial
779 return $
780 case res of
781 FL.Partial s -> IPartial (FrameEscInit s)
782 FL.Done _ ->
783 error "takeFramedByGeneric: fold done without input"
785 {-# INLINE process #-}
786 process s a n = do
787 res <- fstep s a
788 return
789 $ case res of
790 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
791 FL.Done b -> Done 0 b
793 {-# INLINE processNoEsc #-}
794 processNoEsc s a n =
795 case end of
796 Just isEnd ->
797 case begin of
798 Just isBegin ->
799 -- takeFramedBy case
800 if isEnd a
801 then
802 if n == 0
803 then Done 0 <$> fextract s
804 else process s a (n - 1)
805 else
806 let n1 = if isBegin a then n + 1 else n
807 in process s a n1
808 Nothing -> -- takeEndBy case
809 if isEnd a
810 then Done 0 <$> fextract s
811 else process s a n
812 Nothing -> -- takeStartBy case
813 case begin of
814 Just isBegin ->
815 if isBegin a
816 then Done 0 <$> fextract s
817 else process s a n
818 Nothing ->
819 error $ "takeFramedByGeneric: "
820 ++ "Both begin and end frame predicate missing"
822 {-# INLINE processCheckEsc #-}
823 processCheckEsc s a n =
824 case esc of
825 Just isEsc ->
826 if isEsc a
827 then return $ Partial 0 $ FrameEscEsc s n
828 else processNoEsc s a n
829 Nothing -> processNoEsc s a n
831 step (FrameEscInit s) a =
832 case begin of
833 Just isBegin ->
834 if isBegin a
835 then return $ Partial 0 (FrameEscGo s 0)
836 else return $ Error "takeFramedByGeneric: missing frame start"
837 Nothing ->
838 case end of
839 Just isEnd ->
840 if isEnd a
841 then Done 0 <$> fextract s
842 else processCheckEsc s a 0
843 Nothing ->
844 error "Both begin and end frame predicate missing"
845 step (FrameEscGo s n) a = processCheckEsc s a n
846 step (FrameEscEsc s n) a = process s a n
848 err = return . Error
850 extract (FrameEscInit _) =
851 err "takeFramedByGeneric: empty token"
852 extract (FrameEscGo s _) =
853 case begin of
854 Just _ ->
855 case end of
856 Nothing -> fmap (Done 0) $ fextract s
857 Just _ -> err "takeFramedByGeneric: missing frame end"
858 Nothing -> err "takeFramedByGeneric: missing closing frame"
859 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
861-- | See 'Streamly.Internal.Data.Parser.takeEndBy'.
862--
863-- /Pre-release/
864--
865{-# INLINE takeEndBy #-}
866takeEndBy :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b
867takeEndBy cond (Parser pstep pinitial pextract) =
869 Parser step initial pextract
871 where
873 initial = pinitial
875 step s a = do
876 res <- pstep s a
877 if not (cond a)
878 then return res
879 else extractStep pextract res
881-- | See 'Streamly.Internal.Data.Parser.takeEndByEsc'.
882--
883-- /Pre-release/
884--
885{-# INLINE takeEndByEsc #-}
886takeEndByEsc :: Monad m =>
887 (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b
888takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
890 Parser step initial extract
892 where
894 initial = first Left' <$> pinitial
896 step (Left' s) a = do
897 if isEsc a
898 then return $ Partial 0 $ Right' s
899 else do
900 res <- pstep s a
901 if not (isSep a)
902 then return $ first Left' res
903 else fmap (first Left') $ extractStep pextract res
905 step (Right' s) a = do
906 res <- pstep s a
907 return $ first Left' res
909 extract (Left' s) = fmap (first Left') $ pextract s
910 extract (Right' _) =
911 return $ Error "takeEndByEsc: trailing escape"
913-- | See 'Streamly.Internal.Data.Parser.takeEndBy_'.
914--
915-- /Pre-release/
916--
917{-# INLINE takeEndBy_ #-}
918takeEndBy_ :: (a -> Bool) -> Parser m a b -> Parser m a b
919takeEndBy_ cond (Parser pstep pinitial pextract) =
921 Parser step pinitial pextract
923 where
925 step s a =
926 if cond a
927 then pextract s
928 else pstep s a
930-- | See 'Streamly.Internal.Data.Parser.takeStartBy'.
931--
932-- /Pre-release/
933--
935{-# INLINE takeStartBy #-}
936takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
937takeStartBy cond (Fold fstep finitial fextract) =
939 Parser step initial extract
941 where
943 initial = do
944 res <- finitial
945 return $
946 case res of
947 FL.Partial s -> IPartial (Left' s)
948 FL.Done _ -> IError "takeStartBy: fold done without input"
950 {-# INLINE process #-}
951 process s a = do
952 res <- fstep s a
953 return
954 $ case res of
955 FL.Partial s1 -> Partial 0 (Right' s1)
956 FL.Done b -> Done 0 b
958 step (Left' s) a =
959 if cond a
960 then process s a
961 else return $ Error "takeStartBy: missing frame start"
962 step (Right' s) a =
963 if not (cond a)
964 then process s a
965 else Done 1 <$> fextract s
967 extract (Left' s) = fmap (Done 0) $ fextract s
968 extract (Right' s) = fmap (Done 0) $ fextract s
970{-# INLINE takeFramedByEsc_ #-}
971takeFramedByEsc_ :: Monad m =>
972 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
973takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
975 Parser step initial extract
977 where
979 initial = do
980 res <- finitial
981 return $
982 case res of
983 FL.Partial s -> IPartial (FrameEscInit s)
984 FL.Done _ ->
985 error "takeFramedByEsc_: fold done without input"
987 {-# INLINE process #-}
988 process s a n = do
989 res <- fstep s a
990 return
991 $ case res of
992 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
993 FL.Done b -> Done 0 b
995 step (FrameEscInit s) a =
996 if isBegin a
997 then return $ Partial 0 (FrameEscGo s 0)
998 else return $ Error "takeFramedByEsc_: missing frame start"
999 step (FrameEscGo s n) a =
1000 if isEsc a
1001 then return $ Partial 0 $ FrameEscEsc s n
1002 else do
1003 if not (isEnd a)
1004 then
1005 let n1 = if isBegin a then n + 1 else n
1006 in process s a n1
1007 else
1008 if n == 0
1009 then Done 0 <$> fextract s
1010 else process s a (n - 1)
1011 step (FrameEscEsc s n) a = process s a n
1013 err = return . Error
1015 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1016 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1017 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1019data FramedState s = FrameInit !s | FrameGo !s Int
1021{-# INLINE takeFramedBy_ #-}
1022takeFramedBy_ :: Monad m =>
1023 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
1024takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
1026 Parser step initial extract
1028 where
1030 initial = do
1031 res <- finitial
1032 return $
1033 case res of
1034 FL.Partial s -> IPartial (FrameInit s)
1035 FL.Done _ ->
1036 error "takeFramedBy_: fold done without input"
1038 {-# INLINE process #-}
1039 process s a n = do
1040 res <- fstep s a
1041 return
1042 $ case res of
1043 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1044 FL.Done b -> Done 0 b
1046 step (FrameInit s) a =
1047 if isBegin a
1048 then return $ Continue 0 (FrameGo s 0)
1049 else return $ Error "takeFramedBy_: missing frame start"
1050 step (FrameGo s n) a
1051 | not (isEnd a) =
1052 let n1 = if isBegin a then n + 1 else n
1053 in process s a n1
1054 | n == 0 = Done 0 <$> fextract s
1055 | otherwise = process s a (n - 1)
1057 err = return . Error
1059 extract (FrameInit _) = err "takeFramedBy_: empty token"
1060 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1062-------------------------------------------------------------------------------
1063-- Grouping and words
1064-------------------------------------------------------------------------------
1066data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1068-- | See 'Streamly.Internal.Data.Parser.wordBy'.
1071{-# INLINE wordBy #-}
1072wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
1073wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1075 where
1077 {-# INLINE worder #-}
1078 worder s a = do
1079 res <- fstep s a
1080 return
1081 $ case res of
1082 FL.Partial s1 -> Partial 0 $ WBWord s1
1083 FL.Done b -> Done 0 b
1085 initial = do
1086 res <- finitial
1087 return
1088 $ case res of
1089 FL.Partial s -> IPartial $ WBLeft s
1090 FL.Done b -> IDone b
1092 step (WBLeft s) a =
1093 if not (predicate a)
1094 then worder s a
1095 else return $ Partial 0 $ WBLeft s
1096 step (WBWord s) a =
1097 if not (predicate a)
1098 then worder s a
1099 else do
1100 b <- fextract s
1101 return $ Partial 0 $ WBRight b
1102 step (WBRight b) a =
1103 return
1104 $ if not (predicate a)
1105 then Done 1 b
1106 else Partial 0 $ WBRight b
1108 extract (WBLeft s) = fmap (Done 0) $ fextract s
1109 extract (WBWord s) = fmap (Done 0) $ fextract s
1110 extract (WBRight b) = return (Done 0 b)
1112data WordFramedState s b =
1113 WordFramedSkipPre !s
1114 | WordFramedWord !s !Int
1115 | WordFramedEsc !s !Int
1116 | WordFramedSkipPost !b
1118-- | See 'Streamly.Internal.Data.Parser.wordFramedBy'
1120{-# INLINE wordFramedBy #-}
1121wordFramedBy :: Monad m =>
1122 (a -> Bool) -- ^ Escape
1123 -> (a -> Bool) -- ^ left quote
1124 -> (a -> Bool) -- ^ right quote
1125 -> (a -> Bool) -- ^ word seperator
1126 -> Fold m a b
1127 -> Parser m a b
1128wordFramedBy isEsc isBegin isEnd isSep
1129 (Fold fstep finitial fextract) =
1130 Parser step initial extract
1132 where
1134 initial = do
1135 res <- finitial
1136 return $
1137 case res of
1138 FL.Partial s -> IPartial (WordFramedSkipPre s)
1139 FL.Done _ ->
1140 error "wordFramedBy: fold done without input"
1142 {-# INLINE process #-}
1143 process s a n = do
1144 res <- fstep s a
1145 return
1146 $ case res of
1147 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1148 FL.Done b -> Done 0 b
1150 step (WordFramedSkipPre s) a
1151 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1152 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1153 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1154 | isEnd a =
1155 return $ Error "wordFramedBy: missing frame start"
1156 | otherwise = process s a 0
1157 step (WordFramedWord s n) a
1158 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1159 | n == 0 && isSep a = do
1160 b <- fextract s
1161 return $ Partial 0 $ WordFramedSkipPost b
1162 | otherwise = do
1163 -- We need to use different order for checking begin and end for
1164 -- the n == 0 and n == 1 case so that when the begin and end
1165 -- character is the same we treat the one after begin as end.
1166 if n == 0
1167 then
1168 -- Need to check isBegin first
1169 if isBegin a
1170 then return $ Continue 0 $ WordFramedWord s 1
1171 else if isEnd a
1172 then return $ Error "wordFramedBy: missing frame start"
1173 else process s a n
1174 else
1175 -- Need to check isEnd first
1176 if isEnd a
1177 then
1178 if n == 1
1179 then return $ Continue 0 $ WordFramedWord s 0
1180 else process s a (n - 1)
1181 else if isBegin a
1182 then process s a (n + 1)
1183 else process s a n
1184 step (WordFramedEsc s n) a = process s a n
1185 step (WordFramedSkipPost b) a =
1186 return
1187 $ if not (isSep a)
1188 then Done 1 b
1189 else Partial 0 $ WordFramedSkipPost b
1191 err = return . Error
1193 extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s
1194 extract (WordFramedWord s n) =
1195 if n == 0
1196 then fmap (Done 0) $ fextract s
1197 else err "wordFramedBy: missing frame end"
1198 extract (WordFramedEsc _ _) =
1199 err "wordFramedBy: trailing escape"
1200 extract (WordFramedSkipPost b) = return (Done 0 b)
1202data WordQuotedState s b a =
1203 WordQuotedSkipPre !s
1204 | WordUnquotedWord !s
1205 | WordQuotedWord !s !Int a
1206 | WordUnquotedEsc !s
1207 | WordQuotedEsc !s !Int a
1208 | WordQuotedSkipPost !b
1210{-# INLINE wordQuotedBy #-}
1211wordQuotedBy :: (Monad m, Eq a) =>
1212 Bool -- ^ keep the quotes in the output
1213 -> (a -> Bool) -- ^ Escape
1214 -> (a -> Bool) -- ^ left quote
1215 -> (a -> Bool) -- ^ right quote
1216 -> (a -> a) -- ^ get right quote from the left quote
1217 -> (a -> Bool) -- ^ word seperator
1218 -> Fold m a b
1219 -> Parser m a b
1220wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
1221 (Fold fstep finitial fextract) =
1222 Parser step initial extract
1224 where
1226 initial = do
1227 res <- finitial
1228 return $
1229 case res of
1230 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1231 FL.Done _ ->
1232 error "wordQuotedBy: fold done without input"
1234 {-# INLINE process #-}
1235 process s a n q = do
1236 res <- fstep s a
1237 return
1238 $ case res of
1239 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n q)
1240 FL.Done b -> Done 0 b
1242 {-# INLINE processUnquoted #-}
1243 processUnquoted s a = do
1244 res <- fstep s a
1245 return
1246 $ case res of
1247 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1248 FL.Done b -> Done 0 b
1250 step (WordQuotedSkipPre s) a
1251 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1252 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1253 | isBegin a =
1254 if keepQuotes
1255 then process s a 1 a
1256 else return $ Continue 0 $ WordQuotedWord s 1 a
1257 | isEnd a =
1258 return $ Error "wordQuotedBy: missing frame start"
1259 | otherwise = processUnquoted s a
1260 step (WordUnquotedWord s) a
1261 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1262 | isSep a = do
1263 b <- fextract s
1264 return $ Partial 0 $ WordQuotedSkipPost b
1265 | otherwise = do
1266 if isBegin a
1267 then if keepQuotes
1268 then process s a 1 a
1269 else return $ Continue 0 $ WordQuotedWord s 1 a
1270 else if isEnd a
1271 then return $ Error "wordQuotedBy: missing frame start"
1272 else processUnquoted s a
1273 step (WordQuotedWord s n q) a
1274 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n q
1275 -- XXX Will this ever occur? Will n ever be 0?
1276 | n == 0 && isSep a = do
1277 b <- fextract s
1278 return $ Partial 0 $ WordQuotedSkipPost b
1279 | otherwise = do
1280 if a == toRight q
1281 then
1282 if n == 1
1283 then if keepQuotes
1284 then processUnquoted s a
1285 else return $ Continue 0 $ WordUnquotedWord s
1286 else process s a (n - 1) q
1287 else if a == q
1288 then process s a (n + 1) q
1289 else process s a n q
1290 step (WordUnquotedEsc s) a = processUnquoted s a
1291 step (WordQuotedEsc s n q) a = process s a n q
1292 step (WordQuotedSkipPost b) a =
1293 return
1294 $ if not (isSep a)
1295 then Done 1 b
1296 else Partial 0 $ WordQuotedSkipPost b
1298 err = return . Error
1300 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1301 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1302 extract (WordQuotedWord s n _) =
1303 if n == 0
1304 then fmap (Done 0) $ fextract s
1305 else err "wordQuotedBy: missing frame end"
1306 extract WordQuotedEsc {} =
1307 err "wordQuotedBy: trailing escape"
1308 extract (WordUnquotedEsc _) =
1309 err "wordQuotedBy: trailing escape"
1310 extract (WordQuotedSkipPost b) = return (Done 0 b)
1312{-# ANN type GroupByState Fuse #-}
1313data GroupByState a s
1314 = GroupByInit !s
1315 | GroupByGrouping !a !s
1317-- | See 'Streamly.Internal.Data.Parser.groupBy'.
1319{-# INLINE groupBy #-}
1320groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1321groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1323 where
1325 {-# INLINE grouper #-}
1326 grouper s a0 a = do
1327 res <- fstep s a
1328 return
1329 $ case res of
1330 FL.Done b -> Done 0 b
1331 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1333 initial = do
1334 res <- finitial
1335 return
1336 $ case res of
1337 FL.Partial s -> IPartial $ GroupByInit s
1338 FL.Done b -> IDone b
1340 step (GroupByInit s) a = grouper s a a
1341 step (GroupByGrouping a0 s) a =
1342 if eq a0 a
1343 then grouper s a0 a
1344 else Done 1 <$> fextract s
1346 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1347 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1349-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
1351{-# INLINE groupByRolling #-}
1352groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1353groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1355 where
1357 {-# INLINE grouper #-}
1358 grouper s a = do
1359 res <- fstep s a
1360 return
1361 $ case res of
1362 FL.Done b -> Done 0 b
1363 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1365 initial = do
1366 res <- finitial
1367 return
1368 $ case res of
1369 FL.Partial s -> IPartial $ GroupByInit s
1370 FL.Done b -> IDone b
1372 step (GroupByInit s) a = grouper s a
1373 step (GroupByGrouping a0 s) a =
1374 if eq a0 a
1375 then grouper s a
1376 else Done 1 <$> fextract s
1378 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1379 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1381{-# ANN type GroupByStatePair Fuse #-}
1382data GroupByStatePair a s1 s2
1383 = GroupByInitPair !s1 !s2
1384 | GroupByGroupingPair !a !s1 !s2
1385 | GroupByGroupingPairL !a !s1 !s2
1386 | GroupByGroupingPairR !a !s1 !s2
1388{-# INLINE groupByRollingEither #-}
1389groupByRollingEither :: Monad m =>
1390 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
1391groupByRollingEither
1392 eq
1393 (Fold fstep1 finitial1 fextract1)
1394 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
1396 where
1398 {-# INLINE grouper #-}
1399 grouper s1 s2 a = do
1400 return $ Continue 0 (GroupByGroupingPair a s1 s2)
1402 {-# INLINE grouperL2 #-}
1403 grouperL2 s1 s2 a = do
1404 res <- fstep1 s1 a
1405 return
1406 $ case res of
1407 FL.Done b -> Done 0 (Left b)
1408 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
1410 {-# INLINE grouperL #-}
1411 grouperL s1 s2 a0 a = do
1412 res <- fstep1 s1 a0
1413 case res of
1414 FL.Done b -> return $ Done 0 (Left b)
1415 FL.Partial s11 -> grouperL2 s11 s2 a
1417 {-# INLINE grouperR2 #-}
1418 grouperR2 s1 s2 a = do
1419 res <- fstep2 s2 a
1420 return
1421 $ case res of
1422 FL.Done b -> Done 0 (Right b)
1423 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
1425 {-# INLINE grouperR #-}
1426 grouperR s1 s2 a0 a = do
1427 res <- fstep2 s2 a0
1428 case res of
1429 FL.Done b -> return $ Done 0 (Right b)
1430 FL.Partial s21 -> grouperR2 s1 s21 a
1432 initial = do
1433 res1 <- finitial1
1434 res2 <- finitial2
1435 return
1436 $ case res1 of
1437 FL.Partial s1 ->
1438 case res2 of
1439 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
1440 FL.Done b -> IDone (Right b)
1441 FL.Done b -> IDone (Left b)
1443 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
1445 step (GroupByGroupingPair a0 s1 s2) a =
1446 if not (eq a0 a)
1447 then grouperL s1 s2 a0 a
1448 else grouperR s1 s2 a0 a
1450 step (GroupByGroupingPairL a0 s1 s2) a =
1451 if not (eq a0 a)
1452 then grouperL2 s1 s2 a
1453 else Done 1 . Left <$> fextract1 s1
1455 step (GroupByGroupingPairR a0 s1 s2) a =
1456 if eq a0 a
1457 then grouperR2 s1 s2 a
1458 else Done 1 . Right <$> fextract2 s2
1460 extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1
1461 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1
1462 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2
1463 extract (GroupByGroupingPair a s1 _) = do
1464 res <- fstep1 s1 a
1465 case res of
1466 FL.Done b -> return $ Done 0 (Left b)
1467 FL.Partial s11 -> Done 0 . Left <$> fextract1 s11
1469-- XXX use an Unfold instead of a list?
1470-- XXX custom combinators for matching list, array and stream?
1471-- XXX rename to listBy?
1473-- | See 'Streamly.Internal.Data.Parser.eqBy'.
1475-- /Pre-release/
1477{-# INLINE listEqBy #-}
1478listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser m a [a]
1479listEqBy cmp str = Parser step initial extract
1481 where
1483 -- XXX Should return IDone in initial for [] case
1484 initial = return $ IPartial str
1486 step [] _ = return $ Done 0 str
1487 step [x] a =
1488 return
1489 $ if x `cmp` a
1490 then Done 0 str
1491 else Error "listEqBy: failed, yet to match the last element"
1492 step (x:xs) a =
1493 return
1494 $ if x `cmp` a
1495 then Continue 0 xs
1496 else Error
1497 $ "listEqBy: failed, yet to match "
1498 ++ show (length xs + 1) ++ " elements"
1500 extract xs =
1501 return
1502 $ Error
1503 $ "listEqBy: end of input, yet to match "
1504 ++ show (length xs) ++ " elements"
1506-- | Like 'listEqBy' but uses a stream instead of a list
1507{-# INLINE eqBy #-}
1508eqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
1509eqBy cmp (D.Stream sstep state) = Parser step initial extract
1511 where
1513 initial = do
1514 r <- sstep defState state
1515 case r of
1516 D.Yield x s -> return $ IPartial (Just' x, s)
1517 D.Stop -> return $ IDone ()
1518 -- Need Skip/Continue in initial to loop right here
1519 D.Skip s -> return $ IPartial (Nothing', s)
1521 step (Just' x, st) a =
1522 if x `cmp` a
1523 then do
1524 r <- sstep defState st
1525 return
1526 $ case r of
1527 D.Yield x1 s -> Continue 0 (Just' x1, s)
1528 D.Stop -> Done 0 ()
1529 D.Skip s -> Continue 1 (Nothing', s)
1530 else return $ Error "eqBy: mismtach occurred"
1531 step (Nothing', st) a = do
1532 r <- sstep defState st
1533 return
1534 $ case r of
1535 D.Yield x s -> do
1536 if x `cmp` a
1537 then Continue 0 (Nothing', s)
1538 else Error "eqBy: mismatch occurred"
1539 D.Stop -> Done 1 ()
1540 D.Skip s -> Continue 1 (Nothing', s)
1542 extract _ = return $ Error "eqBy: end of input"
1544-------------------------------------------------------------------------------
1545-- Transformations on input
1546-------------------------------------------------------------------------------
1548-- Initial needs a "Continue" constructor to implement scans on parsers. As a
1549-- parser can always return a Continue in initial when we feed the fold's
1550-- initial result to it. We can work this around for postscan by introducing an
1551-- initial state and calling "initial" only on the first input.
1553-- | Stateful scan on the input of a parser using a Fold.
1555-- /Unimplemented/
1557{-# INLINE postscan #-}
1558postscan :: -- Monad m =>
1559 Fold m a b -> Parser m b c -> Parser m a c
1560postscan = undefined
1562{-# INLINE zipWithM #-}
1563zipWithM :: Monad m =>
1564 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
1565zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
1566 Parser step initial extract
1568 where
1570 initial = do
1571 fres <- finitial
1572 case fres of
1573 FL.Partial fs -> do
1574 r <- sstep defState state
1575 case r of
1576 D.Yield x s -> return $ IPartial (Just' x, s, fs)
1577 D.Stop -> do
1578 x <- fextract fs
1579 return $ IDone x
1580 -- Need Skip/Continue in initial to loop right here
1581 D.Skip s -> return $ IPartial (Nothing', s, fs)
1582 FL.Done x -> return $ IDone x
1584 step (Just' a, st, fs) b = do
1585 c <- zf a b
1586 fres <- fstep fs c
1587 case fres of
1588 FL.Partial fs1 -> do
1589 r <- sstep defState st
1590 case r of
1591 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
1592 D.Stop -> do
1593 x <- fextract fs1
1594 return $ Done 0 x
1595 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
1596 FL.Done x -> return $ Done 0 x
1597 step (Nothing', st, fs) b = do
1598 r <- sstep defState st
1599 case r of
1600 D.Yield a s -> do
1601 c <- zf a b
1602 fres <- fstep fs c
1603 case fres of
1604 FL.Partial fs1 ->
1605 return $ Continue 0 (Nothing', s, fs1)
1606 FL.Done x -> return $ Done 0 x
1607 D.Stop -> do
1608 x <- fextract fs
1609 return $ Done 1 x
1610 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
1612 extract _ = return $ Error "zipWithM: end of input"
1614-- | Zip the input of a fold with a stream.
1616-- /Pre-release/
1618{-# INLINE zip #-}
1619zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser m b x
1620zip = zipWithM (curry return)
1622-- | Pair each element of a fold input with its index, starting from index 0.
1624-- /Pre-release/
1625{-# INLINE indexed #-}
1626indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser m a b
1627indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
1629-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
1630-- function using a fold indexing function that attaches an index to each input
1631-- element and a filtering function that filters using @(index, element) ->
1632-- Bool) as predicate.
1634-- For example:
1636-- @
1637-- filterWithIndex = makeIndexFilter indexed filter
1638-- filterWithAbsTime = makeIndexFilter timestamped filter
1639-- filterWithRelTime = makeIndexFilter timeIndexed filter
1640-- @
1642-- /Pre-release/
1643{-# INLINE makeIndexFilter #-}
1644makeIndexFilter ::
1645 (Fold m (s, a) b -> Parser m a b)
1646 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
1647 -> (((s, a) -> Bool) -> Fold m a b -> Parser m a b)
1648makeIndexFilter f comb g = f . comb g . FL.lmap snd
1650-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
1651-- then every element at strides of @stride@.
1653-- /Pre-release/
1654{-# INLINE sampleFromthen #-}
1655sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser m a b
1656sampleFromthen offset size =
1657 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
1659--------------------------------------------------------------------------------
1660--- Spanning
1661--------------------------------------------------------------------------------
1663-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1664-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1665-- input.
1667-- @
1668-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
1670-- > span_ (< 1) [1,2,3]
1671-- ([],[1,2,3])
1673-- > span_ (< 2) [1,2,3]
1674-- ([1],[2,3])
1676-- > span_ (< 4) [1,2,3]
1677-- ([1,2,3],[])
1679-- @
1681-- /Pre-release/
1682{-# INLINE span #-}
1683span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1684span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1686-- | Break the input stream into two groups, the first group takes the input as
1687-- long as the predicate applied to the first element of the stream and next
1688-- input element holds 'True', the second group takes the rest of the input.
1690-- /Pre-release/
1692{-# INLINE spanBy #-}
1693spanBy ::
1694 Monad m
1695 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1696spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1698-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1699-- predicate is applied to the previous and the next input elements.
1701-- /Pre-release/
1702{-# INLINE spanByRolling #-}
1703spanByRolling ::
1704 Monad m
1705 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1706spanByRolling eq f1 f2 =
1707 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1709-------------------------------------------------------------------------------
1710-- nested parsers
1711-------------------------------------------------------------------------------
1713-- | See 'Streamly.Internal.Data.Parser.takeP'.
1715-- /Internal/
1716{-# INLINE takeP #-}
1717takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1718takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1720 where
1722 initial = do
1723 res <- pinitial
1724 case res of
1725 IPartial s ->
1726 if lim > 0
1727 then return $ IPartial $ Tuple' 0 s
1728 else iextract s
1729 IDone b -> return $ IDone b
1730 IError e -> return $ IError e
1732 step (Tuple' cnt r) a = do
1733 assertM(cnt < lim)
1734 res <- pstep r a
1735 let cnt1 = cnt + 1
1736 case res of
1737 Partial 0 s -> do
1738 assertM(cnt1 >= 0)
1739 if cnt1 < lim
1740 then return $ Partial 0 $ Tuple' cnt1 s
1741 else do
1742 r1 <- pextract s
1743 return $ case r1 of
1744 Done n b -> Done n b
1745 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
1746 Error err -> Error err
1747 Partial _ _ -> error "takeP: Partial in extract"
1749 Continue 0 s -> do
1750 assertM(cnt1 >= 0)
1751 if cnt1 < lim
1752 then return $ Continue 0 $ Tuple' cnt1 s
1753 else do
1754 r1 <- pextract s
1755 return $ case r1 of
1756 Done n b -> Done n b
1757 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
1758 Error err -> Error err
1759 Partial _ _ -> error "takeP: Partial in extract"
1760 Partial n s -> do
1761 let taken = cnt1 - n
1762 assertM(taken >= 0)
1763 return $ Partial n $ Tuple' taken s
1764 Continue n s -> do
1765 let taken = cnt1 - n
1766 assertM(taken >= 0)
1767 return $ Continue n $ Tuple' taken s
1768 Done n b -> return $ Done n b
1769 Error str -> return $ Error str
1771 extract (Tuple' cnt r) = do
1772 r1 <- pextract r
1773 return $ case r1 of
1774 Done n b -> Done n b
1775 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
1776 Error err -> Error err
1777 Partial _ _ -> error "takeP: Partial in extract"
1779 -- XXX Need to make the Initial type Step to remove this
1780 iextract s = do
1781 r <- pextract s
1782 return $ case r of
1783 Done _ b -> IDone b
1784 Error err -> IError err
1785 _ -> error "Bug: takeP invalid state in initial"
1787-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1789-- /Pre-release/
1791{-# INLINE lookAhead #-}
1792lookAhead :: Monad m => Parser m a b -> Parser m a b
1793lookAhead (Parser step1 initial1 _) = Parser step initial extract
1795 where
1797 initial = do
1798 res <- initial1
1799 return $ case res of
1800 IPartial s -> IPartial (Tuple' 0 s)
1801 IDone b -> IDone b
1802 IError e -> IError e
1804 step (Tuple' cnt st) a = do
1805 r <- step1 st a
1806 let cnt1 = cnt + 1
1807 return
1808 $ case r of
1809 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1810 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1811 Done _ b -> Done cnt1 b
1812 Error err -> Error err
1814 -- XXX returning an error let's us backtrack. To implement it in a way so
1815 -- that it terminates on eof without an error then we need a way to
1816 -- backtrack on eof, that will require extract to return 'Step' type.
1817 extract (Tuple' n _) =
1818 return
1819 $ Error
1820 $ "lookAhead: end of input after consuming "
1821 ++ show n ++ " elements"
1823-------------------------------------------------------------------------------
1824-- Interleaving
1825-------------------------------------------------------------------------------
1827data DeintercalateState fs sp ss =
1828 DeintercalateL !fs !sp
1829 | DeintercalateR !fs !ss !Bool
1831-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1833-- /Internal/
1835{-# INLINE deintercalate #-}
1836deintercalate :: Monad m =>
1837 Parser m a x
1838 -> Parser m a y
1839 -> Fold m (Either x y) z
1840 -> Parser m a z
1841deintercalate
1842 (Parser stepL initialL extractL)
1843 (Parser stepR initialR extractR)
1844 (Fold fstep finitial fextract) = Parser step initial extract
1846 where
1848 errMsg p status =
1849 error $ "deintercalate: " ++ p ++ " parser cannot "
1850 ++ status ++ " without input"
1852 initial = do
1853 res <- finitial
1854 case res of
1855 FL.Partial fs -> do
1856 resL <- initialL
1857 case resL of
1858 IPartial sL -> return $ IPartial $ DeintercalateL fs sL
1859 IDone _ -> errMsg "left" "succeed"
1860 IError _ -> errMsg "left" "fail"
1861 FL.Done c -> return $ IDone c
1863 step (DeintercalateL fs sL) a = do
1864 r <- stepL sL a
1865 case r of
1866 Partial n s -> return $ Partial n (DeintercalateL fs s)
1867 Continue n s -> return $ Continue n (DeintercalateL fs s)
1868 Done n b -> do
1869 fres <- fstep fs (Left b)
1870 case fres of
1871 FL.Partial fs1 -> do
1872 resR <- initialR
1873 case resR of
1874 IPartial sR ->
1875 return
1876 $ Partial n (DeintercalateR fs1 sR False)
1877 IDone _ -> errMsg "right" "succeed"
1878 IError _ -> errMsg "right" "fail"
1879 FL.Done c -> return $ Done n c
1880 Error err -> return $ Error err
1881 step (DeintercalateR fs sR consumed) a = do
1882 r <- stepR sR a
1883 case r of
1884 Partial n s -> return $ Partial n (DeintercalateR fs s True)
1885 Continue n s -> return $ Continue n (DeintercalateR fs s True)
1886 Done n b ->
1887 if consumed
1888 then do
1889 fres <- fstep fs (Right b)
1890 case fres of
1891 FL.Partial fs1 -> do
1892 resL <- initialL
1893 case resL of
1894 IPartial sL ->
1895 return $ Partial n $ DeintercalateL fs1 sL
1896 IDone _ -> errMsg "left" "succeed"
1897 IError _ -> errMsg "left" "fail"
1898 FL.Done c -> return $ Done n c
1899 else error "deintercalate: infinite loop"
1900 Error err -> return $ Error err
1902 {-# INLINE processResult #-}
1903 processResult n fs r = do
1904 res <- fstep fs r
1905 case res of
1906 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
1907 FL.Done c -> return (Done n c)
1909 extract (DeintercalateL fs sL) = do
1910 r <- extractL sL
1911 case r of
1912 Done n b -> processResult n fs (Left b)
1913 Error err -> return $ Error err
1914 Continue n s -> return $ Continue n (DeintercalateL fs s)
1915 Partial _ _ -> error "Partial in extract"
1917 extract (DeintercalateR fs sR consumed) = do
1918 r <- extractR sR
1919 case r of
1920 Done n b -> processResult n fs (Right b)
1921 Error err -> return $ Error err
1922 -- XXX Review consumed
1923 Continue n s -> return $ Continue n (DeintercalateR fs s consumed)
1924 Partial _ _ -> error "Partial in extract"
1926data SepByState fs sp ss =
1927 SepByInit !fs !sp
1928 | SepBySeparator !fs !ss !Bool
1930-- This is a special case of deintercalate and can be easily implemented in
1931-- terms of deintercalate.
1932{-# INLINE sepBy #-}
1933sepBy :: Monad m =>
1934 Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
1935sepBy
1936 (Parser pstep pinitial pextract)
1937 (Parser sstep sinitial _)
1938 (Fold fstep finitial fextract) = Parser step initial extract
1940 where
1942 errMsg p status =
1943 error $ "sepBy: " ++ p ++ " parser cannot "
1944 ++ status ++ " without input"
1946 initial = do
1947 res <- finitial
1948 case res of
1949 FL.Partial fs -> do
1950 resP <- pinitial
1951 case resP of
1952 IPartial sp -> return $ IPartial $ SepByInit fs sp
1953 IDone _ -> errMsg "content" "succeed"
1954 IError _ -> errMsg "content" "fail"
1955 FL.Done b -> return $ IDone b
1957 step (SepByInit fs sp) a = do
1958 r <- pstep sp a
1959 case r of
1960 Partial n s -> return $ Partial n (SepByInit fs s)
1961 Continue n s -> return $ Continue n (SepByInit fs s)
1962 Done n b -> do
1963 fres <- fstep fs b
1964 case fres of
1965 FL.Partial fs1 -> do
1966 resS <- sinitial
1967 case resS of
1968 IPartial ss ->
1969 return $ Partial n (SepBySeparator fs1 ss False)
1970 IDone _ -> errMsg "separator" "succeed"
1971 IError _ -> errMsg "separator" "fail"
1972 FL.Done c -> return $ Done n c
1973 Error err -> return $ Error err
1974 step (SepBySeparator fs ss consumed) a = do
1975 r <- sstep ss a
1976 case r of
1977 Partial n s -> return $ Partial n (SepBySeparator fs s True)
1978 Continue n s -> return $ Continue n (SepBySeparator fs s True)
1979 Done n _ ->
1980 if consumed
1981 then do
1982 resP <- pinitial
1983 case resP of
1984 IPartial sp -> return $ Partial n $ SepByInit fs sp
1985 IDone _ -> errMsg "content" "succeed"
1986 IError _ -> errMsg "content" "fail"
1987 else error "sepBy: infinite loop"
1988 Error err -> return $ Error err
1990 extract (SepByInit fs sp) = do
1991 r <- pextract sp
1992 case r of
1993 Done n b -> do
1994 res <- fstep fs b
1995 case res of
1996 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
1997 FL.Done c -> return (Done n c)
1998 Error err -> return $ Error err
1999 Continue n s -> return $ Continue n (SepByInit fs s)
2000 Partial _ _ -> error "Partial in extract"
2002 extract (SepBySeparator fs _ _) = fmap (Done 0) $ fextract fs
2004-------------------------------------------------------------------------------
2005-- Sequential Collection
2006-------------------------------------------------------------------------------
2008-- | See 'Streamly.Internal.Data.Parser.sequence'.
2009{-# INLINE sequence #-}
2010sequence :: Monad m =>
2011 D.Stream m (Parser m a b) -> Fold m b c -> Parser m a c
2012sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
2013 Parser step initial extract
2015 where
2017 initial = do
2018 fres <- finitial
2019 case fres of
2020 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
2021 FL.Done c -> return $ IDone c
2023 -- state does not contain any parser
2024 -- yield a new parser from the stream
2025 step (Nothing', ss, fs) _ = do
2026 sres <- sstep defState ss
2027 case sres of
2028 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
2029 D.Stop -> do
2030 c <- fextract fs
2031 return $ Done 1 c
2032 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
2034 -- state holds a parser that may or may not have been
2035 -- initialized. pinit holds the initial parser state
2036 -- or modified parser state respectively
2037 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
2038 ps <- pinit
2039 case ps of
2040 IPartial ps1 -> do
2041 pres <- pstep ps1 a
2042 case pres of
2043 Partial n ps2 ->
2044 let newP =
2045 Just' $ Parser pstep (return $ IPartial ps2) pextr
2046 in return $ Partial n (newP, ss, fs)
2047 Continue n ps2 ->
2048 let newP =
2049 Just' $ Parser pstep (return $ IPartial ps2) pextr
2050 in return $ Continue n (newP, ss, fs)
2051 Done n b -> do
2052 fres <- fstep fs b
2053 case fres of
2054 FL.Partial fs1 ->
2055 return $ Partial n (Nothing', ss, fs1)
2056 FL.Done c -> return $ Done n c
2057 Error msg -> return $ Error msg
2058 IDone b -> do
2059 fres <- fstep fs b
2060 case fres of
2061 FL.Partial fs1 ->
2062 return $ Partial 1 (Nothing', ss, fs1)
2063 FL.Done c -> return $ Done 1 c
2064 IError err -> return $ Error err
2066 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
2067 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
2068 ps <- pinit
2069 case ps of
2070 IPartial ps1 -> do
2071 r <- pextr ps1
2072 case r of
2073 Done n b -> do
2074 res <- fstep fs b
2075 case res of
2076 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2077 FL.Done c -> return (Done n c)
2078 Error err -> return $ Error err
2079 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
2080 Partial _ _ -> error "Partial in extract"
2081 IDone b -> do
2082 fres <- fstep fs b
2083 case fres of
2084 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
2085 FL.Done c -> return (Done 0 c)
2086 IError err -> return $ Error err
2088-------------------------------------------------------------------------------
2089-- Alternative Collection
2090-------------------------------------------------------------------------------
2093-- | See 'Streamly.Internal.Data.Parser.choice'.
2095-- /Broken/
2097{-# INLINE choice #-}
2098choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
2099choice = foldl1 shortest
2102-------------------------------------------------------------------------------
2103-- Sequential Repetition
2104-------------------------------------------------------------------------------
2106{-# INLINE manyP #-}
2107manyP :: -- MonadCatch m =>
2108 Parser m a b -> Parser m b c -> Parser m a c
2109manyP _p _f = undefined
2111-- | See 'Streamly.Internal.Data.Parser.many'.
2113-- /Pre-release/
2115{-# INLINE many #-}
2116many :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
2117many = splitMany
2118-- many = countBetween 0 maxBound
2120-- | See 'Streamly.Internal.Data.Parser.some'.
2122-- /Pre-release/
2124{-# INLINE some #-}
2125some :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
2126some = splitSome
2127-- some p f = manyP p (takeGE 1 f)
2128-- some = countBetween 1 maxBound
2130-- | See 'Streamly.Internal.Data.Parser.countBetween'.
2132-- /Unimplemented/
2134{-# INLINE countBetween #-}
2135countBetween :: -- MonadCatch m =>
2136 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
2137countBetween _m _n _p = undefined
2138-- countBetween m n p f = manyP p (takeBetween m n f)
2140-- | See 'Streamly.Internal.Data.Parser.count'.
2142-- /Unimplemented/
2144{-# INLINE count #-}
2145count :: -- MonadCatch m =>
2146 Int -> Parser m a b -> Fold m b c -> Parser m a c
2147count n = countBetween n n
2148-- count n p f = manyP p (takeEQ n f)
2150data ManyTillState fs sr sl
2151 = ManyTillR Int fs sr
2152 | ManyTillL Int fs sl
2154-- | See 'Streamly.Internal.Data.Parser.manyTill'.
2156-- /Pre-release/
2158{-# INLINE manyTill #-}
2159manyTill :: Monad m
2160 => Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
2161manyTill (Parser stepL initialL extractL)
2162 (Parser stepR initialR _)
2163 (Fold fstep finitial fextract) =
2164 Parser step initial extract
2166 where
2168 -- Caution: Mutual recursion
2170 scrutL fs p c d e = do
2171 resL <- initialL
2172 case resL of
2173 IPartial sl -> return $ c (ManyTillL 0 fs sl)
2174 IDone bl -> do
2175 fr <- fstep fs bl
2176 case fr of
2177 FL.Partial fs1 -> scrutR fs1 p c d e
2178 FL.Done fb -> return $ d fb
2179 IError err -> return $ e err
2181 scrutR fs p c d e = do
2182 resR <- initialR
2183 case resR of
2184 IPartial sr -> return $ p (ManyTillR 0 fs sr)
2185 IDone _ -> d <$> fextract fs
2186 IError _ -> scrutL fs p c d e
2188 initial = do
2189 res <- finitial
2190 case res of
2191 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
2192 FL.Done b -> return $ IDone b
2194 step (ManyTillR cnt fs st) a = do
2195 r <- stepR st a
2196 case r of
2197 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
2198 Continue n s -> do
2199 assertM(cnt + 1 - n >= 0)
2200 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
2201 Done n _ -> do
2202 b <- fextract fs
2203 return $ Done n b
2204 Error _ -> do
2205 resL <- initialL
2206 case resL of
2207 IPartial sl ->
2208 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
2209 IDone bl -> do
2210 fr <- fstep fs bl
2211 let cnt1 = cnt + 1
2212 p = Partial cnt
2213 c = Continue cnt
2214 d = Done cnt
2215 case fr of
2216 FL.Partial fs1 -> scrutR fs1 p c d Error
2217 FL.Done fb -> return $ Done cnt1 fb
2218 IError err -> return $ Error err
2219 -- XXX the cnt is being used only by the assert
2220 step (ManyTillL cnt fs st) a = do
2221 r <- stepL st a
2222 case r of
2223 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
2224 Continue n s -> do
2225 assertM(cnt + 1 - n >= 0)
2226 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
2227 Done n b -> do
2228 fs1 <- fstep fs b
2229 case fs1 of
2230 FL.Partial s ->
2231 scrutR s (Partial n) (Continue n) (Done n) Error
2232 FL.Done b1 -> return $ Done n b1
2233 Error err -> return $ Error err
2235 extract (ManyTillL cnt fs sR) = do
2236 res <- extractL sR
2237 case res of
2238 Done n b -> do
2239 r <- fstep fs b
2240 case r of
2241 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2242 FL.Done c -> return (Done n c)
2243 Error err -> return $ Error err
2244 Continue n s -> do
2245 assertM(n == cnt)
2246 return $ Continue n (ManyTillL 0 fs s)
2247 Partial _ _ -> error "Partial in extract"
2248 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs