git.iko.soy/streamly
on 03218ad help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
1034 lines 29 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 -- First order parsers
22 -- * Accumulators
23 , fromFold
24 , fromPure
25 , fromEffect
26 , die
27 , dieM
29 -- * Element parsers
30 , peek
31 , eof
32 , satisfy
33 , maybe
34 , either
36 -- * Sequence parsers
37 --
38 -- Parsers chained in series, if one parser terminates the composition
39 -- terminates. Currently we are using folds to collect the output of the
40 -- parsers but we can use Parsers instead of folds to make the composition
41 -- more powerful. For example, we can do:
42 --
43 -- sliceSepByMax cond n p = sliceBy cond (take n p)
44 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
45 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
46 --
47 -- Grab a sequence of input elements without inspecting them
48 , takeBetween
49 -- , take -- take -- takeBetween 0 n
50 -- , takeLE1 -- take1 -- takeBetween 1 n
51 , takeEQ -- takeBetween n n
52 , takeGE -- takeBetween n maxBound
54 -- Grab a sequence of input elements by inspecting them
55 , lookAhead
56 , takeWhile
57 , takeWhile1
58 , sliceSepByP
59 -- , sliceSepByBetween
60 , sliceBeginWith
61 -- , sliceSepWith
62 --
63 -- , frameSepBy -- parse frames escaped by an escape char/sequence
64 -- , frameEndWith
65 --
66 , wordBy
67 , groupBy
68 , groupByRolling
69 , eqBy
70 -- , prefixOf -- match any prefix of a given string
71 -- , suffixOf -- match any suffix of a given string
72 -- , infixOf -- match any substring of a given string
74 -- ** Spanning
75 , span
76 , spanBy
77 , spanByRolling
79 -- Second order parsers (parsers using parsers)
80 -- * Binary Combinators
82 -- ** Sequential Applicative
83 , serialWith
84 , split_
86 -- ** Parallel Applicatives
87 , teeWith
88 , teeWithFst
89 , teeWithMin
90 -- , teeTill -- like manyTill but parallel
92 -- ** Sequential Interleaving
93 -- Use two folds, run a primary parser, its rejected values go to the
94 -- secondary parser.
95 , deintercalate
97 -- ** Sequential Alternative
98 , alt
100 -- ** Parallel Alternatives
101 , shortest
102 , longest
103 -- , fastest
105 -- * N-ary Combinators
106 -- ** Sequential Collection
107 , sequence
108 , concatMap
110 -- ** Sequential Repetition
111 , count
112 , countBetween
113 -- , countBetweenTill
115 , many
116 , some
117 , manyTill
119 -- -- ** Special cases
120 -- XXX traditional implmentations of these may be of limited use. For
121 -- example, consider parsing lines separated by "\r\n". The main parser
122 -- will have to detect and exclude the sequence "\r\n" anyway so that we
123 -- can apply the "sep" parser.
124 --
125 -- We can instead implement these as special cases of deintercalate.
126 --
127 -- , endBy
128 -- , sepBy
129 -- , sepEndBy
130 -- , beginBy
131 -- , sepBeginBy
132 -- , sepAroundBy
134 -- -- * Distribution
135 --
136 -- A simple and stupid impl would be to just convert the stream to an array
137 -- and give the array reference to all consumers. The array can be grown on
138 -- demand by any consumer and truncated when nonbody needs it.
139 --
140 -- -- ** Distribute to collection
141 -- -- ** Distribute to repetition
143 -- -- ** Interleaved collection
144 -- Round robin
145 -- Priority based
146 -- -- ** Interleaved repetition
147 -- repeat one parser and when it fails run an error recovery parser
148 -- e.g. to find a key frame in the stream after an error
150 -- ** Collection of Alternatives
151 -- , shortestN
152 -- , longestN
153 -- , fastestN -- first N successful in time
154 -- , choiceN -- first N successful in position
155 , choice -- first successful in position
157 -- -- ** Repeated Alternatives
158 -- , retryMax -- try N times
159 -- , retryUntil -- try until successful
160 -- , retryUntilN -- try until successful n times
161 )
162where
164import Control.Exception (assert)
165import Control.Monad.Catch (MonadCatch, MonadThrow(..))
166import Fusion.Plugin.Types (Fuse(..))
167import Streamly.Internal.Data.Fold.Type (Fold(..))
168import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
170import qualified Streamly.Internal.Data.Fold.Type as FL
172import Prelude hiding
173 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
174import Streamly.Internal.Data.Parser.ParserD.Tee
175import Streamly.Internal.Data.Parser.ParserD.Type
177--
178-- $setup
179-- >>> :m
180-- >>> import Prelude hiding ()
181-- >>> import qualified Streamly.Prelude as Stream
182-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
183-- >>> import qualified Streamly.Data.Fold as Fold
184-- >>> import qualified Streamly.Internal.Data.Parser as Parser
186-------------------------------------------------------------------------------
187-- Upgrade folds to parses
188-------------------------------------------------------------------------------
189--
190-- | See 'Streamly.Internal.Data.Parser.fromFold'.
191--
192-- /Pre-release/
193--
194{-# INLINE fromFold #-}
195fromFold :: Monad m => Fold m a b -> Parser m a b
196fromFold (Fold fstep finitial fextract) = Parser step initial fextract
198 where
200 initial = do
201 res <- finitial
202 return
203 $ case res of
204 FL.Partial s1 -> IPartial s1
205 FL.Done b -> IDone b
207 step s a = do
208 res <- fstep s a
209 return
210 $ case res of
211 FL.Partial s1 -> Partial 0 s1
212 FL.Done b -> Done 0 b
214-------------------------------------------------------------------------------
215-- Failing Parsers
216-------------------------------------------------------------------------------
218-- | See 'Streamly.Internal.Data.Parser.peek'.
219--
220-- /Pre-release/
221--
222{-# INLINABLE peek #-}
223peek :: MonadThrow m => Parser m a a
224peek = Parser step initial extract
226 where
228 initial = return $ IPartial ()
230 step () a = return $ Done 1 a
232 extract () = throwM $ ParseError "peek: end of input"
234-- | See 'Streamly.Internal.Data.Parser.eof'.
235--
236-- /Pre-release/
237--
238{-# INLINABLE eof #-}
239eof :: Monad m => Parser m a ()
240eof = Parser step initial return
242 where
244 initial = return $ IPartial ()
246 step () _ = return $ Error "eof: not at end of input"
248-- | See 'Streamly.Internal.Data.Parser.satisfy'.
249--
250-- /Pre-release/
251--
252{-# INLINE satisfy #-}
253satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
254satisfy predicate = Parser step initial extract
256 where
258 initial = return $ IPartial ()
260 step () a = return $
261 if predicate a
262 then Done 0 a
263 else Error "satisfy: predicate failed"
265 extract _ = throwM $ ParseError "satisfy: end of input"
267-- | See 'Streamly.Internal.Data.Parser.maybe'.
268--
269-- /Pre-release/
270--
271{-# INLINE maybe #-}
272maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
273maybe parser = Parser step initial extract
275 where
277 initial = return $ IPartial ()
279 step () a = return $
280 case parser a of
281 Just b -> Done 0 b
282 Nothing -> Error "maybe: predicate failed"
284 extract _ = throwM $ ParseError "maybe: end of input"
286-- | See 'Streamly.Internal.Data.Parser.either'.
287--
288-- /Pre-release/
289--
290{-# INLINE either #-}
291either :: MonadThrow m => (a -> Either String b) -> Parser m a b
292either parser = Parser step initial extract
294 where
296 initial = return $ IPartial ()
298 step () a = return $
299 case parser a of
300 Right b -> Done 0 b
301 Left err -> Error $ "either: " ++ err
303 extract _ = throwM $ ParseError "either: end of input"
305-------------------------------------------------------------------------------
306-- Taking elements
307-------------------------------------------------------------------------------
309-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
310--
311-- /Pre-release/
312--
313{-# INLINE takeBetween #-}
314takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
315takeBetween low high (Fold fstep finitial fextract) =
317 Parser step initial extract
319 where
321 initial = do
322 res <- finitial
323 return $ case res of
324 FL.Partial s -> IPartial $ Tuple' 0 s
325 FL.Done b ->
326 if low <= 0
327 then IDone b
328 else IError
329 $ "takeBetween: the collecting fold terminated without"
330 ++ " consuming any elements"
331 ++ " minimum" ++ show low ++ " elements needed"
333 step (Tuple' i s) a
334 | low > high =
335 throwM
336 $ ParseError
337 $ "takeBetween: lower bound - " ++ show low
338 ++ " is greater than higher bound - " ++ show high
339 | high <= 0 = Done 1 <$> fextract s
340 | i1 < low = do
341 res <- fstep s a
342 return
343 $ case res of
344 FL.Partial s1 -> Continue 0 $ Tuple' i1 s1
345 FL.Done _ ->
346 Error
347 $ "takeBetween: the collecting fold terminated after"
348 ++ " consuming" ++ show i1 ++ " elements"
349 ++ " minimum" ++ show low ++ " elements needed"
350 | otherwise = do
351 res <- fstep s a
352 case res of
353 FL.Partial s1 ->
354 if i1 >= high
355 then Done 0 <$> fextract s1
356 else return $ Partial 0 $ Tuple' i1 s1
357 FL.Done b -> return $ Done 0 b
359 where
361 i1 = i + 1
363 extract (Tuple' i s)
364 | i >= low && i <= high = fextract s
365 | otherwise = throwM $ ParseError err
367 where
369 err =
370 "takeBetween: Expecting alteast " ++ show low
371 ++ " elements, got " ++ show i
373-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
374--
375-- /Pre-release/
376--
377{-# INLINE takeEQ #-}
378takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
379takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
381 where
383 cnt = max n 0
385 initial = do
386 res <- finitial
387 return $ case res of
388 FL.Partial s -> IPartial $ Tuple' 0 s
389 FL.Done b ->
390 if cnt == 0
391 then IDone b
392 else IError
393 $ "takeEQ: Expecting exactly " ++ show cnt
394 ++ " elements, fold terminated without"
395 ++ " consuming any elements"
397 step (Tuple' i r) a
398 | i1 < cnt = do
399 res <- fstep r a
400 return
401 $ case res of
402 FL.Partial s -> Continue 0 $ Tuple' i1 s
403 FL.Done _ ->
404 Error
405 $ "takeEQ: Expecting exactly " ++ show cnt
406 ++ " elements, fold terminated on " ++ show i1
407 | i1 == cnt = do
408 res <- fstep r a
409 Done 0
410 <$> case res of
411 FL.Partial s -> fextract s
412 FL.Done b -> return b
413 -- XXX we should not reach here when initial returns Step type
414 -- reachable only when n == 0
415 | otherwise = Done 1 <$> fextract r
417 where
419 i1 = i + 1
421 extract (Tuple' i r)
422 | i == 0 && cnt == 0 = fextract r
423 | otherwise =
424 throwM
425 $ ParseError
426 $ "takeEQ: Expecting exactly " ++ show cnt
427 ++ " elements, input terminated on " ++ show i
429-- | See 'Streamly.Internal.Data.Parser.takeGE'.
430--
431-- /Pre-release/
432--
433{-# INLINE takeGE #-}
434takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
435takeGE n (Fold fstep finitial fextract) = Parser step initial extract
437 where
439 cnt = max n 0
440 initial = do
441 res <- finitial
442 return $ case res of
443 FL.Partial s -> IPartial $ Tuple' 0 s
444 FL.Done b ->
445 if cnt == 0
446 then IDone b
447 else IError
448 $ "takeGE: Expecting at least " ++ show cnt
449 ++ " elements, fold terminated without"
450 ++ " consuming any elements"
452 step (Tuple' i r) a
453 | i1 < cnt = do
454 res <- fstep r a
455 return
456 $ case res of
457 FL.Partial s -> Continue 0 $ Tuple' i1 s
458 FL.Done _ ->
459 Error
460 $ "takeGE: Expecting at least " ++ show cnt
461 ++ " elements, fold terminated on " ++ show i1
462 | otherwise = do
463 res <- fstep r a
464 return
465 $ case res of
466 FL.Partial s -> Partial 0 $ Tuple' i1 s
467 FL.Done b -> Done 0 b
469 where
471 i1 = i + 1
473 extract (Tuple' i r)
474 | i >= cnt = fextract r
475 | otherwise =
476 throwM
477 $ ParseError
478 $ "takeGE: Expecting at least " ++ show cnt
479 ++ " elements, input terminated on " ++ show i
481-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
482--
483-- /Pre-release/
484--
485{-# INLINE takeWhile #-}
486takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
487takeWhile predicate (Fold fstep finitial fextract) =
488 Parser step initial fextract
490 where
492 initial = do
493 res <- finitial
494 return $ case res of
495 FL.Partial s -> IPartial s
496 FL.Done b -> IDone b
498 step s a =
499 if predicate a
500 then do
501 fres <- fstep s a
502 return
503 $ case fres of
504 FL.Partial s1 -> Partial 0 s1
505 FL.Done b -> Done 0 b
506 else Done 1 <$> fextract s
508-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
509--
510-- /Pre-release/
511--
512{-# INLINE takeWhile1 #-}
513takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
514takeWhile1 predicate (Fold fstep finitial fextract) =
515 Parser step initial extract
517 where
519 initial = do
520 res <- finitial
521 return $ case res of
522 FL.Partial s -> IPartial (Left s)
523 FL.Done _ ->
524 IError
525 $ "takeWhile1: fold terminated without consuming:"
526 ++ " any element"
528 {-# INLINE process #-}
529 process s a = do
530 res <- fstep s a
531 return
532 $ case res of
533 FL.Partial s1 -> Partial 0 (Right s1)
534 FL.Done b -> Done 0 b
536 step (Left s) a =
537 if predicate a
538 then process s a
539 else return $ Error "takeWhile1: predicate failed on first element"
540 step (Right s) a =
541 if predicate a
542 then process s a
543 else do
544 b <- fextract s
545 return $ Done 1 b
547 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
548 extract (Right s) = fextract s
550-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
551--
552-- /Pre-release/
553--
554sliceSepByP :: MonadCatch m =>
555 (a -> Bool) -> Parser m a b -> Parser m a b
556sliceSepByP cond (Parser pstep pinitial pextract) =
558 Parser step initial pextract
560 where
562 initial = pinitial
564 step s a =
565 if cond a
566 then do
567 res <- pextract s
568 return $ Done 0 res
569 else pstep s a
571-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
572--
573-- /Pre-release/
574--
575data SliceBeginWithState s = Left' s | Right' s
577{-# INLINE sliceBeginWith #-}
578sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
579sliceBeginWith cond (Fold fstep finitial fextract) =
581 Parser step initial extract
583 where
585 initial = do
586 res <- finitial
587 return $
588 case res of
589 FL.Partial s -> IPartial (Left' s)
590 FL.Done _ -> IError "sliceBeginWith : bad finitial"
592 {-# INLINE process #-}
593 process s a = do
594 res <- fstep s a
595 return
596 $ case res of
597 FL.Partial s1 -> Partial 0 (Right' s1)
598 FL.Done b -> Done 0 b
600 step (Left' s) a =
601 if cond a
602 then process s a
603 else error $ "sliceBeginWith : slice begins with an element which "
604 ++ "fails the predicate"
605 step (Right' s) a =
606 if not (cond a)
607 then process s a
608 else Done 1 <$> fextract s
610 extract (Left' s) = fextract s
611 extract (Right' s) = fextract s
613data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
615-- | See 'Streamly.Internal.Data.Parser.wordBy'.
616--
617--
618{-# INLINE wordBy #-}
619wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
620wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
622 where
624 {-# INLINE worder #-}
625 worder s a = do
626 res <- fstep s a
627 return
628 $ case res of
629 FL.Partial s1 -> Partial 0 $ WBWord s1
630 FL.Done b -> Done 0 b
632 initial = do
633 res <- finitial
634 return
635 $ case res of
636 FL.Partial s -> IPartial $ WBLeft s
637 FL.Done b -> IDone b
639 step (WBLeft s) a =
640 if not (predicate a)
641 then worder s a
642 else return $ Partial 0 $ WBLeft s
643 step (WBWord s) a =
644 if not (predicate a)
645 then worder s a
646 else do
647 b <- fextract s
648 return $ Partial 0 $ WBRight b
649 step (WBRight b) a =
650 return
651 $ if not (predicate a)
652 then Done 1 b
653 else Partial 0 $ WBRight b
655 extract (WBLeft s) = fextract s
656 extract (WBWord s) = fextract s
657 extract (WBRight b) = return b
659{-# ANN type GroupByState Fuse #-}
660data GroupByState a s
661 = GroupByInit !s
662 | GroupByGrouping !a !s
664-- | See 'Streamly.Internal.Data.Parser.groupBy'.
665--
666{-# INLINE groupBy #-}
667groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
668groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
670 where
672 {-# INLINE grouper #-}
673 grouper s a0 a = do
674 res <- fstep s a
675 return
676 $ case res of
677 FL.Done b -> Done 0 b
678 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
680 initial = do
681 res <- finitial
682 return
683 $ case res of
684 FL.Partial s -> IPartial $ GroupByInit s
685 FL.Done b -> IDone b
687 step (GroupByInit s) a = grouper s a a
688 step (GroupByGrouping a0 s) a =
689 if eq a0 a
690 then grouper s a0 a
691 else Done 1 <$> fextract s
693 extract (GroupByInit s) = fextract s
694 extract (GroupByGrouping _ s) = fextract s
696-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
697--
698{-# INLINE groupByRolling #-}
699groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
700groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
702 where
704 {-# INLINE grouper #-}
705 grouper s a = do
706 res <- fstep s a
707 return
708 $ case res of
709 FL.Done b -> Done 0 b
710 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
712 initial = do
713 res <- finitial
714 return
715 $ case res of
716 FL.Partial s -> IPartial $ GroupByInit s
717 FL.Done b -> IDone b
719 step (GroupByInit s) a = grouper s a
720 step (GroupByGrouping a0 s) a =
721 if eq a0 a
722 then grouper s a
723 else Done 1 <$> fextract s
725 extract (GroupByInit s) = fextract s
726 extract (GroupByGrouping _ s) = fextract s
728-- XXX use an Unfold instead of a list?
729-- XXX custom combinators for matching list, array and stream?
730--
731-- | See 'Streamly.Internal.Data.Parser.eqBy'.
732--
733-- /Pre-release/
734--
735{-# INLINE eqBy #-}
736eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
737eqBy cmp str = Parser step initial extract
739 where
741 initial = return $ IPartial str
743 step [] _ = return $ Done 0 ()
744 step [x] a =
745 return
746 $ if x `cmp` a
747 then Done 0 ()
748 else Error "eqBy: failed, yet to match the last element"
749 step (x:xs) a =
750 return
751 $ if x `cmp` a
752 then Continue 0 xs
753 else Error
754 $ "eqBy: failed, yet to match "
755 ++ show (length xs + 1) ++ " elements"
757 extract xs =
758 throwM
759 $ ParseError
760 $ "eqBy: end of input, yet to match "
761 ++ show (length xs) ++ " elements"
763--------------------------------------------------------------------------------
764--- Spanning
765--------------------------------------------------------------------------------
767-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
768-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
769-- input.
770--
771-- @
772-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
773--
774-- > span_ (< 1) [1,2,3]
775-- ([],[1,2,3])
776--
777-- > span_ (< 2) [1,2,3]
778-- ([1],[2,3])
779--
780-- > span_ (< 4) [1,2,3]
781-- ([1,2,3],[])
782--
783-- @
784--
785-- /Pre-release/
786{-# INLINE span #-}
787span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
788span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
790-- | Break the input stream into two groups, the first group takes the input as
791-- long as the predicate applied to the first element of the stream and next
792-- input element holds 'True', the second group takes the rest of the input.
793--
794-- /Pre-release/
795--
796{-# INLINE spanBy #-}
797spanBy ::
798 Monad m
799 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
800spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
802-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
803-- predicate is applied to the previous and the next input elements.
804--
805-- /Pre-release/
806{-# INLINE spanByRolling #-}
807spanByRolling ::
808 Monad m
809 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
810spanByRolling eq f1 f2 =
811 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
813-------------------------------------------------------------------------------
814-- nested parsers
815-------------------------------------------------------------------------------
817-- | See 'Streamly.Internal.Data.Parser.lookahead'.
818--
819-- /Pre-release/
820--
821{-# INLINE lookAhead #-}
822lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
823lookAhead (Parser step1 initial1 _) = Parser step initial extract
825 where
827 initial = do
828 res <- initial1
829 return $ case res of
830 IPartial s -> IPartial (Tuple' 0 s)
831 IDone b -> IDone b
832 IError e -> IError e
834 step (Tuple' cnt st) a = do
835 r <- step1 st a
836 let cnt1 = cnt + 1
837 return
838 $ case r of
839 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
840 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
841 Done _ b -> Done cnt1 b
842 Error err -> Error err
844 -- XXX returning an error let's us backtrack. To implement it in a way so
845 -- that it terminates on eof without an error then we need a way to
846 -- backtrack on eof, that will require extract to return 'Step' type.
847 extract (Tuple' n _) =
848 throwM
849 $ ParseError
850 $ "lookAhead: end of input after consuming "
851 ++ show n ++ " elements"
853-------------------------------------------------------------------------------
854-- Interleaving
855-------------------------------------------------------------------------------
856--
857-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
858--
859-- /Unimplemented/
860--
861{-# INLINE deintercalate #-}
862deintercalate ::
863 -- Monad m =>
864 Fold m a y -> Parser m x a
865 -> Fold m b z -> Parser m x b
866 -> Parser m x (y, z)
867deintercalate = undefined
869-------------------------------------------------------------------------------
870-- Sequential Collection
871-------------------------------------------------------------------------------
872--
873-- | See 'Streamly.Internal.Data.Parser.sequence'.
874--
875-- /Unimplemented/
876--
877{-# INLINE sequence #-}
878sequence ::
879 -- Foldable t =>
880 Fold m b c -> t (Parser m a b) -> Parser m a c
881sequence _f _p = undefined
883-------------------------------------------------------------------------------
884-- Alternative Collection
885-------------------------------------------------------------------------------
886--
887-- | See 'Streamly.Internal.Data.Parser.choice'.
888--
889-- /Unimplemented/
890--
891{-# INLINE choice #-}
892choice ::
893 -- Foldable t =>
894 t (Parser m a b) -> Parser m a b
895choice _ps = undefined
897-------------------------------------------------------------------------------
898-- Sequential Repetition
899-------------------------------------------------------------------------------
900--
901-- | See 'Streamly.Internal.Data.Parser.many'.
902--
903-- /Pre-release/
904--
905{-# INLINE many #-}
906many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
907many = splitMany
908-- many = countBetween 0 maxBound
910-- | See 'Streamly.Internal.Data.Parser.some'.
911--
912-- /Pre-release/
913--
914{-# INLINE some #-}
915some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
916some = splitSome
917-- some f p = many (takeGE 1 f) p
918-- many = countBetween 1 maxBound
920-- | See 'Streamly.Internal.Data.Parser.countBetween'.
921--
922-- /Unimplemented/
923--
924{-# INLINE countBetween #-}
925countBetween ::
926 -- MonadCatch m =>
927 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
928countBetween _m _n _p = undefined
929-- countBetween m n p f = many (takeBetween m n f) p
931-- | See 'Streamly.Internal.Data.Parser.count'.
932--
933-- /Unimplemented/
934--
935{-# INLINE count #-}
936count ::
937 -- MonadCatch m =>
938 Int -> Parser m a b -> Fold m b c -> Parser m a c
939count n = countBetween n n
940-- count n f p = many (takeEQ n f) p
942data ManyTillState fs sr sl
943 = ManyTillR Int fs sr
944 | ManyTillL Int fs sl
946-- | See 'Streamly.Internal.Data.Parser.manyTill'.
947--
948-- /Pre-release/
949--
950{-# INLINE manyTill #-}
951manyTill :: MonadCatch m
952 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
953manyTill (Fold fstep finitial fextract)
954 (Parser stepL initialL extractL)
955 (Parser stepR initialR _) =
956 Parser step initial extract
958 where
960 -- Caution: Mutual recursion
962 -- Don't inline this
963 scrutL fs p c d e = do
964 resL <- initialL
965 case resL of
966 IPartial sl -> return $ c (ManyTillL 0 fs sl)
967 IDone bl -> do
968 fr <- fstep fs bl
969 case fr of
970 FL.Partial fs1 -> scrutR fs1 p c d e
971 FL.Done fb -> return $ d fb
972 IError err -> return $ e err
974 {-# INLINE scrutR #-}
975 scrutR fs p c d e = do
976 resR <- initialR
977 case resR of
978 IPartial sr -> return $ p (ManyTillR 0 fs sr)
979 IDone _ -> d <$> fextract fs
980 IError _ -> scrutL fs p c d e
982 initial = do
983 res <- finitial
984 case res of
985 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
986 FL.Done b -> return $ IDone b
988 step (ManyTillR cnt fs st) a = do
989 r <- stepR st a
990 case r of
991 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
992 Continue n s -> do
993 assert (cnt + 1 - n >= 0) (return ())
994 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
995 Done n _ -> do
996 b <- fextract fs
997 return $ Done n b
998 Error _ -> do
999 resL <- initialL
1000 case resL of
1001 IPartial sl ->
1002 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1003 IDone bl -> do
1004 fr <- fstep fs bl
1005 let cnt1 = cnt + 1
1006 p = Partial cnt
1007 c = Continue cnt
1008 d = Done cnt
1009 case fr of
1010 FL.Partial fs1 -> scrutR fs1 p c d Error
1011 FL.Done fb -> return $ Done cnt1 fb
1012 IError err -> return $ Error err
1013 -- XXX the cnt is being used only by the assert
1014 step (ManyTillL cnt fs st) a = do
1015 r <- stepL st a
1016 case r of
1017 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1018 Continue n s -> do
1019 assert (cnt + 1 - n >= 0) (return ())
1020 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1021 Done n b -> do
1022 fs1 <- fstep fs b
1023 case fs1 of
1024 FL.Partial s ->
1025 scrutR s (Partial n) (Continue n) (Done n) Error
1026 FL.Done b1 -> return $ Done n b1
1027 Error err -> return $ Error err
1029 extract (ManyTillL _ fs sR) = do
1030 res <- extractL sR >>= fstep fs
1031 case res of
1032 FL.Partial s -> fextract s
1033 FL.Done b -> return b
1034 extract (ManyTillR _ fs _) = fextract fs