git.iko.soy/streamly
on 0717458 help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
2247 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-- >>> import Prelude hiding ()
227-- >>> import qualified Data.Maybe as Maybe
228-- >>> import qualified Streamly.Data.Stream as Stream
229-- >>> import qualified Streamly.Internal.Data.Stream as Stream
230-- >>> import qualified Streamly.Data.Fold as Fold
231-- >>> import qualified Streamly.Internal.Data.Parser as Parser
233-------------------------------------------------------------------------------
234-- Downgrade a parser to a Fold
235-------------------------------------------------------------------------------
237-- | See 'Streamly.Internal.Data.Parser.toFold'.
238--
239-- /Internal/
240--
241{-# INLINE toFold #-}
242toFold :: Monad m => Parser m a b -> Fold m a b
243toFold (Parser pstep pinitial pextract) = Fold step initial extract
245 where
247 initial = do
248 r <- pinitial
249 case r of
250 IPartial s -> return $ FL.Partial s
251 IDone b -> return $ FL.Done b
252 IError err ->
253 error $ "toFold: parser throws error in initial" ++ err
255 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
256 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
257 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
258 eerror err = error $ "toFold: parser throws error: " ++ err
260 step st a = do
261 r <- pstep st a
262 case r of
263 Partial 0 s -> return $ FL.Partial s
264 Continue 0 s -> return $ FL.Partial s
265 Done 0 b -> return $ FL.Done b
266 Partial n _ -> perror n
267 Continue n _ -> cerror n
268 Done n _ -> derror n
269 Error err -> eerror err
271 extract st = do
272 r <- pextract st
273 case r of
274 Done 0 b -> return b
275 Partial n _ -> perror n
276 Continue n _ -> cerror n
277 Done n _ -> derror n
278 Error err -> eerror err
280-------------------------------------------------------------------------------
281-- Upgrade folds to parses
282-------------------------------------------------------------------------------
283--
284-- | See 'Streamly.Internal.Data.Parser.fromFold'.
285--
286-- /Pre-release/
287--
288{-# INLINE fromFold #-}
289fromFold :: Monad m => Fold m a b -> Parser m a b
290fromFold (Fold fstep finitial fextract) = Parser step initial extract
292 where
294 initial = do
295 res <- finitial
296 return
297 $ case res of
298 FL.Partial s1 -> IPartial s1
299 FL.Done b -> IDone b
301 step s a = do
302 res <- fstep s a
303 return
304 $ case res of
305 FL.Partial s1 -> Partial 0 s1
306 FL.Done b -> Done 0 b
308 extract = fmap (Done 0) . fextract
310-- | Convert Maybe returning folds to error returning parsers.
311--
312-- /Pre-release/
313--
314{-# INLINE fromFoldMaybe #-}
315fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser m a b
316fromFoldMaybe errMsg (Fold fstep finitial fextract) =
317 Parser step initial extract
319 where
321 initial = do
322 res <- finitial
323 return
324 $ case res of
325 FL.Partial s1 -> IPartial s1
326 FL.Done b ->
327 case b of
328 Just x -> IDone x
329 Nothing -> IError errMsg
331 step s a = do
332 res <- fstep s a
333 return
334 $ case res of
335 FL.Partial s1 -> Partial 0 s1
336 FL.Done b ->
337 case b of
338 Just x -> Done 0 x
339 Nothing -> Error errMsg
341 extract s = do
342 res <- fextract s
343 case res of
344 Just x -> return $ Done 0 x
345 Nothing -> return $ Error errMsg
347-------------------------------------------------------------------------------
348-- Failing Parsers
349-------------------------------------------------------------------------------
351-- | See 'Streamly.Internal.Data.Parser.peek'.
352--
353-- /Pre-release/
354--
355{-# INLINE peek #-}
356peek :: Monad m => Parser m a a
357peek = Parser step initial extract
359 where
361 initial = return $ IPartial ()
363 step () a = return $ Done 1 a
365 extract () = return $ Error "peek: end of input"
367-- | See 'Streamly.Internal.Data.Parser.eof'.
368--
369-- /Pre-release/
370--
371{-# INLINE eof #-}
372eof :: Monad m => Parser m a ()
373eof = Parser step initial extract
375 where
377 initial = return $ IPartial ()
379 step () _ = return $ Error "eof: not at end of input"
381 extract () = return $ Done 0 ()
383-- | See 'Streamly.Internal.Data.Parser.next'.
384--
385-- /Pre-release/
386--
387{-# INLINE next #-}
388next :: Monad m => Parser m a (Maybe a)
389next = Parser step initial extract
391 where
393 initial = pure $ IPartial ()
395 step () a = pure $ Done 0 (Just a)
397 extract () = pure $ Done 0 Nothing
399-- | See 'Streamly.Internal.Data.Parser.either'.
400--
401-- /Pre-release/
402--
403{-# INLINE either #-}
404either :: Monad m => (a -> Either String b) -> Parser m a b
405either f = Parser step initial extract
407 where
409 initial = return $ IPartial ()
411 step () a = return $
412 case f a of
413 Right b -> Done 0 b
414 Left err -> Error err
416 extract () = return $ Error "end of input"
418-- | See 'Streamly.Internal.Data.Parser.maybe'.
419--
420-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
421-- >>> maybe f = Parser.either (toEither . f)
422--
423-- /Pre-release/
424--
425{-# INLINE maybe #-}
426maybe :: Monad m => (a -> Maybe b) -> Parser m a b
427-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
428maybe parserF = Parser step initial extract
430 where
432 initial = return $ IPartial ()
434 step () a = return $
435 case parserF a of
436 Just b -> Done 0 b
437 Nothing -> Error "maybe: predicate failed"
439 extract () = return $ Error "maybe: end of input"
441-- | See 'Streamly.Internal.Data.Parser.satisfy'.
442--
443-- >>> toMaybe f x = if f x then Just x else Nothing
444-- >>> satisfy f = Parser.maybe (toMaybe f)
445--
446-- /Pre-release/
447--
448{-# INLINE satisfy #-}
449satisfy :: Monad m => (a -> Bool) -> Parser m a a
450-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
451satisfy predicate = Parser step initial extract
453 where
455 initial = return $ IPartial ()
457 step () a = return $
458 if predicate a
459 then Done 0 a
460 else Error "satisfy: predicate failed"
462 extract () = return $ Error "satisfy: end of input"
464-------------------------------------------------------------------------------
465-- Taking elements
466-------------------------------------------------------------------------------
468-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
469{-# ANN type Tuple'Fused Fuse #-}
470data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
472-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
473--
474-- /Pre-release/
475--
476{-# INLINE takeBetween #-}
477takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser m a b
478takeBetween low high (Fold fstep finitial fextract) =
480 Parser step initial (extract streamErr)
482 where
484 streamErr i =
485 "takeBetween: Expecting alteast " ++ show low
486 ++ " elements, got " ++ show i
488 invalidRange =
489 "takeBetween: lower bound - " ++ show low
490 ++ " is greater than higher bound - " ++ show high
492 foldErr :: Int -> String
493 foldErr i =
494 "takeBetween: the collecting fold terminated after"
495 ++ " consuming" ++ show i ++ " elements"
496 ++ " minimum" ++ show low ++ " elements needed"
498 -- Exactly the same as snext except different constructors, we can possibly
499 -- deduplicate the two.
500 {-# INLINE inext #-}
501 inext i res =
502 let i1 = i + 1
503 in case res of
504 FL.Partial s -> do
505 let s1 = Tuple'Fused i1 s
506 if i1 < high
507 -- XXX ideally this should be a Continue instead
508 then return $ IPartial s1
509 else iextract foldErr s1
510 FL.Done b ->
511 return
512 $ if i1 >= low
513 then IDone b
514 else IError (foldErr i1)
516 initial = do
517 when (low >= 0 && high >= 0 && low > high)
518 $ error invalidRange
520 finitial >>= inext (-1)
522 -- Keep the impl same as inext
523 {-# INLINE snext #-}
524 snext i res =
525 let i1 = i + 1
526 in case res of
527 FL.Partial s -> do
528 let s1 = Tuple'Fused i1 s
529 if i1 < high
530 then return $ Continue 0 s1
531 else extract foldErr s1
532 FL.Done b ->
533 return
534 $ if i1 >= low
535 then Done 0 b
536 else Error (foldErr i1)
538 step (Tuple'Fused i s) a = fstep s a >>= snext i
540 extract f (Tuple'Fused i s)
541 | i >= low && i <= high = fmap (Done 0) (fextract s)
542 | otherwise = return $ Error (f i)
544 -- XXX Need to make Initial return type Step to deduplicate this
545 iextract f (Tuple'Fused i s)
546 | i >= low && i <= high = fmap IDone (fextract s)
547 | otherwise = return $ IError (f i)
549-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
550--
551-- /Pre-release/
552--
553{-# INLINE takeEQ #-}
554takeEQ :: Monad m => Int -> Fold m a b -> Parser m a b
555takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
557 where
559 cnt = max n 0
561 initial = do
562 res <- finitial
563 return $ case res of
564 FL.Partial s -> IPartial $ Tuple' 0 s
565 FL.Done b ->
566 if cnt == 0
567 then IDone b
568 else IError
569 $ "takeEQ: Expecting exactly " ++ show cnt
570 ++ " elements, fold terminated without"
571 ++ " consuming any elements"
573 step (Tuple' i r) a
574 | i1 < cnt = do
575 res <- fstep r a
576 return
577 $ case res of
578 FL.Partial s -> Continue 0 $ Tuple' i1 s
579 FL.Done _ ->
580 Error
581 $ "takeEQ: Expecting exactly " ++ show cnt
582 ++ " elements, fold terminated on " ++ show i1
583 | i1 == cnt = do
584 res <- fstep r a
585 Done 0
586 <$> case res of
587 FL.Partial s -> fextract s
588 FL.Done b -> return b
589 -- XXX we should not reach here when initial returns Step type
590 -- reachable only when n == 0
591 | otherwise = Done 1 <$> fextract r
593 where
595 i1 = i + 1
597 extract (Tuple' i r)
598 | i == 0 && cnt == 0 = fmap (Done 0) $ fextract r
599 | otherwise =
600 return
601 $ Error
602 $ "takeEQ: Expecting exactly " ++ show cnt
603 ++ " elements, input terminated on " ++ show i
605-- | See 'Streamly.Internal.Data.Parser.takeGE'.
606--
607-- /Pre-release/
608--
609{-# INLINE takeGE #-}
610takeGE :: Monad m => Int -> Fold m a b -> Parser m a b
611takeGE n (Fold fstep finitial fextract) = Parser step initial extract
613 where
615 cnt = max n 0
617 initial = do
618 res <- finitial
619 return $ case res of
620 FL.Partial s -> IPartial $ Tuple' 0 s
621 FL.Done b ->
622 if cnt == 0
623 then IDone b
624 else IError
625 $ "takeGE: Expecting at least " ++ show cnt
626 ++ " elements, fold terminated without"
627 ++ " consuming any elements"
629 step (Tuple' i r) a
630 | i1 < cnt = do
631 res <- fstep r a
632 return
633 $ case res of
634 FL.Partial s -> Continue 0 $ Tuple' i1 s
635 FL.Done _ ->
636 Error
637 $ "takeGE: Expecting at least " ++ show cnt
638 ++ " elements, fold terminated on " ++ show i1
639 | otherwise = do
640 res <- fstep r a
641 return
642 $ case res of
643 FL.Partial s -> Partial 0 $ Tuple' i1 s
644 FL.Done b -> Done 0 b
646 where
648 i1 = i + 1
650 extract (Tuple' i r)
651 | i >= cnt = fmap (Done 0) $ fextract r
652 | otherwise =
653 return
654 $ Error
655 $ "takeGE: Expecting at least " ++ show cnt
656 ++ " elements, input terminated on " ++ show i
658-------------------------------------------------------------------------------
659-- Conditional splitting
660-------------------------------------------------------------------------------
662-- | See 'Streamly.Internal.Data.Parser.takeWhileP'.
663--
664-- /Pre-release/
665--
666{-# INLINE takeWhileP #-}
667takeWhileP :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b
668takeWhileP predicate (Parser pstep pinitial pextract) =
669 Parser step pinitial pextract
671 where
673 step s a =
674 if predicate a
675 then pstep s a
676 else do
677 r <- pextract s
678 -- XXX need a map on count
679 case r of
680 Error err -> return $ Error err
681 Done n s1 -> return $ Done (n + 1) s1
682 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
683 Continue n s1 -> return $ Continue (n + 1) s1
685-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
686--
687-- /Pre-release/
688--
689{-# INLINE takeWhile #-}
690takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
691takeWhile predicate (Fold fstep finitial fextract) =
692 Parser step initial extract
694 where
696 initial = do
697 res <- finitial
698 return $ case res of
699 FL.Partial s -> IPartial s
700 FL.Done b -> IDone b
702 step s a =
703 if predicate a
704 then do
705 fres <- fstep s a
706 return
707 $ case fres of
708 FL.Partial s1 -> Partial 0 s1
709 FL.Done b -> Done 0 b
710 else Done 1 <$> fextract s
712 extract s = fmap (Done 0) (fextract s)
714-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
715--
716-- /Pre-release/
717--
718{-# INLINE takeWhile1 #-}
719takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
720takeWhile1 predicate (Fold fstep finitial fextract) =
721 Parser step initial extract
723 where
725 initial = do
726 res <- finitial
727 return $ case res of
728 FL.Partial s -> IPartial (Left' s)
729 FL.Done _ ->
730 IError
731 $ "takeWhile1: fold terminated without consuming:"
732 ++ " any element"
734 {-# INLINE process #-}
735 process s a = do
736 res <- fstep s a
737 return
738 $ case res of
739 FL.Partial s1 -> Partial 0 (Right' s1)
740 FL.Done b -> Done 0 b
742 step (Left' s) a =
743 if predicate a
744 then process s a
745 else return $ Error "takeWhile1: predicate failed on first element"
746 step (Right' s) a =
747 if predicate a
748 then process s a
749 else do
750 b <- fextract s
751 return $ Done 1 b
753 extract (Left' _) = return $ Error "takeWhile1: end of input"
754 extract (Right' s) = fmap (Done 0) (fextract s)
756-------------------------------------------------------------------------------
757-- Separators
758-------------------------------------------------------------------------------
760data FramedEscState s =
761 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
763{-# INLINE takeFramedByGeneric #-}
764takeFramedByGeneric :: Monad m =>
765 Maybe (a -> Bool)
766 -> Maybe (a -> Bool)
767 -> Maybe (a -> Bool)
768 -> Fold m a b
769 -> Parser m a b
770takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
772 Parser step initial extract
774 where
776 initial = do
777 res <- finitial
778 return $
779 case res of
780 FL.Partial s -> IPartial (FrameEscInit s)
781 FL.Done _ ->
782 error "takeFramedByGeneric: fold done without input"
784 {-# INLINE process #-}
785 process s a n = do
786 res <- fstep s a
787 return
788 $ case res of
789 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
790 FL.Done b -> Done 0 b
792 {-# INLINE processNoEsc #-}
793 processNoEsc s a n =
794 case end of
795 Just isEnd ->
796 case begin of
797 Just isBegin ->
798 -- takeFramedBy case
799 if isEnd a
800 then
801 if n == 0
802 then Done 0 <$> fextract s
803 else process s a (n - 1)
804 else
805 let n1 = if isBegin a then n + 1 else n
806 in process s a n1
807 Nothing -> -- takeEndBy case
808 if isEnd a
809 then Done 0 <$> fextract s
810 else process s a n
811 Nothing -> -- takeStartBy case
812 case begin of
813 Just isBegin ->
814 if isBegin a
815 then Done 0 <$> fextract s
816 else process s a n
817 Nothing ->
818 error $ "takeFramedByGeneric: "
819 ++ "Both begin and end frame predicate missing"
821 {-# INLINE processCheckEsc #-}
822 processCheckEsc s a n =
823 case esc of
824 Just isEsc ->
825 if isEsc a
826 then return $ Partial 0 $ FrameEscEsc s n
827 else processNoEsc s a n
828 Nothing -> processNoEsc s a n
830 step (FrameEscInit s) a =
831 case begin of
832 Just isBegin ->
833 if isBegin a
834 then return $ Partial 0 (FrameEscGo s 0)
835 else return $ Error "takeFramedByGeneric: missing frame start"
836 Nothing ->
837 case end of
838 Just isEnd ->
839 if isEnd a
840 then Done 0 <$> fextract s
841 else processCheckEsc s a 0
842 Nothing ->
843 error "Both begin and end frame predicate missing"
844 step (FrameEscGo s n) a = processCheckEsc s a n
845 step (FrameEscEsc s n) a = process s a n
847 err = return . Error
849 extract (FrameEscInit _) =
850 err "takeFramedByGeneric: empty token"
851 extract (FrameEscGo s _) =
852 case begin of
853 Just _ ->
854 case end of
855 Nothing -> fmap (Done 0) $ fextract s
856 Just _ -> err "takeFramedByGeneric: missing frame end"
857 Nothing -> err "takeFramedByGeneric: missing closing frame"
858 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
860-- | See 'Streamly.Internal.Data.Parser.takeEndBy'.
861--
862-- /Pre-release/
863--
864{-# INLINE takeEndBy #-}
865takeEndBy :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b
866takeEndBy cond (Parser pstep pinitial pextract) =
868 Parser step initial pextract
870 where
872 initial = pinitial
874 step s a = do
875 res <- pstep s a
876 if not (cond a)
877 then return res
878 else extractStep pextract res
880-- | See 'Streamly.Internal.Data.Parser.takeEndByEsc'.
881--
882-- /Pre-release/
883--
884{-# INLINE takeEndByEsc #-}
885takeEndByEsc :: Monad m =>
886 (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b
887takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
889 Parser step initial extract
891 where
893 initial = first Left' <$> pinitial
895 step (Left' s) a = do
896 if isEsc a
897 then return $ Partial 0 $ Right' s
898 else do
899 res <- pstep s a
900 if not (isSep a)
901 then return $ first Left' res
902 else fmap (first Left') $ extractStep pextract res
904 step (Right' s) a = do
905 res <- pstep s a
906 return $ first Left' res
908 extract (Left' s) = fmap (first Left') $ pextract s
909 extract (Right' _) =
910 return $ Error "takeEndByEsc: trailing escape"
912-- | See 'Streamly.Internal.Data.Parser.takeEndBy_'.
913--
914-- /Pre-release/
915--
916{-# INLINE takeEndBy_ #-}
917takeEndBy_ :: (a -> Bool) -> Parser m a b -> Parser m a b
918takeEndBy_ cond (Parser pstep pinitial pextract) =
920 Parser step pinitial pextract
922 where
924 step s a =
925 if cond a
926 then pextract s
927 else pstep s a
929-- | See 'Streamly.Internal.Data.Parser.takeStartBy'.
930--
931-- /Pre-release/
932--
934{-# INLINE takeStartBy #-}
935takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
936takeStartBy cond (Fold fstep finitial fextract) =
938 Parser step initial extract
940 where
942 initial = do
943 res <- finitial
944 return $
945 case res of
946 FL.Partial s -> IPartial (Left' s)
947 FL.Done _ -> IError "takeStartBy: fold done without input"
949 {-# INLINE process #-}
950 process s a = do
951 res <- fstep s a
952 return
953 $ case res of
954 FL.Partial s1 -> Partial 0 (Right' s1)
955 FL.Done b -> Done 0 b
957 step (Left' s) a =
958 if cond a
959 then process s a
960 else return $ Error "takeStartBy: missing frame start"
961 step (Right' s) a =
962 if not (cond a)
963 then process s a
964 else Done 1 <$> fextract s
966 extract (Left' s) = fmap (Done 0) $ fextract s
967 extract (Right' s) = fmap (Done 0) $ fextract s
969{-# INLINE takeFramedByEsc_ #-}
970takeFramedByEsc_ :: Monad m =>
971 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
972takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
974 Parser step initial extract
976 where
978 initial = do
979 res <- finitial
980 return $
981 case res of
982 FL.Partial s -> IPartial (FrameEscInit s)
983 FL.Done _ ->
984 error "takeFramedByEsc_: fold done without input"
986 {-# INLINE process #-}
987 process s a n = do
988 res <- fstep s a
989 return
990 $ case res of
991 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
992 FL.Done b -> Done 0 b
994 step (FrameEscInit s) a =
995 if isBegin a
996 then return $ Partial 0 (FrameEscGo s 0)
997 else return $ Error "takeFramedByEsc_: missing frame start"
998 step (FrameEscGo s n) a =
999 if isEsc a
1000 then return $ Partial 0 $ FrameEscEsc s n
1001 else do
1002 if not (isEnd a)
1003 then
1004 let n1 = if isBegin a then n + 1 else n
1005 in process s a n1
1006 else
1007 if n == 0
1008 then Done 0 <$> fextract s
1009 else process s a (n - 1)
1010 step (FrameEscEsc s n) a = process s a n
1012 err = return . Error
1014 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1015 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1016 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1018data FramedState s = FrameInit !s | FrameGo !s Int
1020{-# INLINE takeFramedBy_ #-}
1021takeFramedBy_ :: Monad m =>
1022 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
1023takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
1025 Parser step initial extract
1027 where
1029 initial = do
1030 res <- finitial
1031 return $
1032 case res of
1033 FL.Partial s -> IPartial (FrameInit s)
1034 FL.Done _ ->
1035 error "takeFramedBy_: fold done without input"
1037 {-# INLINE process #-}
1038 process s a n = do
1039 res <- fstep s a
1040 return
1041 $ case res of
1042 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1043 FL.Done b -> Done 0 b
1045 step (FrameInit s) a =
1046 if isBegin a
1047 then return $ Continue 0 (FrameGo s 0)
1048 else return $ Error "takeFramedBy_: missing frame start"
1049 step (FrameGo s n) a
1050 | not (isEnd a) =
1051 let n1 = if isBegin a then n + 1 else n
1052 in process s a n1
1053 | n == 0 = Done 0 <$> fextract s
1054 | otherwise = process s a (n - 1)
1056 err = return . Error
1058 extract (FrameInit _) = err "takeFramedBy_: empty token"
1059 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1061-------------------------------------------------------------------------------
1062-- Grouping and words
1063-------------------------------------------------------------------------------
1065data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1067-- | See 'Streamly.Internal.Data.Parser.wordBy'.
1070{-# INLINE wordBy #-}
1071wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
1072wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1074 where
1076 {-# INLINE worder #-}
1077 worder s a = do
1078 res <- fstep s a
1079 return
1080 $ case res of
1081 FL.Partial s1 -> Partial 0 $ WBWord s1
1082 FL.Done b -> Done 0 b
1084 initial = do
1085 res <- finitial
1086 return
1087 $ case res of
1088 FL.Partial s -> IPartial $ WBLeft s
1089 FL.Done b -> IDone b
1091 step (WBLeft s) a =
1092 if not (predicate a)
1093 then worder s a
1094 else return $ Partial 0 $ WBLeft s
1095 step (WBWord s) a =
1096 if not (predicate a)
1097 then worder s a
1098 else do
1099 b <- fextract s
1100 return $ Partial 0 $ WBRight b
1101 step (WBRight b) a =
1102 return
1103 $ if not (predicate a)
1104 then Done 1 b
1105 else Partial 0 $ WBRight b
1107 extract (WBLeft s) = fmap (Done 0) $ fextract s
1108 extract (WBWord s) = fmap (Done 0) $ fextract s
1109 extract (WBRight b) = return (Done 0 b)
1111data WordFramedState s b =
1112 WordFramedSkipPre !s
1113 | WordFramedWord !s !Int
1114 | WordFramedEsc !s !Int
1115 | WordFramedSkipPost !b
1117-- | See 'Streamly.Internal.Data.Parser.wordFramedBy'
1119{-# INLINE wordFramedBy #-}
1120wordFramedBy :: Monad m =>
1121 (a -> Bool) -- ^ Escape
1122 -> (a -> Bool) -- ^ left quote
1123 -> (a -> Bool) -- ^ right quote
1124 -> (a -> Bool) -- ^ word seperator
1125 -> Fold m a b
1126 -> Parser m a b
1127wordFramedBy isEsc isBegin isEnd isSep
1128 (Fold fstep finitial fextract) =
1129 Parser step initial extract
1131 where
1133 initial = do
1134 res <- finitial
1135 return $
1136 case res of
1137 FL.Partial s -> IPartial (WordFramedSkipPre s)
1138 FL.Done _ ->
1139 error "wordFramedBy: fold done without input"
1141 {-# INLINE process #-}
1142 process s a n = do
1143 res <- fstep s a
1144 return
1145 $ case res of
1146 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1147 FL.Done b -> Done 0 b
1149 step (WordFramedSkipPre s) a
1150 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1151 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1152 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1153 | isEnd a =
1154 return $ Error "wordFramedBy: missing frame start"
1155 | otherwise = process s a 0
1156 step (WordFramedWord s n) a
1157 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1158 | n == 0 && isSep a = do
1159 b <- fextract s
1160 return $ Partial 0 $ WordFramedSkipPost b
1161 | otherwise = do
1162 -- We need to use different order for checking begin and end for
1163 -- the n == 0 and n == 1 case so that when the begin and end
1164 -- character is the same we treat the one after begin as end.
1165 if n == 0
1166 then
1167 -- Need to check isBegin first
1168 if isBegin a
1169 then return $ Continue 0 $ WordFramedWord s 1
1170 else if isEnd a
1171 then return $ Error "wordFramedBy: missing frame start"
1172 else process s a n
1173 else
1174 -- Need to check isEnd first
1175 if isEnd a
1176 then
1177 if n == 1
1178 then return $ Continue 0 $ WordFramedWord s 0
1179 else process s a (n - 1)
1180 else if isBegin a
1181 then process s a (n + 1)
1182 else process s a n
1183 step (WordFramedEsc s n) a = process s a n
1184 step (WordFramedSkipPost b) a =
1185 return
1186 $ if not (isSep a)
1187 then Done 1 b
1188 else Partial 0 $ WordFramedSkipPost b
1190 err = return . Error
1192 extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s
1193 extract (WordFramedWord s n) =
1194 if n == 0
1195 then fmap (Done 0) $ fextract s
1196 else err "wordFramedBy: missing frame end"
1197 extract (WordFramedEsc _ _) =
1198 err "wordFramedBy: trailing escape"
1199 extract (WordFramedSkipPost b) = return (Done 0 b)
1201data WordQuotedState s b a =
1202 WordQuotedSkipPre !s
1203 | WordUnquotedWord !s
1204 | WordQuotedWord !s !Int a
1205 | WordUnquotedEsc !s
1206 | WordQuotedEsc !s !Int a
1207 | WordQuotedSkipPost !b
1209{-# INLINE wordQuotedBy #-}
1210wordQuotedBy :: (Monad m, Eq a) =>
1211 Bool -- ^ keep the quotes in the output
1212 -> (a -> Bool) -- ^ Escape
1213 -> (a -> Bool) -- ^ left quote
1214 -> (a -> Bool) -- ^ right quote
1215 -> (a -> a) -- ^ get right quote from the left quote
1216 -> (a -> Bool) -- ^ word seperator
1217 -> Fold m a b
1218 -> Parser m a b
1219wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
1220 (Fold fstep finitial fextract) =
1221 Parser step initial extract
1223 where
1225 initial = do
1226 res <- finitial
1227 return $
1228 case res of
1229 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1230 FL.Done _ ->
1231 error "wordQuotedBy: fold done without input"
1233 {-# INLINE process #-}
1234 process s a n q = do
1235 res <- fstep s a
1236 return
1237 $ case res of
1238 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n q)
1239 FL.Done b -> Done 0 b
1241 {-# INLINE processUnquoted #-}
1242 processUnquoted s a = do
1243 res <- fstep s a
1244 return
1245 $ case res of
1246 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1247 FL.Done b -> Done 0 b
1249 step (WordQuotedSkipPre s) a
1250 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1251 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1252 | isBegin a =
1253 if keepQuotes
1254 then process s a 1 a
1255 else return $ Continue 0 $ WordQuotedWord s 1 a
1256 | isEnd a =
1257 return $ Error "wordQuotedBy: missing frame start"
1258 | otherwise = processUnquoted s a
1259 step (WordUnquotedWord s) a
1260 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1261 | isSep a = do
1262 b <- fextract s
1263 return $ Partial 0 $ WordQuotedSkipPost b
1264 | otherwise = do
1265 if isBegin a
1266 then if keepQuotes
1267 then process s a 1 a
1268 else return $ Continue 0 $ WordQuotedWord s 1 a
1269 else if isEnd a
1270 then return $ Error "wordQuotedBy: missing frame start"
1271 else processUnquoted s a
1272 step (WordQuotedWord s n q) a
1273 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n q
1274 -- XXX Will this ever occur? Will n ever be 0?
1275 | n == 0 && isSep a = do
1276 b <- fextract s
1277 return $ Partial 0 $ WordQuotedSkipPost b
1278 | otherwise = do
1279 if a == toRight q
1280 then
1281 if n == 1
1282 then if keepQuotes
1283 then processUnquoted s a
1284 else return $ Continue 0 $ WordUnquotedWord s
1285 else process s a (n - 1) q
1286 else if a == q
1287 then process s a (n + 1) q
1288 else process s a n q
1289 step (WordUnquotedEsc s) a = processUnquoted s a
1290 step (WordQuotedEsc s n q) a = process s a n q
1291 step (WordQuotedSkipPost b) a =
1292 return
1293 $ if not (isSep a)
1294 then Done 1 b
1295 else Partial 0 $ WordQuotedSkipPost b
1297 err = return . Error
1299 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1300 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1301 extract (WordQuotedWord s n _) =
1302 if n == 0
1303 then fmap (Done 0) $ fextract s
1304 else err "wordQuotedBy: missing frame end"
1305 extract WordQuotedEsc {} =
1306 err "wordQuotedBy: trailing escape"
1307 extract (WordUnquotedEsc _) =
1308 err "wordQuotedBy: trailing escape"
1309 extract (WordQuotedSkipPost b) = return (Done 0 b)
1311{-# ANN type GroupByState Fuse #-}
1312data GroupByState a s
1313 = GroupByInit !s
1314 | GroupByGrouping !a !s
1316-- | See 'Streamly.Internal.Data.Parser.groupBy'.
1318{-# INLINE groupBy #-}
1319groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1320groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1322 where
1324 {-# INLINE grouper #-}
1325 grouper s a0 a = do
1326 res <- fstep s a
1327 return
1328 $ case res of
1329 FL.Done b -> Done 0 b
1330 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1332 initial = do
1333 res <- finitial
1334 return
1335 $ case res of
1336 FL.Partial s -> IPartial $ GroupByInit s
1337 FL.Done b -> IDone b
1339 step (GroupByInit s) a = grouper s a a
1340 step (GroupByGrouping a0 s) a =
1341 if eq a0 a
1342 then grouper s a0 a
1343 else Done 1 <$> fextract s
1345 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1346 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1348-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
1350{-# INLINE groupByRolling #-}
1351groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1352groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1354 where
1356 {-# INLINE grouper #-}
1357 grouper s a = do
1358 res <- fstep s a
1359 return
1360 $ case res of
1361 FL.Done b -> Done 0 b
1362 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1364 initial = do
1365 res <- finitial
1366 return
1367 $ case res of
1368 FL.Partial s -> IPartial $ GroupByInit s
1369 FL.Done b -> IDone b
1371 step (GroupByInit s) a = grouper s a
1372 step (GroupByGrouping a0 s) a =
1373 if eq a0 a
1374 then grouper s a
1375 else Done 1 <$> fextract s
1377 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1378 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1380{-# ANN type GroupByStatePair Fuse #-}
1381data GroupByStatePair a s1 s2
1382 = GroupByInitPair !s1 !s2
1383 | GroupByGroupingPair !a !s1 !s2
1384 | GroupByGroupingPairL !a !s1 !s2
1385 | GroupByGroupingPairR !a !s1 !s2
1387{-# INLINE groupByRollingEither #-}
1388groupByRollingEither :: Monad m =>
1389 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
1390groupByRollingEither
1391 eq
1392 (Fold fstep1 finitial1 fextract1)
1393 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
1395 where
1397 {-# INLINE grouper #-}
1398 grouper s1 s2 a = do
1399 return $ Continue 0 (GroupByGroupingPair a s1 s2)
1401 {-# INLINE grouperL2 #-}
1402 grouperL2 s1 s2 a = do
1403 res <- fstep1 s1 a
1404 return
1405 $ case res of
1406 FL.Done b -> Done 0 (Left b)
1407 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
1409 {-# INLINE grouperL #-}
1410 grouperL s1 s2 a0 a = do
1411 res <- fstep1 s1 a0
1412 case res of
1413 FL.Done b -> return $ Done 0 (Left b)
1414 FL.Partial s11 -> grouperL2 s11 s2 a
1416 {-# INLINE grouperR2 #-}
1417 grouperR2 s1 s2 a = do
1418 res <- fstep2 s2 a
1419 return
1420 $ case res of
1421 FL.Done b -> Done 0 (Right b)
1422 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
1424 {-# INLINE grouperR #-}
1425 grouperR s1 s2 a0 a = do
1426 res <- fstep2 s2 a0
1427 case res of
1428 FL.Done b -> return $ Done 0 (Right b)
1429 FL.Partial s21 -> grouperR2 s1 s21 a
1431 initial = do
1432 res1 <- finitial1
1433 res2 <- finitial2
1434 return
1435 $ case res1 of
1436 FL.Partial s1 ->
1437 case res2 of
1438 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
1439 FL.Done b -> IDone (Right b)
1440 FL.Done b -> IDone (Left b)
1442 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
1444 step (GroupByGroupingPair a0 s1 s2) a =
1445 if not (eq a0 a)
1446 then grouperL s1 s2 a0 a
1447 else grouperR s1 s2 a0 a
1449 step (GroupByGroupingPairL a0 s1 s2) a =
1450 if not (eq a0 a)
1451 then grouperL2 s1 s2 a
1452 else Done 1 . Left <$> fextract1 s1
1454 step (GroupByGroupingPairR a0 s1 s2) a =
1455 if eq a0 a
1456 then grouperR2 s1 s2 a
1457 else Done 1 . Right <$> fextract2 s2
1459 extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1
1460 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1
1461 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2
1462 extract (GroupByGroupingPair a s1 _) = do
1463 res <- fstep1 s1 a
1464 case res of
1465 FL.Done b -> return $ Done 0 (Left b)
1466 FL.Partial s11 -> Done 0 . Left <$> fextract1 s11
1468-- XXX use an Unfold instead of a list?
1469-- XXX custom combinators for matching list, array and stream?
1470-- XXX rename to listBy?
1472-- | See 'Streamly.Internal.Data.Parser.eqBy'.
1474-- /Pre-release/
1476{-# INLINE listEqBy #-}
1477listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser m a [a]
1478listEqBy cmp str = Parser step initial extract
1480 where
1482 -- XXX Should return IDone in initial for [] case
1483 initial = return $ IPartial str
1485 step [] _ = return $ Done 0 str
1486 step [x] a =
1487 return
1488 $ if x `cmp` a
1489 then Done 0 str
1490 else Error "listEqBy: failed, yet to match the last element"
1491 step (x:xs) a =
1492 return
1493 $ if x `cmp` a
1494 then Continue 0 xs
1495 else Error
1496 $ "listEqBy: failed, yet to match "
1497 ++ show (length xs + 1) ++ " elements"
1499 extract xs =
1500 return
1501 $ Error
1502 $ "listEqBy: end of input, yet to match "
1503 ++ show (length xs) ++ " elements"
1505-- | Like 'listEqBy' but uses a stream instead of a list
1506{-# INLINE eqBy #-}
1507eqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
1508eqBy cmp (D.Stream sstep state) = Parser step initial extract
1510 where
1512 initial = do
1513 r <- sstep defState state
1514 case r of
1515 D.Yield x s -> return $ IPartial (Just' x, s)
1516 D.Stop -> return $ IDone ()
1517 -- Need Skip/Continue in initial to loop right here
1518 D.Skip s -> return $ IPartial (Nothing', s)
1520 step (Just' x, st) a =
1521 if x `cmp` a
1522 then do
1523 r <- sstep defState st
1524 return
1525 $ case r of
1526 D.Yield x1 s -> Continue 0 (Just' x1, s)
1527 D.Stop -> Done 0 ()
1528 D.Skip s -> Continue 1 (Nothing', s)
1529 else return $ Error "eqBy: mismtach occurred"
1530 step (Nothing', st) a = do
1531 r <- sstep defState st
1532 return
1533 $ case r of
1534 D.Yield x s -> do
1535 if x `cmp` a
1536 then Continue 0 (Nothing', s)
1537 else Error "eqBy: mismatch occurred"
1538 D.Stop -> Done 1 ()
1539 D.Skip s -> Continue 1 (Nothing', s)
1541 extract _ = return $ Error "eqBy: end of input"
1543-------------------------------------------------------------------------------
1544-- Transformations on input
1545-------------------------------------------------------------------------------
1547-- Initial needs a "Continue" constructor to implement scans on parsers. As a
1548-- parser can always return a Continue in initial when we feed the fold's
1549-- initial result to it. We can work this around for postscan by introducing an
1550-- initial state and calling "initial" only on the first input.
1552-- | Stateful scan on the input of a parser using a Fold.
1554-- /Unimplemented/
1556{-# INLINE postscan #-}
1557postscan :: -- Monad m =>
1558 Fold m a b -> Parser m b c -> Parser m a c
1559postscan = undefined
1561{-# INLINE zipWithM #-}
1562zipWithM :: Monad m =>
1563 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
1564zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
1565 Parser step initial extract
1567 where
1569 initial = do
1570 fres <- finitial
1571 case fres of
1572 FL.Partial fs -> do
1573 r <- sstep defState state
1574 case r of
1575 D.Yield x s -> return $ IPartial (Just' x, s, fs)
1576 D.Stop -> do
1577 x <- fextract fs
1578 return $ IDone x
1579 -- Need Skip/Continue in initial to loop right here
1580 D.Skip s -> return $ IPartial (Nothing', s, fs)
1581 FL.Done x -> return $ IDone x
1583 step (Just' a, st, fs) b = do
1584 c <- zf a b
1585 fres <- fstep fs c
1586 case fres of
1587 FL.Partial fs1 -> do
1588 r <- sstep defState st
1589 case r of
1590 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
1591 D.Stop -> do
1592 x <- fextract fs1
1593 return $ Done 0 x
1594 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
1595 FL.Done x -> return $ Done 0 x
1596 step (Nothing', st, fs) b = do
1597 r <- sstep defState st
1598 case r of
1599 D.Yield a s -> do
1600 c <- zf a b
1601 fres <- fstep fs c
1602 case fres of
1603 FL.Partial fs1 ->
1604 return $ Continue 0 (Nothing', s, fs1)
1605 FL.Done x -> return $ Done 0 x
1606 D.Stop -> do
1607 x <- fextract fs
1608 return $ Done 1 x
1609 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
1611 extract _ = return $ Error "zipWithM: end of input"
1613-- | Zip the input of a fold with a stream.
1615-- /Pre-release/
1617{-# INLINE zip #-}
1618zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser m b x
1619zip = zipWithM (curry return)
1621-- | Pair each element of a fold input with its index, starting from index 0.
1623-- /Pre-release/
1624{-# INLINE indexed #-}
1625indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser m a b
1626indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
1628-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
1629-- function using a fold indexing function that attaches an index to each input
1630-- element and a filtering function that filters using @(index, element) ->
1631-- Bool) as predicate.
1633-- For example:
1635-- @
1636-- filterWithIndex = makeIndexFilter indexed filter
1637-- filterWithAbsTime = makeIndexFilter timestamped filter
1638-- filterWithRelTime = makeIndexFilter timeIndexed filter
1639-- @
1641-- /Pre-release/
1642{-# INLINE makeIndexFilter #-}
1643makeIndexFilter ::
1644 (Fold m (s, a) b -> Parser m a b)
1645 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
1646 -> (((s, a) -> Bool) -> Fold m a b -> Parser m a b)
1647makeIndexFilter f comb g = f . comb g . FL.lmap snd
1649-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
1650-- then every element at strides of @stride@.
1652-- /Pre-release/
1653{-# INLINE sampleFromthen #-}
1654sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser m a b
1655sampleFromthen offset size =
1656 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
1658--------------------------------------------------------------------------------
1659--- Spanning
1660--------------------------------------------------------------------------------
1662-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1663-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1664-- input.
1666-- @
1667-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
1669-- > span_ (< 1) [1,2,3]
1670-- ([],[1,2,3])
1672-- > span_ (< 2) [1,2,3]
1673-- ([1],[2,3])
1675-- > span_ (< 4) [1,2,3]
1676-- ([1,2,3],[])
1678-- @
1680-- /Pre-release/
1681{-# INLINE span #-}
1682span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1683span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1685-- | Break the input stream into two groups, the first group takes the input as
1686-- long as the predicate applied to the first element of the stream and next
1687-- input element holds 'True', the second group takes the rest of the input.
1689-- /Pre-release/
1691{-# INLINE spanBy #-}
1692spanBy ::
1693 Monad m
1694 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1695spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1697-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1698-- predicate is applied to the previous and the next input elements.
1700-- /Pre-release/
1701{-# INLINE spanByRolling #-}
1702spanByRolling ::
1703 Monad m
1704 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1705spanByRolling eq f1 f2 =
1706 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1708-------------------------------------------------------------------------------
1709-- nested parsers
1710-------------------------------------------------------------------------------
1712-- | See 'Streamly.Internal.Data.Parser.takeP'.
1714-- /Internal/
1715{-# INLINE takeP #-}
1716takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1717takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1719 where
1721 initial = do
1722 res <- pinitial
1723 case res of
1724 IPartial s ->
1725 if lim > 0
1726 then return $ IPartial $ Tuple' 0 s
1727 else iextract s
1728 IDone b -> return $ IDone b
1729 IError e -> return $ IError e
1731 step (Tuple' cnt r) a = do
1732 assertM(cnt < lim)
1733 res <- pstep r a
1734 let cnt1 = cnt + 1
1735 case res of
1736 Partial 0 s -> do
1737 assertM(cnt1 >= 0)
1738 if cnt1 < lim
1739 then return $ Partial 0 $ Tuple' cnt1 s
1740 else do
1741 r1 <- pextract s
1742 return $ case r1 of
1743 Done n b -> Done n b
1744 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
1745 Error err -> Error err
1746 Partial _ _ -> error "takeP: Partial in extract"
1748 Continue 0 s -> do
1749 assertM(cnt1 >= 0)
1750 if cnt1 < lim
1751 then return $ Continue 0 $ Tuple' cnt1 s
1752 else do
1753 r1 <- pextract s
1754 return $ case r1 of
1755 Done n b -> Done n b
1756 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
1757 Error err -> Error err
1758 Partial _ _ -> error "takeP: Partial in extract"
1759 Partial n s -> do
1760 let taken = cnt1 - n
1761 assertM(taken >= 0)
1762 return $ Partial n $ Tuple' taken s
1763 Continue n s -> do
1764 let taken = cnt1 - n
1765 assertM(taken >= 0)
1766 return $ Continue n $ Tuple' taken s
1767 Done n b -> return $ Done n b
1768 Error str -> return $ Error str
1770 extract (Tuple' cnt r) = do
1771 r1 <- pextract r
1772 return $ case r1 of
1773 Done n b -> Done n b
1774 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
1775 Error err -> Error err
1776 Partial _ _ -> error "takeP: Partial in extract"
1778 -- XXX Need to make the Initial type Step to remove this
1779 iextract s = do
1780 r <- pextract s
1781 return $ case r of
1782 Done _ b -> IDone b
1783 Error err -> IError err
1784 _ -> error "Bug: takeP invalid state in initial"
1786-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1788-- /Pre-release/
1790{-# INLINE lookAhead #-}
1791lookAhead :: Monad m => Parser m a b -> Parser m a b
1792lookAhead (Parser step1 initial1 _) = Parser step initial extract
1794 where
1796 initial = do
1797 res <- initial1
1798 return $ case res of
1799 IPartial s -> IPartial (Tuple' 0 s)
1800 IDone b -> IDone b
1801 IError e -> IError e
1803 step (Tuple' cnt st) a = do
1804 r <- step1 st a
1805 let cnt1 = cnt + 1
1806 return
1807 $ case r of
1808 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1809 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1810 Done _ b -> Done cnt1 b
1811 Error err -> Error err
1813 -- XXX returning an error let's us backtrack. To implement it in a way so
1814 -- that it terminates on eof without an error then we need a way to
1815 -- backtrack on eof, that will require extract to return 'Step' type.
1816 extract (Tuple' n _) =
1817 return
1818 $ Error
1819 $ "lookAhead: end of input after consuming "
1820 ++ show n ++ " elements"
1822-------------------------------------------------------------------------------
1823-- Interleaving
1824-------------------------------------------------------------------------------
1826data DeintercalateState fs sp ss =
1827 DeintercalateL !fs !sp
1828 | DeintercalateR !fs !ss !Bool
1830-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1832-- /Internal/
1834{-# INLINE deintercalate #-}
1835deintercalate :: Monad m =>
1836 Parser m a x
1837 -> Parser m a y
1838 -> Fold m (Either x y) z
1839 -> Parser m a z
1840deintercalate
1841 (Parser stepL initialL extractL)
1842 (Parser stepR initialR extractR)
1843 (Fold fstep finitial fextract) = Parser step initial extract
1845 where
1847 errMsg p status =
1848 error $ "deintercalate: " ++ p ++ " parser cannot "
1849 ++ status ++ " without input"
1851 initial = do
1852 res <- finitial
1853 case res of
1854 FL.Partial fs -> do
1855 resL <- initialL
1856 case resL of
1857 IPartial sL -> return $ IPartial $ DeintercalateL fs sL
1858 IDone _ -> errMsg "left" "succeed"
1859 IError _ -> errMsg "left" "fail"
1860 FL.Done c -> return $ IDone c
1862 step (DeintercalateL fs sL) a = do
1863 r <- stepL sL a
1864 case r of
1865 Partial n s -> return $ Partial n (DeintercalateL fs s)
1866 Continue n s -> return $ Continue n (DeintercalateL fs s)
1867 Done n b -> do
1868 fres <- fstep fs (Left b)
1869 case fres of
1870 FL.Partial fs1 -> do
1871 resR <- initialR
1872 case resR of
1873 IPartial sR ->
1874 return
1875 $ Partial n (DeintercalateR fs1 sR False)
1876 IDone _ -> errMsg "right" "succeed"
1877 IError _ -> errMsg "right" "fail"
1878 FL.Done c -> return $ Done n c
1879 Error err -> return $ Error err
1880 step (DeintercalateR fs sR consumed) a = do
1881 r <- stepR sR a
1882 case r of
1883 Partial n s -> return $ Partial n (DeintercalateR fs s True)
1884 Continue n s -> return $ Continue n (DeintercalateR fs s True)
1885 Done n b ->
1886 if consumed
1887 then do
1888 fres <- fstep fs (Right b)
1889 case fres of
1890 FL.Partial fs1 -> do
1891 resL <- initialL
1892 case resL of
1893 IPartial sL ->
1894 return $ Partial n $ DeintercalateL fs1 sL
1895 IDone _ -> errMsg "left" "succeed"
1896 IError _ -> errMsg "left" "fail"
1897 FL.Done c -> return $ Done n c
1898 else error "deintercalate: infinite loop"
1899 Error err -> return $ Error err
1901 {-# INLINE processResult #-}
1902 processResult n fs r = do
1903 res <- fstep fs r
1904 case res of
1905 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
1906 FL.Done c -> return (Done n c)
1908 extract (DeintercalateL fs sL) = do
1909 r <- extractL sL
1910 case r of
1911 Done n b -> processResult n fs (Left b)
1912 Error err -> return $ Error err
1913 Continue n s -> return $ Continue n (DeintercalateL fs s)
1914 Partial _ _ -> error "Partial in extract"
1916 extract (DeintercalateR fs sR consumed) = do
1917 r <- extractR sR
1918 case r of
1919 Done n b -> processResult n fs (Right b)
1920 Error err -> return $ Error err
1921 -- XXX Review consumed
1922 Continue n s -> return $ Continue n (DeintercalateR fs s consumed)
1923 Partial _ _ -> error "Partial in extract"
1925data SepByState fs sp ss =
1926 SepByInit !fs !sp
1927 | SepBySeparator !fs !ss !Bool
1929-- This is a special case of deintercalate and can be easily implemented in
1930-- terms of deintercalate.
1931{-# INLINE sepBy #-}
1932sepBy :: Monad m =>
1933 Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
1934sepBy
1935 (Parser pstep pinitial pextract)
1936 (Parser sstep sinitial _)
1937 (Fold fstep finitial fextract) = Parser step initial extract
1939 where
1941 errMsg p status =
1942 error $ "sepBy: " ++ p ++ " parser cannot "
1943 ++ status ++ " without input"
1945 initial = do
1946 res <- finitial
1947 case res of
1948 FL.Partial fs -> do
1949 resP <- pinitial
1950 case resP of
1951 IPartial sp -> return $ IPartial $ SepByInit fs sp
1952 IDone _ -> errMsg "content" "succeed"
1953 IError _ -> errMsg "content" "fail"
1954 FL.Done b -> return $ IDone b
1956 step (SepByInit fs sp) a = do
1957 r <- pstep sp a
1958 case r of
1959 Partial n s -> return $ Partial n (SepByInit fs s)
1960 Continue n s -> return $ Continue n (SepByInit fs s)
1961 Done n b -> do
1962 fres <- fstep fs b
1963 case fres of
1964 FL.Partial fs1 -> do
1965 resS <- sinitial
1966 case resS of
1967 IPartial ss ->
1968 return $ Partial n (SepBySeparator fs1 ss False)
1969 IDone _ -> errMsg "separator" "succeed"
1970 IError _ -> errMsg "separator" "fail"
1971 FL.Done c -> return $ Done n c
1972 Error err -> return $ Error err
1973 step (SepBySeparator fs ss consumed) a = do
1974 r <- sstep ss a
1975 case r of
1976 Partial n s -> return $ Partial n (SepBySeparator fs s True)
1977 Continue n s -> return $ Continue n (SepBySeparator fs s True)
1978 Done n _ ->
1979 if consumed
1980 then do
1981 resP <- pinitial
1982 case resP of
1983 IPartial sp -> return $ Partial n $ SepByInit fs sp
1984 IDone _ -> errMsg "content" "succeed"
1985 IError _ -> errMsg "content" "fail"
1986 else error "sepBy: infinite loop"
1987 Error err -> return $ Error err
1989 extract (SepByInit fs sp) = do
1990 r <- pextract sp
1991 case r of
1992 Done n b -> do
1993 res <- fstep fs b
1994 case res of
1995 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
1996 FL.Done c -> return (Done n c)
1997 Error err -> return $ Error err
1998 Continue n s -> return $ Continue n (SepByInit fs s)
1999 Partial _ _ -> error "Partial in extract"
2001 extract (SepBySeparator fs _ _) = fmap (Done 0) $ fextract fs
2003-------------------------------------------------------------------------------
2004-- Sequential Collection
2005-------------------------------------------------------------------------------
2007-- | See 'Streamly.Internal.Data.Parser.sequence'.
2008{-# INLINE sequence #-}
2009sequence :: Monad m =>
2010 D.Stream m (Parser m a b) -> Fold m b c -> Parser m a c
2011sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
2012 Parser step initial extract
2014 where
2016 initial = do
2017 fres <- finitial
2018 case fres of
2019 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
2020 FL.Done c -> return $ IDone c
2022 -- state does not contain any parser
2023 -- yield a new parser from the stream
2024 step (Nothing', ss, fs) _ = do
2025 sres <- sstep defState ss
2026 case sres of
2027 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
2028 D.Stop -> do
2029 c <- fextract fs
2030 return $ Done 1 c
2031 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
2033 -- state holds a parser that may or may not have been
2034 -- initialized. pinit holds the initial parser state
2035 -- or modified parser state respectively
2036 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
2037 ps <- pinit
2038 case ps of
2039 IPartial ps1 -> do
2040 pres <- pstep ps1 a
2041 case pres of
2042 Partial n ps2 ->
2043 let newP =
2044 Just' $ Parser pstep (return $ IPartial ps2) pextr
2045 in return $ Partial n (newP, ss, fs)
2046 Continue n ps2 ->
2047 let newP =
2048 Just' $ Parser pstep (return $ IPartial ps2) pextr
2049 in return $ Continue n (newP, ss, fs)
2050 Done n b -> do
2051 fres <- fstep fs b
2052 case fres of
2053 FL.Partial fs1 ->
2054 return $ Partial n (Nothing', ss, fs1)
2055 FL.Done c -> return $ Done n c
2056 Error msg -> return $ Error msg
2057 IDone b -> do
2058 fres <- fstep fs b
2059 case fres of
2060 FL.Partial fs1 ->
2061 return $ Partial 1 (Nothing', ss, fs1)
2062 FL.Done c -> return $ Done 1 c
2063 IError err -> return $ Error err
2065 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
2066 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
2067 ps <- pinit
2068 case ps of
2069 IPartial ps1 -> do
2070 r <- pextr ps1
2071 case r of
2072 Done n b -> do
2073 res <- fstep fs b
2074 case res of
2075 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2076 FL.Done c -> return (Done n c)
2077 Error err -> return $ Error err
2078 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
2079 Partial _ _ -> error "Partial in extract"
2080 IDone b -> do
2081 fres <- fstep fs b
2082 case fres of
2083 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
2084 FL.Done c -> return (Done 0 c)
2085 IError err -> return $ Error err
2087-------------------------------------------------------------------------------
2088-- Alternative Collection
2089-------------------------------------------------------------------------------
2092-- | See 'Streamly.Internal.Data.Parser.choice'.
2094-- /Broken/
2096{-# INLINE choice #-}
2097choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
2098choice = foldl1 shortest
2101-------------------------------------------------------------------------------
2102-- Sequential Repetition
2103-------------------------------------------------------------------------------
2105{-# INLINE manyP #-}
2106manyP :: -- MonadCatch m =>
2107 Parser m a b -> Parser m b c -> Parser m a c
2108manyP _p _f = undefined
2110-- | See 'Streamly.Internal.Data.Parser.many'.
2112-- /Pre-release/
2114{-# INLINE many #-}
2115many :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
2116many = splitMany
2117-- many = countBetween 0 maxBound
2119-- | See 'Streamly.Internal.Data.Parser.some'.
2121-- /Pre-release/
2123{-# INLINE some #-}
2124some :: Monad m => Parser m a b -> Fold m b c -> Parser m a c
2125some = splitSome
2126-- some p f = manyP p (takeGE 1 f)
2127-- some = countBetween 1 maxBound
2129-- | See 'Streamly.Internal.Data.Parser.countBetween'.
2131-- /Unimplemented/
2133{-# INLINE countBetween #-}
2134countBetween :: -- MonadCatch m =>
2135 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
2136countBetween _m _n _p = undefined
2137-- countBetween m n p f = manyP p (takeBetween m n f)
2139-- | See 'Streamly.Internal.Data.Parser.count'.
2141-- /Unimplemented/
2143{-# INLINE count #-}
2144count :: -- MonadCatch m =>
2145 Int -> Parser m a b -> Fold m b c -> Parser m a c
2146count n = countBetween n n
2147-- count n p f = manyP p (takeEQ n f)
2149data ManyTillState fs sr sl
2150 = ManyTillR Int fs sr
2151 | ManyTillL Int fs sl
2153-- | See 'Streamly.Internal.Data.Parser.manyTill'.
2155-- /Pre-release/
2157{-# INLINE manyTill #-}
2158manyTill :: Monad m
2159 => Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c
2160manyTill (Parser stepL initialL extractL)
2161 (Parser stepR initialR _)
2162 (Fold fstep finitial fextract) =
2163 Parser step initial extract
2165 where
2167 -- Caution: Mutual recursion
2169 scrutL fs p c d e = do
2170 resL <- initialL
2171 case resL of
2172 IPartial sl -> return $ c (ManyTillL 0 fs sl)
2173 IDone bl -> do
2174 fr <- fstep fs bl
2175 case fr of
2176 FL.Partial fs1 -> scrutR fs1 p c d e
2177 FL.Done fb -> return $ d fb
2178 IError err -> return $ e err
2180 scrutR fs p c d e = do
2181 resR <- initialR
2182 case resR of
2183 IPartial sr -> return $ p (ManyTillR 0 fs sr)
2184 IDone _ -> d <$> fextract fs
2185 IError _ -> scrutL fs p c d e
2187 initial = do
2188 res <- finitial
2189 case res of
2190 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
2191 FL.Done b -> return $ IDone b
2193 step (ManyTillR cnt fs st) a = do
2194 r <- stepR st a
2195 case r of
2196 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
2197 Continue n s -> do
2198 assertM(cnt + 1 - n >= 0)
2199 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
2200 Done n _ -> do
2201 b <- fextract fs
2202 return $ Done n b
2203 Error _ -> do
2204 resL <- initialL
2205 case resL of
2206 IPartial sl ->
2207 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
2208 IDone bl -> do
2209 fr <- fstep fs bl
2210 let cnt1 = cnt + 1
2211 p = Partial cnt
2212 c = Continue cnt
2213 d = Done cnt
2214 case fr of
2215 FL.Partial fs1 -> scrutR fs1 p c d Error
2216 FL.Done fb -> return $ Done cnt1 fb
2217 IError err -> return $ Error err
2218 -- XXX the cnt is being used only by the assert
2219 step (ManyTillL cnt fs st) a = do
2220 r <- stepL st a
2221 case r of
2222 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
2223 Continue n s -> do
2224 assertM(cnt + 1 - n >= 0)
2225 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
2226 Done n b -> do
2227 fs1 <- fstep fs b
2228 case fs1 of
2229 FL.Partial s ->
2230 scrutR s (Partial n) (Continue n) (Done n) Error
2231 FL.Done b1 -> return $ Done n b1
2232 Error err -> return $ Error err
2234 extract (ManyTillL cnt fs sR) = do
2235 res <- extractL sR
2236 case res of
2237 Done n b -> do
2238 r <- fstep fs b
2239 case r of
2240 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2241 FL.Done c -> return (Done n c)
2242 Error err -> return $ Error err
2243 Continue n s -> do
2244 assertM(n == cnt)
2245 return $ Continue n (ManyTillL 0 fs s)
2246 Partial _ _ -> error "Partial in extract"
2247 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs