git.iko.soy/streamly
on 162fc17 help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
2249 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 , eqBy
95 , matchBy
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 eqBy #-}
1478eqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser m a ()
1479eqBy 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 ()
1487 step [x] a =
1488 return
1489 $ if x `cmp` a
1490 then Done 0 ()
1491 else Error "eqBy: 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 $ "eqBy: failed, yet to match "
1498 ++ show (length xs + 1) ++ " elements"
1500 extract xs =
1501 return
1502 $ Error
1503 $ "eqBy: end of input, yet to match "
1504 ++ show (length xs) ++ " elements"
1506-- XXX rename to streamBy?
1507-- | Like eqBy but uses a stream instead of a list
1508{-# INLINE matchBy #-}
1509matchBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
1510matchBy cmp (D.Stream sstep state) = Parser step initial extract
1512 where
1514 initial = do
1515 r <- sstep defState state
1516 case r of
1517 D.Yield x s -> return $ IPartial (Just' x, s)
1518 D.Stop -> return $ IDone ()
1519 -- Need Skip/Continue in initial to loop right here
1520 D.Skip s -> return $ IPartial (Nothing', s)
1522 step (Just' x, st) a =
1523 if x `cmp` a
1524 then do
1525 r <- sstep defState st
1526 return
1527 $ case r of
1528 D.Yield x1 s -> Continue 0 (Just' x1, s)
1529 D.Stop -> Done 0 ()
1530 D.Skip s -> Continue 1 (Nothing', s)
1531 else return $ Error "match: mismtach occurred"
1532 step (Nothing', st) a = do
1533 r <- sstep defState st
1534 return
1535 $ case r of
1536 D.Yield x s -> do
1537 if x `cmp` a
1538 then Continue 0 (Nothing', s)
1539 else Error "match: mismatch occurred"
1540 D.Stop -> Done 1 ()
1541 D.Skip s -> Continue 1 (Nothing', s)
1543 extract _ = return $ Error "match: end of input"
1545-------------------------------------------------------------------------------
1546-- Transformations on input
1547-------------------------------------------------------------------------------
1549-- Initial needs a "Continue" constructor to implement scans on parsers. As a
1550-- parser can always return a Continue in initial when we feed the fold's
1551-- initial result to it. We can work this around for postscan by introducing an
1552-- initial state and calling "initial" only on the first input.
1554-- | Stateful scan on the input of a parser using a Fold.
1556-- /Unimplemented/
1558{-# INLINE postscan #-}
1559postscan :: -- Monad m =>
1560 Fold m a b -> Parser m b c -> Parser m a c
1561postscan = undefined
1563{-# INLINE zipWithM #-}
1564zipWithM :: Monad m =>
1565 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
1566zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
1567 Parser step initial extract
1569 where
1571 initial = do
1572 fres <- finitial
1573 case fres of
1574 FL.Partial fs -> do
1575 r <- sstep defState state
1576 case r of
1577 D.Yield x s -> return $ IPartial (Just' x, s, fs)
1578 D.Stop -> do
1579 x <- fextract fs
1580 return $ IDone x
1581 -- Need Skip/Continue in initial to loop right here
1582 D.Skip s -> return $ IPartial (Nothing', s, fs)
1583 FL.Done x -> return $ IDone x
1585 step (Just' a, st, fs) b = do
1586 c <- zf a b
1587 fres <- fstep fs c
1588 case fres of
1589 FL.Partial fs1 -> do
1590 r <- sstep defState st
1591 case r of
1592 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
1593 D.Stop -> do
1594 x <- fextract fs1
1595 return $ Done 0 x
1596 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
1597 FL.Done x -> return $ Done 0 x
1598 step (Nothing', st, fs) b = do
1599 r <- sstep defState st
1600 case r of
1601 D.Yield a s -> do
1602 c <- zf a b
1603 fres <- fstep fs c
1604 case fres of
1605 FL.Partial fs1 ->
1606 return $ Continue 0 (Nothing', s, fs1)
1607 FL.Done x -> return $ Done 0 x
1608 D.Stop -> do
1609 x <- fextract fs
1610 return $ Done 1 x
1611 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
1613 extract _ = return $ Error "zipWithM: end of input"
1615-- | Zip the input of a fold with a stream.
1617-- /Pre-release/
1619{-# INLINE zip #-}
1620zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser m b x
1621zip = zipWithM (curry return)
1623-- | Pair each element of a fold input with its index, starting from index 0.
1625-- /Pre-release/
1626{-# INLINE indexed #-}
1627indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser m a b
1628indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
1630-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
1631-- function using a fold indexing function that attaches an index to each input
1632-- element and a filtering function that filters using @(index, element) ->
1633-- Bool) as predicate.
1635-- For example:
1637-- @
1638-- filterWithIndex = makeIndexFilter indexed filter
1639-- filterWithAbsTime = makeIndexFilter timestamped filter
1640-- filterWithRelTime = makeIndexFilter timeIndexed filter
1641-- @
1643-- /Pre-release/
1644{-# INLINE makeIndexFilter #-}
1645makeIndexFilter ::
1646 (Fold m (s, a) b -> Parser m a b)
1647 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
1648 -> (((s, a) -> Bool) -> Fold m a b -> Parser m a b)
1649makeIndexFilter f comb g = f . comb g . FL.lmap snd
1651-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
1652-- then every element at strides of @stride@.
1654-- /Pre-release/
1655{-# INLINE sampleFromthen #-}
1656sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser m a b
1657sampleFromthen offset size =
1658 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
1660--------------------------------------------------------------------------------
1661--- Spanning
1662--------------------------------------------------------------------------------
1664-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1665-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1666-- input.
1668-- @
1669-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
1671-- > span_ (< 1) [1,2,3]
1672-- ([],[1,2,3])
1674-- > span_ (< 2) [1,2,3]
1675-- ([1],[2,3])
1677-- > span_ (< 4) [1,2,3]
1678-- ([1,2,3],[])
1680-- @
1682-- /Pre-release/
1683{-# INLINE span #-}
1684span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1685span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1687-- | Break the input stream into two groups, the first group takes the input as
1688-- long as the predicate applied to the first element of the stream and next
1689-- input element holds 'True', the second group takes the rest of the input.
1691-- /Pre-release/
1693{-# INLINE spanBy #-}
1694spanBy ::
1695 Monad m
1696 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1697spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1699-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1700-- predicate is applied to the previous and the next input elements.
1702-- /Pre-release/
1703{-# INLINE spanByRolling #-}
1704spanByRolling ::
1705 Monad m
1706 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1707spanByRolling eq f1 f2 =
1708 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1710-------------------------------------------------------------------------------
1711-- nested parsers
1712-------------------------------------------------------------------------------
1714-- | See 'Streamly.Internal.Data.Parser.takeP'.
1716-- /Internal/
1717{-# INLINE takeP #-}
1718takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1719takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1721 where
1723 initial = do
1724 res <- pinitial
1725 case res of
1726 IPartial s ->
1727 if lim > 0
1728 then return $ IPartial $ Tuple' 0 s
1729 else iextract s
1730 IDone b -> return $ IDone b
1731 IError e -> return $ IError e
1733 step (Tuple' cnt r) a = do
1734 assertM(cnt < lim)
1735 res <- pstep r a
1736 let cnt1 = cnt + 1
1737 case res of
1738 Partial 0 s -> do
1739 assertM(cnt1 >= 0)
1740 if cnt1 < lim
1741 then return $ Partial 0 $ Tuple' cnt1 s
1742 else do
1743 r1 <- pextract s
1744 return $ case r1 of
1745 Done n b -> Done n b
1746 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
1747 Error err -> Error err
1748 Partial _ _ -> error "takeP: Partial in extract"
1750 Continue 0 s -> do
1751 assertM(cnt1 >= 0)
1752 if cnt1 < lim
1753 then return $ Continue 0 $ Tuple' cnt1 s
1754 else do
1755 r1 <- pextract s
1756 return $ case r1 of
1757 Done n b -> Done n b
1758 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
1759 Error err -> Error err
1760 Partial _ _ -> error "takeP: Partial in extract"
1761 Partial n s -> do
1762 let taken = cnt1 - n
1763 assertM(taken >= 0)
1764 return $ Partial n $ Tuple' taken s
1765 Continue n s -> do
1766 let taken = cnt1 - n
1767 assertM(taken >= 0)
1768 return $ Continue n $ Tuple' taken s
1769 Done n b -> return $ Done n b
1770 Error str -> return $ Error str
1772 extract (Tuple' cnt r) = do
1773 r1 <- pextract r
1774 return $ case r1 of
1775 Done n b -> Done n b
1776 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
1777 Error err -> Error err
1778 Partial _ _ -> error "takeP: Partial in extract"
1780 -- XXX Need to make the Initial type Step to remove this
1781 iextract s = do
1782 r <- pextract s
1783 return $ case r of
1784 Done _ b -> IDone b
1785 Error err -> IError err
1786 _ -> error "Bug: takeP invalid state in initial"
1788-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1790-- /Pre-release/
1792{-# INLINE lookAhead #-}
1793lookAhead :: Monad m => Parser m a b -> Parser m a b
1794lookAhead (Parser step1 initial1 _) = Parser step initial extract
1796 where
1798 initial = do
1799 res <- initial1
1800 return $ case res of
1801 IPartial s -> IPartial (Tuple' 0 s)
1802 IDone b -> IDone b
1803 IError e -> IError e
1805 step (Tuple' cnt st) a = do
1806 r <- step1 st a
1807 let cnt1 = cnt + 1
1808 return
1809 $ case r of
1810 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1811 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1812 Done _ b -> Done cnt1 b
1813 Error err -> Error err
1815 -- XXX returning an error let's us backtrack. To implement it in a way so
1816 -- that it terminates on eof without an error then we need a way to
1817 -- backtrack on eof, that will require extract to return 'Step' type.
1818 extract (Tuple' n _) =
1819 return
1820 $ Error
1821 $ "lookAhead: end of input after consuming "
1822 ++ show n ++ " elements"
1824-------------------------------------------------------------------------------
1825-- Interleaving
1826-------------------------------------------------------------------------------
1828data DeintercalateState fs sp ss =
1829 DeintercalateL !fs !sp
1830 | DeintercalateR !fs !ss !Bool
1832-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1834-- /Internal/
1836{-# INLINE deintercalate #-}
1837deintercalate :: Monad m =>
1838 Parser m a x
1839 -> Parser m a y
1840 -> Fold m (Either x y) z
1841 -> Parser m a z
1842deintercalate
1843 (Parser stepL initialL extractL)
1844 (Parser stepR initialR extractR)
1845 (Fold fstep finitial fextract) = Parser step initial extract
1847 where
1849 errMsg p status =
1850 error $ "deintercalate: " ++ p ++ " parser cannot "
1851 ++ status ++ " without input"
1853 initial = do
1854 res <- finitial
1855 case res of
1856 FL.Partial fs -> do
1857 resL <- initialL
1858 case resL of
1859 IPartial sL -> return $ IPartial $ DeintercalateL fs sL
1860 IDone _ -> errMsg "left" "succeed"
1861 IError _ -> errMsg "left" "fail"
1862 FL.Done c -> return $ IDone c
1864 step (DeintercalateL fs sL) a = do
1865 r <- stepL sL a
1866 case r of
1867 Partial n s -> return $ Partial n (DeintercalateL fs s)
1868 Continue n s -> return $ Continue n (DeintercalateL fs s)
1869 Done n b -> do
1870 fres <- fstep fs (Left b)
1871 case fres of
1872 FL.Partial fs1 -> do
1873 resR <- initialR
1874 case resR of
1875 IPartial sR ->
1876 return
1877 $ Partial n (DeintercalateR fs1 sR False)
1878 IDone _ -> errMsg "right" "succeed"
1879 IError _ -> errMsg "right" "fail"
1880 FL.Done c -> return $ Done n c
1881 Error err -> return $ Error err
1882 step (DeintercalateR fs sR consumed) a = do
1883 r <- stepR sR a
1884 case r of
1885 Partial n s -> return $ Partial n (DeintercalateR fs s True)
1886 Continue n s -> return $ Continue n (DeintercalateR fs s True)
1887 Done n b ->
1888 if consumed
1889 then do
1890 fres <- fstep fs (Right b)
1891 case fres of
1892 FL.Partial fs1 -> do
1893 resL <- initialL
1894 case resL of
1895 IPartial sL ->
1896 return $ Partial n $ DeintercalateL fs1 sL
1897 IDone _ -> errMsg "left" "succeed"
1898 IError _ -> errMsg "left" "fail"
1899 FL.Done c -> return $ Done n c
1900 else error "deintercalate: infinite loop"
1901 Error err -> return $ Error err
1903 {-# INLINE processResult #-}
1904 processResult n fs r = do
1905 res <- fstep fs r
1906 case res of
1907 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
1908 FL.Done c -> return (Done n c)
1910 extract (DeintercalateL fs sL) = do
1911 r <- extractL sL
1912 case r of
1913 Done n b -> processResult n fs (Left b)
1914 Error err -> return $ Error err
1915 Continue n s -> return $ Continue n (DeintercalateL fs s)
1916 Partial _ _ -> error "Partial in extract"
1918 extract (DeintercalateR fs sR consumed) = do
1919 r <- extractR sR
1920 case r of
1921 Done n b -> processResult n fs (Right b)
1922 Error err -> return $ Error err
1923 -- XXX Review consumed
1924 Continue n s -> return $ Continue n (DeintercalateR fs s consumed)
1925 Partial _ _ -> error "Partial in extract"
1927data SepByState fs sp ss =
1928 SepByInit !fs !sp
1929 | SepBySeparator !fs !ss !Bool
1931-- This is a special case of deintercalate and can be easily implemented in
1932-- terms of deintercalate.
1933{-# INLINE sepBy #-}
1934sepBy :: Monad m =>
1935 Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
1936sepBy
1937 (Parser pstep pinitial pextract)
1938 (Parser sstep sinitial _)
1939 (Fold fstep finitial fextract) = Parser step initial extract
1941 where
1943 errMsg p status =
1944 error $ "sepBy: " ++ p ++ " parser cannot "
1945 ++ status ++ " without input"
1947 initial = do
1948 res <- finitial
1949 case res of
1950 FL.Partial fs -> do
1951 resP <- pinitial
1952 case resP of
1953 IPartial sp -> return $ IPartial $ SepByInit fs sp
1954 IDone _ -> errMsg "content" "succeed"
1955 IError _ -> errMsg "content" "fail"
1956 FL.Done b -> return $ IDone b
1958 step (SepByInit fs sp) a = do
1959 r <- pstep sp a
1960 case r of
1961 Partial n s -> return $ Partial n (SepByInit fs s)
1962 Continue n s -> return $ Continue n (SepByInit fs s)
1963 Done n b -> do
1964 fres <- fstep fs b
1965 case fres of
1966 FL.Partial fs1 -> do
1967 resS <- sinitial
1968 case resS of
1969 IPartial ss ->
1970 return $ Partial n (SepBySeparator fs1 ss False)
1971 IDone _ -> errMsg "separator" "succeed"
1972 IError _ -> errMsg "separator" "fail"
1973 FL.Done c -> return $ Done n c
1974 Error err -> return $ Error err
1975 step (SepBySeparator fs ss consumed) a = do
1976 r <- sstep ss a
1977 case r of
1978 Partial n s -> return $ Partial n (SepBySeparator fs s True)
1979 Continue n s -> return $ Continue n (SepBySeparator fs s True)
1980 Done n _ ->
1981 if consumed
1982 then do
1983 resP <- pinitial
1984 case resP of
1985 IPartial sp -> return $ Partial n $ SepByInit fs sp
1986 IDone _ -> errMsg "content" "succeed"
1987 IError _ -> errMsg "content" "fail"
1988 else error "sepBy: infinite loop"
1989 Error err -> return $ Error err
1991 extract (SepByInit fs sp) = do
1992 r <- pextract sp
1993 case r of
1994 Done n b -> do
1995 res <- fstep fs b
1996 case res of
1997 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
1998 FL.Done c -> return (Done n c)
1999 Error err -> return $ Error err
2000 Continue n s -> return $ Continue n (SepByInit fs s)
2001 Partial _ _ -> error "Partial in extract"
2003 extract (SepBySeparator fs _ _) = fmap (Done 0) $ fextract fs
2005-------------------------------------------------------------------------------
2006-- Sequential Collection
2007-------------------------------------------------------------------------------
2009-- | See 'Streamly.Internal.Data.Parser.sequence'.
2010{-# INLINE sequence #-}
2011sequence :: Monad m =>
2012 D.Stream m (Parser m a b) -> Fold m b c -> Parser m a c
2013sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
2014 Parser step initial extract
2016 where
2018 initial = do
2019 fres <- finitial
2020 case fres of
2021 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
2022 FL.Done c -> return $ IDone c
2024 -- state does not contain any parser
2025 -- yield a new parser from the stream
2026 step (Nothing', ss, fs) _ = do
2027 sres <- sstep defState ss
2028 case sres of
2029 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
2030 D.Stop -> do
2031 c <- fextract fs
2032 return $ Done 1 c
2033 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
2035 -- state holds a parser that may or may not have been
2036 -- initialized. pinit holds the initial parser state
2037 -- or modified parser state respectively
2038 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
2039 ps <- pinit
2040 case ps of
2041 IPartial ps1 -> do
2042 pres <- pstep ps1 a
2043 case pres of
2044 Partial n ps2 ->
2045 let newP =
2046 Just' $ Parser pstep (return $ IPartial ps2) pextr
2047 in return $ Partial n (newP, ss, fs)
2048 Continue n ps2 ->
2049 let newP =
2050 Just' $ Parser pstep (return $ IPartial ps2) pextr
2051 in return $ Continue n (newP, ss, fs)
2052 Done n b -> do
2053 fres <- fstep fs b
2054 case fres of
2055 FL.Partial fs1 ->
2056 return $ Partial n (Nothing', ss, fs1)
2057 FL.Done c -> return $ Done n c
2058 Error msg -> return $ Error msg
2059 IDone b -> do
2060 fres <- fstep fs b
2061 case fres of
2062 FL.Partial fs1 ->
2063 return $ Partial 1 (Nothing', ss, fs1)
2064 FL.Done c -> return $ Done 1 c
2065 IError err -> return $ Error err
2067 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
2068 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
2069 ps <- pinit
2070 case ps of
2071 IPartial ps1 -> do
2072 r <- pextr ps1
2073 case r of
2074 Done n b -> do
2075 res <- fstep fs b
2076 case res of
2077 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2078 FL.Done c -> return (Done n c)
2079 Error err -> return $ Error err
2080 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
2081 Partial _ _ -> error "Partial in extract"
2082 IDone b -> do
2083 fres <- fstep fs b
2084 case fres of
2085 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
2086 FL.Done c -> return (Done 0 c)
2087 IError err -> return $ Error err
2089-------------------------------------------------------------------------------
2090-- Alternative Collection
2091-------------------------------------------------------------------------------
2094-- | See 'Streamly.Internal.Data.Parser.choice'.
2096-- /Broken/
2098{-# INLINE choice #-}
2099choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
2100choice = foldl1 shortest
2103-------------------------------------------------------------------------------
2104-- Sequential Repetition
2105-------------------------------------------------------------------------------
2107{-# INLINE manyP #-}
2108manyP :: -- MonadCatch m =>
2109 Parser m a b -> Parser m b c -> Parser m a c
2110manyP _p _f = undefined
2112-- | See 'Streamly.Internal.Data.Parser.many'.
2114-- /Pre-release/
2116{-# INLINE many #-}
2117many :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
2118many = splitMany
2119-- many = countBetween 0 maxBound
2121-- | See 'Streamly.Internal.Data.Parser.some'.
2123-- /Pre-release/
2125{-# INLINE some #-}
2126some :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
2127some = splitSome
2128-- some p f = manyP p (takeGE 1 f)
2129-- some = countBetween 1 maxBound
2131-- | See 'Streamly.Internal.Data.Parser.countBetween'.
2133-- /Unimplemented/
2135{-# INLINE countBetween #-}
2136countBetween :: -- MonadCatch m =>
2137 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
2138countBetween _m _n _p = undefined
2139-- countBetween m n p f = manyP p (takeBetween m n f)
2141-- | See 'Streamly.Internal.Data.Parser.count'.
2143-- /Unimplemented/
2145{-# INLINE count #-}
2146count :: -- MonadCatch m =>
2147 Int -> Parser m a b -> Fold m b c -> Parser m a c
2148count n = countBetween n n
2149-- count n p f = manyP p (takeEQ n f)
2151data ManyTillState fs sr sl
2152 = ManyTillR Int fs sr
2153 | ManyTillL Int fs sl
2155-- | See 'Streamly.Internal.Data.Parser.manyTill'.
2157-- /Pre-release/
2159{-# INLINE manyTill #-}
2160manyTill :: Monad m
2161 => Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
2162manyTill (Parser stepL initialL extractL)
2163 (Parser stepR initialR _)
2164 (Fold fstep finitial fextract) =
2165 Parser step initial extract
2167 where
2169 -- Caution: Mutual recursion
2171 scrutL fs p c d e = do
2172 resL <- initialL
2173 case resL of
2174 IPartial sl -> return $ c (ManyTillL 0 fs sl)
2175 IDone bl -> do
2176 fr <- fstep fs bl
2177 case fr of
2178 FL.Partial fs1 -> scrutR fs1 p c d e
2179 FL.Done fb -> return $ d fb
2180 IError err -> return $ e err
2182 scrutR fs p c d e = do
2183 resR <- initialR
2184 case resR of
2185 IPartial sr -> return $ p (ManyTillR 0 fs sr)
2186 IDone _ -> d <$> fextract fs
2187 IError _ -> scrutL fs p c d e
2189 initial = do
2190 res <- finitial
2191 case res of
2192 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
2193 FL.Done b -> return $ IDone b
2195 step (ManyTillR cnt fs st) a = do
2196 r <- stepR st a
2197 case r of
2198 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
2199 Continue n s -> do
2200 assertM(cnt + 1 - n >= 0)
2201 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
2202 Done n _ -> do
2203 b <- fextract fs
2204 return $ Done n b
2205 Error _ -> do
2206 resL <- initialL
2207 case resL of
2208 IPartial sl ->
2209 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
2210 IDone bl -> do
2211 fr <- fstep fs bl
2212 let cnt1 = cnt + 1
2213 p = Partial cnt
2214 c = Continue cnt
2215 d = Done cnt
2216 case fr of
2217 FL.Partial fs1 -> scrutR fs1 p c d Error
2218 FL.Done fb -> return $ Done cnt1 fb
2219 IError err -> return $ Error err
2220 -- XXX the cnt is being used only by the assert
2221 step (ManyTillL cnt fs st) a = do
2222 r <- stepL st a
2223 case r of
2224 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
2225 Continue n s -> do
2226 assertM(cnt + 1 - n >= 0)
2227 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
2228 Done n b -> do
2229 fs1 <- fstep fs b
2230 case fs1 of
2231 FL.Partial s ->
2232 scrutR s (Partial n) (Continue n) (Done n) Error
2233 FL.Done b1 -> return $ Done n b1
2234 Error err -> return $ Error err
2236 extract (ManyTillL cnt fs sR) = do
2237 res <- extractL sR
2238 case res of
2239 Done n b -> do
2240 r <- fstep fs b
2241 case r of
2242 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2243 FL.Done c -> return (Done n c)
2244 Error err -> return $ Error err
2245 Continue n s -> do
2246 assertM(n == cnt)
2247 return $ Continue n (ManyTillL 0 fs s)
2248 Partial _ _ -> error "Partial in extract"
2249 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs