git.iko.soy/streamly
on e40c09c help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
878 lines 25 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 (..)
19 -- First order parsers
20 -- * Accumulators
21 , fromFold
22 , yield
23 , yieldM
24 , die
25 , dieM
27 -- * Element parsers
28 , peek
29 , eof
30 , satisfy
31 , maybe
32 , either
34 -- * Sequence parsers
35 --
36 -- Parsers chained in series, if one parser terminates the composition
37 -- terminates. Currently we are using folds to collect the output of the
38 -- parsers but we can use Parsers instead of folds to make the composition
39 -- more powerful. For example, we can do:
40 --
41 -- sliceSepByMax cond n p = sliceBy cond (take n p)
42 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
43 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
44 --
45 -- Grab a sequence of input elements without inspecting them
46 , takeBetween
47 -- , takeLE -- take -- takeBetween 0 n
48 -- , takeLE1 -- take1 -- takeBetween 1 n
49 , takeEQ -- takeBetween n n
50 , takeGE -- takeBetween n maxBound
52 -- Grab a sequence of input elements by inspecting them
53 , lookAhead
54 , takeWhile
55 , takeWhile1
56 , sliceSepByP
57 -- , sliceSepByBetween
58 , sliceBeginWith
59 -- , sliceSepWith
60 --
61 -- , frameSepBy -- parse frames escaped by an escape char/sequence
62 -- , frameEndWith
63 --
64 , wordBy
65 , groupBy
66 , groupByRolling
67 , eqBy
68 -- , prefixOf -- match any prefix of a given string
69 -- , suffixOf -- match any suffix of a given string
70 -- , infixOf -- match any substring of a given string
72 -- Second order parsers (parsers using parsers)
73 -- * Binary Combinators
75 -- ** Sequential Applicative
76 , splitWith
77 , split_
79 -- ** Parallel Applicatives
80 , teeWith
81 , teeWithFst
82 , teeWithMin
83 -- , teeTill -- like manyTill but parallel
85 -- ** Sequential Interleaving
86 -- Use two folds, run a primary parser, its rejected values go to the
87 -- secondary parser.
88 , deintercalate
90 -- ** Sequential Alternative
91 , alt
93 -- ** Parallel Alternatives
94 , shortest
95 , longest
96 -- , fastest
98 -- * N-ary Combinators
99 -- ** Sequential Collection
100 , sequence
101 , concatMap
103 -- ** Sequential Repetition
104 , count
105 , countBetween
106 -- , countBetweenTill
108 , many
109 , some
110 , manyTill
112 -- -- ** Special cases
113 -- XXX traditional implmentations of these may be of limited use. For
114 -- example, consider parsing lines separated by "\r\n". The main parser
115 -- will have to detect and exclude the sequence "\r\n" anyway so that we
116 -- can apply the "sep" parser.
117 --
118 -- We can instead implement these as special cases of deintercalate.
119 --
120 -- , endBy
121 -- , sepBy
122 -- , sepEndBy
123 -- , beginBy
124 -- , sepBeginBy
125 -- , sepAroundBy
127 -- -- * Distribution
128 --
129 -- A simple and stupid impl would be to just convert the stream to an array
130 -- and give the array reference to all consumers. The array can be grown on
131 -- demand by any consumer and truncated when nonbody needs it.
132 --
133 -- -- ** Distribute to collection
134 -- -- ** Distribute to repetition
136 -- -- ** Interleaved collection
137 -- Round robin
138 -- Priority based
139 -- -- ** Interleaved repetition
140 -- repeat one parser and when it fails run an error recovery parser
141 -- e.g. to find a key frame in the stream after an error
143 -- ** Collection of Alternatives
144 -- , shortestN
145 -- , longestN
146 -- , fastestN -- first N successful in time
147 -- , choiceN -- first N successful in position
148 , choice -- first successful in position
150 -- -- ** Repeated Alternatives
151 -- , retryMax -- try N times
152 -- , retryUntil -- try until successful
153 -- , retryUntilN -- try until successful n times
154 )
155where
157import Control.Exception (assert)
158import Control.Monad.Catch (MonadCatch, MonadThrow(..))
159import Streamly.Internal.Data.Fold.Types (Fold(..))
160import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
162import qualified Streamly.Internal.Data.Fold.Types as FL
164import Prelude hiding
165 (any, all, take, takeWhile, sequence, concatMap, maybe, either)
166import Streamly.Internal.Data.Parser.ParserD.Tee
167import Streamly.Internal.Data.Parser.ParserD.Types
169-------------------------------------------------------------------------------
170-- Upgrade folds to parses
171-------------------------------------------------------------------------------
172--
173-- | See 'Streamly.Internal.Data.Parser.fromFold'.
174--
175-- /Internal/
176--
177{-# INLINE fromFold #-}
178fromFold :: Monad m => Fold m a b -> Parser m a b
179fromFold (Fold fstep finitial fextract) = Parser step finitial extract
181 where
183 step (FL.Partial s) a = do
184 res <- fstep s a
185 return
186 $ case res of
187 FL.Partial s1 -> Partial 0 (FL.Partial s1)
188 FL.Done b -> Done 0 b
189 step (FL.Done b) _ = return $ Done 1 b
191 extract (FL.Partial s) = fextract s
192 extract (FL.Done b) = return b
194-------------------------------------------------------------------------------
195-- Failing Parsers
196-------------------------------------------------------------------------------
198-- | See 'Streamly.Internal.Data.Parser.peek'.
199--
200-- /Internal/
201--
202{-# INLINABLE peek #-}
203peek :: MonadThrow m => Parser m a a
204peek = Parser step initial extract
206 where
208 initial = return ()
210 step () a = return $ Done 1 a
212 extract () = throwM $ ParseError "peek: end of input"
214-- | See 'Streamly.Internal.Data.Parser.eof'.
215--
216-- /Internal/
217--
218{-# INLINABLE eof #-}
219eof :: Monad m => Parser m a ()
220eof = Parser step initial return
222 where
224 initial = return ()
226 step () _ = return $ Error "eof: not at end of input"
228-- | See 'Streamly.Internal.Data.Parser.satisfy'.
229--
230-- /Internal/
231--
232{-# INLINE satisfy #-}
233satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
234satisfy predicate = Parser step initial extract
236 where
238 initial = return ()
240 step () a = return $
241 if predicate a
242 then Done 0 a
243 else Error "satisfy: predicate failed"
245 extract _ = throwM $ ParseError "satisfy: end of input"
247-- | See 'Streamly.Internal.Data.Parser.maybe'.
248--
249-- /Internal/
250--
251{-# INLINE maybe #-}
252maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
253maybe parser = Parser step initial extract
255 where
257 initial = return ()
259 step () a = return $
260 case parser a of
261 Just b -> Done 0 b
262 Nothing -> Error "maybe: predicate failed"
264 extract _ = throwM $ ParseError "maybe: end of input"
266-- | See 'Streamly.Internal.Data.Parser.either'.
267--
268-- /Internal/
269--
270{-# INLINE either #-}
271either :: MonadThrow m => (a -> Either String b) -> Parser m a b
272either parser = Parser step initial extract
274 where
276 initial = return ()
278 step () a = return $
279 case parser a of
280 Right b -> Done 0 b
281 Left err -> Error $ "either: " ++ err
283 extract _ = throwM $ ParseError "either: end of input"
285-------------------------------------------------------------------------------
286-- Taking elements
287-------------------------------------------------------------------------------
289-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
290--
291-- /Internal/
292--
293{-# INLINE takeBetween #-}
294takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
295takeBetween low high (Fold fstep finitial fextract) =
297 Parser step initial extract
299 where
301 initial = do
302 res <- finitial
303 case res of
304 FL.Partial s -> return $ Tuple' 0 s
305 FL.Done _ ->
306 error "takeBetween: Done/Error in initial not implemented yet."
308 step (Tuple' i s) a
309 | low > high =
310 throwM
311 $ ParseError
312 $ "takeBetween: lower bound - " ++ show low
313 ++ " is greater than higher bound - " ++ show high
314 | high <= 0 = Done 1 <$> fextract s
315 | i1 < low = do
316 res <- fstep s a
317 return
318 $ case res of
319 FL.Partial s1 -> Continue 0 $ Tuple' i1 s1
320 FL.Done _ ->
321 Error
322 $ "takeBetween: the collecting fold terminated after"
323 ++ " consuming" ++ show i1 ++ " elements"
324 ++ " minimum" ++ show low ++ " elements needed"
325 | otherwise = do
326 res <- fstep s a
327 case res of
328 FL.Partial s1 ->
329 if i1 >= high
330 then Done 0 <$> fextract s1
331 else return $ Partial 0 $ Tuple' i1 s1
332 FL.Done b -> return $ Done 0 b
334 where
336 i1 = i + 1
338 extract (Tuple' i s)
339 | i >= low && i <= high = fextract s
340 | otherwise = throwM $ ParseError err
342 where
344 err =
345 "takeBetween: Expecting alteast " ++ show low
346 ++ " elements, got " ++ show i
348-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
349--
350-- /Internal/
351--
352{-# INLINE takeEQ #-}
353takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
354takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
356 where
358 cnt = max n 0
360 initial = do
361 res <- finitial
362 case res of
363 FL.Partial s -> return $ Tuple' 0 s
364 FL.Done _ ->
365 error "takeEQ: Done/Error in initial not implemented yet."
367 step (Tuple' i r) a
368 | i1 < cnt = do
369 res <- fstep r a
370 return
371 $ case res of
372 FL.Partial s -> Continue 0 $ Tuple' i1 s
373 FL.Done _ ->
374 Error
375 $ "takeEQ: Expecting exactly " ++ show cnt
376 ++ " elements, fold terminated on " ++ show i1
377 | i1 == cnt = do
378 res <- fstep r a
379 Done 0
380 <$> case res of
381 FL.Partial s -> fextract s
382 FL.Done b -> return b
383 -- XXX we should not reach here when initial returns Step type
384 -- reachable only when n == 0
385 | otherwise = Done 1 <$> fextract r
387 where
389 i1 = i + 1
391 extract (Tuple' i r)
392 | i == 0 && cnt == 0 = fextract r
393 | otherwise =
394 throwM
395 $ ParseError
396 $ "takeEQ: Expecting exactly " ++ show cnt
397 ++ " elements, input terminated on " ++ show i
399-- | See 'Streamly.Internal.Data.Parser.takeGE'.
400--
401-- /Internal/
402--
403{-# INLINE takeGE #-}
404takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
405takeGE n (Fold fstep finitial fextract) = Parser step initial extract
407 where
409 cnt = max n 0
410 initial = do
411 res <- finitial
412 case res of
413 FL.Partial s -> return $ Tuple' 0 s
414 FL.Done _ ->
415 error "takeGE: Done/Error in initial not implemented yet."
417 step (Tuple' i r) a
418 | i1 < cnt = do
419 res <- fstep r a
420 return
421 $ case res of
422 FL.Partial s -> Continue 0 $ Tuple' i1 s
423 FL.Done _ ->
424 Error
425 $ "takeGE: Expecting at least " ++ show cnt
426 ++ " elements, fold terminated on " ++ show i1
427 | otherwise = do
428 res <- fstep r a
429 return
430 $ case res of
431 FL.Partial s -> Partial 0 $ Tuple' i1 s
432 FL.Done b -> Done 0 b
434 where
436 i1 = i + 1
438 extract (Tuple' i r)
439 | i >= cnt = fextract r
440 | otherwise =
441 throwM
442 $ ParseError
443 $ "takeGE: Expecting at least " ++ show cnt
444 ++ " elements, input terminated on " ++ show i
446-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
447--
448-- /Internal/
449--
450{-# INLINE takeWhile #-}
451takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
452takeWhile predicate (Fold fstep finitial fextract) =
453 Parser step initial fextract
455 where
457 initial = do
458 res <- finitial
459 case res of
460 FL.Partial s -> return s
461 FL.Done _ ->
462 error "takeWhile: Done/Error in initial not implemented yet."
464 step s a =
465 if predicate a
466 then do
467 fres <- fstep s a
468 return
469 $ case fres of
470 FL.Partial s1 -> Partial 0 s1
471 FL.Done b -> Done 0 b
472 else Done 1 <$> fextract s
474-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
475--
476-- /Internal/
477--
478{-# INLINE takeWhile1 #-}
479takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
480takeWhile1 predicate (Fold fstep finitial fextract) =
481 Parser step initial extract
483 where
485 initial = return Nothing
487 step Nothing a =
488 let err = Error "takeWhile1: predicate failed on first element"
489 in if predicate a
490 then do
491 res <- finitial
492 case res of
493 FL.Partial s -> do
494 sr <- fstep s a
495 return
496 $ case sr of
497 FL.Partial s1 -> Partial 0 (Just s1)
498 FL.Done b -> Done 0 b
499 FL.Done _ -> return err
500 else return err
501 step (Just s) a =
502 if predicate a
503 then do
504 sr <- fstep s a
505 case sr of
506 FL.Partial r -> return $ Partial 0 (Just r)
507 FL.Done b -> return $ Done 0 b
508 else do
509 b <- fextract s
510 return $ Done 1 b
512 extract Nothing = throwM $ ParseError "takeWhile1: end of input"
513 extract (Just s) = fextract s
515-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
516--
517-- /Internal/
518--
519sliceSepByP :: MonadCatch m =>
520 (a -> Bool) -> Parser m a b -> Parser m a b
521sliceSepByP cond (Parser pstep pinitial pextract) =
523 Parser step initial pextract
525 where
527 initial = pinitial
529 step s a =
530 if cond a
531 then do
532 res <- pextract s
533 return $ Done 0 res
534 else pstep s a
536-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
537--
538-- /Unimplemented/
539--
540{-# INLINABLE sliceBeginWith #-}
541sliceBeginWith ::
542 -- Monad m =>
543 (a -> Bool) -> Fold m a b -> Parser m a b
544sliceBeginWith = undefined
546data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
548-- | See 'Streamly.Internal.Data.Parser.wordBy'.
549--
550--
551{-# INLINE wordBy #-}
552wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
553wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
555 where
557 {-# INLINE worder #-}
558 worder s a = do
559 res <- fstep s a
560 return
561 $ case res of
562 FL.Partial s1 -> Partial 0 $ WBWord s1
563 FL.Done b -> Done 0 b
565 initial = do
566 res <- finitial
567 return
568 $ case res of
569 FL.Partial s -> WBLeft s
570 FL.Done _ -> error "wordBy: Done in initial not implemented"
572 step (WBLeft s) a =
573 if not (predicate a)
574 then worder s a
575 else return $ Partial 0 $ WBLeft s
576 step (WBWord s) a =
577 if not (predicate a)
578 then worder s a
579 else do
580 b <- fextract s
581 return $ Partial 0 $ WBRight b
582 step (WBRight b) a =
583 return
584 $ if not (predicate a)
585 then Done 1 b
586 else Partial 0 $ WBRight b
588 extract (WBLeft s) = fextract s
589 extract (WBWord s) = fextract s
590 extract (WBRight b) = return b
592data GroupByState a s
593 = GroupByInit !s
594 | GroupByGrouping !a !s
596-- | See 'Streamly.Internal.Data.Parser.groupBy'.
597--
598{-# INLINE groupBy #-}
599groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
600groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
602 where
604 {-# INLINE grouper #-}
605 grouper s a0 a = do
606 res <- fstep s a
607 return
608 $ case res of
609 FL.Done b -> Done 0 b
610 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
612 initial = do
613 res <- finitial
614 return
615 $ case res of
616 FL.Partial s -> GroupByInit s
617 FL.Done _ -> error "groupBy: Done in initial not implemented"
619 step (GroupByInit s) a = grouper s a a
620 step (GroupByGrouping a0 s) a =
621 if eq a0 a
622 then grouper s a0 a
623 else Done 1 <$> fextract s
625 extract (GroupByInit s) = fextract s
626 extract (GroupByGrouping _ s) = fextract s
628-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
629--
630{-# INLINE groupByRolling #-}
631groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
632groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
634 where
636 {-# INLINE grouper #-}
637 grouper s a = do
638 res <- fstep s a
639 return
640 $ case res of
641 FL.Done b -> Done 0 b
642 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
644 initial = do
645 res <- finitial
646 return
647 $ case res of
648 FL.Partial s -> GroupByInit s
649 FL.Done _ -> error "groupByRolling: Done in initial not implemented"
651 step (GroupByInit s) a = grouper s a
652 step (GroupByGrouping a0 s) a =
653 if eq a0 a
654 then grouper s a
655 else Done 1 <$> fextract s
657 extract (GroupByInit s) = fextract s
658 extract (GroupByGrouping _ s) = fextract s
660-- XXX use an Unfold instead of a list?
661-- XXX custom combinators for matching list, array and stream?
662--
663-- | See 'Streamly.Internal.Data.Parser.eqBy'.
664--
665-- /Internal/
666--
667{-# INLINE eqBy #-}
668eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
669eqBy cmp str = Parser step initial extract
671 where
673 initial = return str
675 step [] _ = return $ Done 0 ()
676 step [x] a =
677 return
678 $ if x `cmp` a
679 then Done 0 ()
680 else Error "eqBy: failed, yet to match the last element"
681 step (x:xs) a =
682 return
683 $ if x `cmp` a
684 then Continue 0 xs
685 else Error
686 $ "eqBy: failed, yet to match "
687 ++ show (length xs + 1) ++ " elements"
689 extract xs =
690 throwM
691 $ ParseError
692 $ "eqBy: end of input, yet to match "
693 ++ show (length xs) ++ " elements"
695-------------------------------------------------------------------------------
696-- nested parsers
697-------------------------------------------------------------------------------
699-- | See 'Streamly.Internal.Data.Parser.lookahead'.
700--
701-- /Internal/
702--
703{-# INLINE lookAhead #-}
704lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
705lookAhead (Parser step1 initial1 _) = Parser step initial extract
707 where
709 initial = Tuple' 0 <$> initial1
711 step (Tuple' cnt st) a = do
712 r <- step1 st a
713 let cnt1 = cnt + 1
714 return
715 $ case r of
716 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
717 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
718 Done _ b -> Done cnt1 b
719 Error err -> Error err
721 -- XXX returning an error let's us backtrack. To implement it in a way so
722 -- that it terminates on eof without an error then we need a way to
723 -- backtrack on eof, that will require extract to return 'Step' type.
724 extract (Tuple' n _) =
725 throwM
726 $ ParseError
727 $ "lookAhead: end of input after consuming "
728 ++ show n ++ " elements"
730-------------------------------------------------------------------------------
731-- Interleaving
732-------------------------------------------------------------------------------
733--
734-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
735--
736-- /Unimplemented/
737--
738{-# INLINE deintercalate #-}
739deintercalate ::
740 -- Monad m =>
741 Fold m a y -> Parser m x a
742 -> Fold m b z -> Parser m x b
743 -> Parser m x (y, z)
744deintercalate = undefined
746-------------------------------------------------------------------------------
747-- Sequential Collection
748-------------------------------------------------------------------------------
749--
750-- | See 'Streamly.Internal.Data.Parser.sequence'.
751--
752-- /Unimplemented/
753--
754{-# INLINE sequence #-}
755sequence ::
756 -- Foldable t =>
757 Fold m b c -> t (Parser m a b) -> Parser m a c
758sequence _f _p = undefined
760-------------------------------------------------------------------------------
761-- Alternative Collection
762-------------------------------------------------------------------------------
763--
764-- | See 'Streamly.Internal.Data.Parser.choice'.
765--
766-- /Unimplemented/
767--
768{-# INLINE choice #-}
769choice ::
770 -- Foldable t =>
771 t (Parser m a b) -> Parser m a b
772choice _ps = undefined
774-------------------------------------------------------------------------------
775-- Sequential Repetition
776-------------------------------------------------------------------------------
777--
778-- | See 'Streamly.Internal.Data.Parser.many'.
779--
780-- /Internal/
781--
782{-# INLINE many #-}
783many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
784many = splitMany
785-- many = countBetween 0 maxBound
787-- | See 'Streamly.Internal.Data.Parser.some'.
788--
789-- /Internal/
790--
791{-# INLINE some #-}
792some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
793some = splitSome
794-- some f p = many (takeGE 1 f) p
795-- many = countBetween 1 maxBound
797-- | See 'Streamly.Internal.Data.Parser.countBetween'.
798--
799-- /Unimplemented/
800--
801{-# INLINE countBetween #-}
802countBetween ::
803 -- MonadCatch m =>
804 Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
805countBetween _m _n _f = undefined
806-- countBetween m n f p = many (takeBetween m n f) p
808-- | See 'Streamly.Internal.Data.Parser.count'.
809--
810-- /Unimplemented/
811--
812{-# INLINE count #-}
813count ::
814 -- MonadCatch m =>
815 Int -> Fold m b c -> Parser m a b -> Parser m a c
816count n = countBetween n n
817-- count n f p = many (takeEQ n f) p
819data ManyTillState fs sr sl
820 = ManyTillR Int fs sr
821 | ManyTillL Int fs sl
823-- | See 'Streamly.Internal.Data.Parser.manyTill'.
824--
825-- /Internal/
826--
827{-# INLINE manyTill #-}
828manyTill :: MonadCatch m
829 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
830manyTill (Fold fstep finitial fextract)
831 (Parser stepL initialL extractL)
832 (Parser stepR initialR _) =
833 Parser step initial extract
835 where
837 initial = do
838 res <- finitial
839 case res of
840 FL.Partial fs -> ManyTillR 0 fs <$> initialR
841 FL.Done _ -> error "manyTill: Done in initial not implemented"
843 step (ManyTillR cnt fs st) a = do
844 r <- stepR st a
845 case r of
846 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
847 Continue n s -> do
848 assert (cnt + 1 - n >= 0) (return ())
849 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
850 Done n _ -> do
851 b <- fextract fs
852 return $ Done n b
853 Error _ -> do
854 rR <- initialL
855 return $ Continue (cnt + 1) (ManyTillL 0 fs rR)
856 -- XXX the cnt is being used only by the assert
857 step (ManyTillL cnt fs st) a = do
858 r <- stepL st a
859 case r of
860 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
861 Continue n s -> do
862 assert (cnt + 1 - n >= 0) (return ())
863 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
864 Done n b -> do
865 fs1 <- fstep fs b
866 case fs1 of
867 FL.Partial s -> do
868 l <- initialR
869 return $ Partial n (ManyTillR 0 s l)
870 FL.Done b1 -> return $ Done n b1
871 Error err -> return $ Error err
873 extract (ManyTillL _ fs sR) = do
874 res <- extractL sR >>= fstep fs
875 case res of
876 FL.Partial s -> fextract s
877 FL.Done b -> return b
878 extract (ManyTillR _ fs _) = fextract fs