git.iko.soy/streamly
on ee691b6 help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
1033 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 (..)
20 -- First order parsers
21 -- * Accumulators
22 , fromFold
23 , yield
24 , yieldM
25 , die
26 , dieM
28 -- * Element parsers
29 , peek
30 , eof
31 , satisfy
32 , maybe
33 , either
35 -- * Sequence parsers
36 --
37 -- Parsers chained in series, if one parser terminates the composition
38 -- terminates. Currently we are using folds to collect the output of the
39 -- parsers but we can use Parsers instead of folds to make the composition
40 -- more powerful. For example, we can do:
41 --
42 -- sliceSepByMax cond n p = sliceBy cond (take n p)
43 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
44 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
45 --
46 -- Grab a sequence of input elements without inspecting them
47 , takeBetween
48 -- , take -- take -- takeBetween 0 n
49 -- , takeLE1 -- take1 -- takeBetween 1 n
50 , takeEQ -- takeBetween n n
51 , takeGE -- takeBetween n maxBound
53 -- Grab a sequence of input elements by inspecting them
54 , lookAhead
55 , takeWhile
56 , takeWhile1
57 , sliceSepByP
58 -- , sliceSepByBetween
59 , sliceBeginWith
60 -- , sliceSepWith
61 --
62 -- , frameSepBy -- parse frames escaped by an escape char/sequence
63 -- , frameEndWith
64 --
65 , wordBy
66 , groupBy
67 , groupByRolling
68 , eqBy
69 -- , prefixOf -- match any prefix of a given string
70 -- , suffixOf -- match any suffix of a given string
71 -- , infixOf -- match any substring of a given string
73 -- ** Spanning
74 , span
75 , spanBy
76 , spanByRolling
78 -- Second order parsers (parsers using parsers)
79 -- * Binary Combinators
81 -- ** Sequential Applicative
82 , serialWith
83 , split_
85 -- ** Parallel Applicatives
86 , teeWith
87 , teeWithFst
88 , teeWithMin
89 -- , teeTill -- like manyTill but parallel
91 -- ** Sequential Interleaving
92 -- Use two folds, run a primary parser, its rejected values go to the
93 -- secondary parser.
94 , deintercalate
96 -- ** Sequential Alternative
97 , alt
99 -- ** Parallel Alternatives
100 , shortest
101 , longest
102 -- , fastest
104 -- * N-ary Combinators
105 -- ** Sequential Collection
106 , sequence
107 , concatMap
109 -- ** Sequential Repetition
110 , count
111 , countBetween
112 -- , countBetweenTill
114 , many
115 , some
116 , manyTill
118 -- -- ** Special cases
119 -- XXX traditional implmentations of these may be of limited use. For
120 -- example, consider parsing lines separated by "\r\n". The main parser
121 -- will have to detect and exclude the sequence "\r\n" anyway so that we
122 -- can apply the "sep" parser.
123 --
124 -- We can instead implement these as special cases of deintercalate.
125 --
126 -- , endBy
127 -- , sepBy
128 -- , sepEndBy
129 -- , beginBy
130 -- , sepBeginBy
131 -- , sepAroundBy
133 -- -- * Distribution
134 --
135 -- A simple and stupid impl would be to just convert the stream to an array
136 -- and give the array reference to all consumers. The array can be grown on
137 -- demand by any consumer and truncated when nonbody needs it.
138 --
139 -- -- ** Distribute to collection
140 -- -- ** Distribute to repetition
142 -- -- ** Interleaved collection
143 -- Round robin
144 -- Priority based
145 -- -- ** Interleaved repetition
146 -- repeat one parser and when it fails run an error recovery parser
147 -- e.g. to find a key frame in the stream after an error
149 -- ** Collection of Alternatives
150 -- , shortestN
151 -- , longestN
152 -- , fastestN -- first N successful in time
153 -- , choiceN -- first N successful in position
154 , choice -- first successful in position
156 -- -- ** Repeated Alternatives
157 -- , retryMax -- try N times
158 -- , retryUntil -- try until successful
159 -- , retryUntilN -- try until successful n times
160 )
161where
163import Control.Exception (assert)
164import Control.Monad.Catch (MonadCatch, MonadThrow(..))
165import Fusion.Plugin.Types (Fuse(..))
166import Streamly.Internal.Data.Fold.Type (Fold(..))
167import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
169import qualified Streamly.Internal.Data.Fold.Type as FL
171import Prelude hiding
172 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
173import Streamly.Internal.Data.Parser.ParserD.Tee
174import Streamly.Internal.Data.Parser.ParserD.Type
176--
177-- $setup
178-- >>> :m
179-- >>> import Prelude hiding ()
180-- >>> import qualified Streamly.Prelude as Stream
181-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
182-- >>> import qualified Streamly.Data.Fold as Fold
183-- >>> import qualified Streamly.Internal.Data.Parser as Parser
185-------------------------------------------------------------------------------
186-- Upgrade folds to parses
187-------------------------------------------------------------------------------
188--
189-- | See 'Streamly.Internal.Data.Parser.fromFold'.
190--
191-- /Pre-release/
192--
193{-# INLINE fromFold #-}
194fromFold :: Monad m => Fold m a b -> Parser m a b
195fromFold (Fold fstep finitial fextract) = Parser step initial fextract
197 where
199 initial = do
200 res <- finitial
201 return
202 $ case res of
203 FL.Partial s1 -> IPartial s1
204 FL.Done b -> IDone b
206 step s a = do
207 res <- fstep s a
208 return
209 $ case res of
210 FL.Partial s1 -> Partial 0 s1
211 FL.Done b -> Done 0 b
213-------------------------------------------------------------------------------
214-- Failing Parsers
215-------------------------------------------------------------------------------
217-- | See 'Streamly.Internal.Data.Parser.peek'.
218--
219-- /Pre-release/
220--
221{-# INLINABLE peek #-}
222peek :: MonadThrow m => Parser m a a
223peek = Parser step initial extract
225 where
227 initial = return $ IPartial ()
229 step () a = return $ Done 1 a
231 extract () = throwM $ ParseError "peek: end of input"
233-- | See 'Streamly.Internal.Data.Parser.eof'.
234--
235-- /Pre-release/
236--
237{-# INLINABLE eof #-}
238eof :: Monad m => Parser m a ()
239eof = Parser step initial return
241 where
243 initial = return $ IPartial ()
245 step () _ = return $ Error "eof: not at end of input"
247-- | See 'Streamly.Internal.Data.Parser.satisfy'.
248--
249-- /Pre-release/
250--
251{-# INLINE satisfy #-}
252satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
253satisfy predicate = Parser step initial extract
255 where
257 initial = return $ IPartial ()
259 step () a = return $
260 if predicate a
261 then Done 0 a
262 else Error "satisfy: predicate failed"
264 extract _ = throwM $ ParseError "satisfy: end of input"
266-- | See 'Streamly.Internal.Data.Parser.maybe'.
267--
268-- /Pre-release/
269--
270{-# INLINE maybe #-}
271maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
272maybe parser = Parser step initial extract
274 where
276 initial = return $ IPartial ()
278 step () a = return $
279 case parser a of
280 Just b -> Done 0 b
281 Nothing -> Error "maybe: predicate failed"
283 extract _ = throwM $ ParseError "maybe: end of input"
285-- | See 'Streamly.Internal.Data.Parser.either'.
286--
287-- /Pre-release/
288--
289{-# INLINE either #-}
290either :: MonadThrow m => (a -> Either String b) -> Parser m a b
291either parser = Parser step initial extract
293 where
295 initial = return $ IPartial ()
297 step () a = return $
298 case parser a of
299 Right b -> Done 0 b
300 Left err -> Error $ "either: " ++ err
302 extract _ = throwM $ ParseError "either: end of input"
304-------------------------------------------------------------------------------
305-- Taking elements
306-------------------------------------------------------------------------------
308-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
309--
310-- /Pre-release/
311--
312{-# INLINE takeBetween #-}
313takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
314takeBetween low high (Fold fstep finitial fextract) =
316 Parser step initial extract
318 where
320 initial = do
321 res <- finitial
322 return $ case res of
323 FL.Partial s -> IPartial $ Tuple' 0 s
324 FL.Done b ->
325 if low <= 0
326 then IDone b
327 else IError
328 $ "takeBetween: the collecting fold terminated without"
329 ++ " consuming any elements"
330 ++ " minimum" ++ show low ++ " elements needed"
332 step (Tuple' i s) a
333 | low > high =
334 throwM
335 $ ParseError
336 $ "takeBetween: lower bound - " ++ show low
337 ++ " is greater than higher bound - " ++ show high
338 | high <= 0 = Done 1 <$> fextract s
339 | i1 < low = do
340 res <- fstep s a
341 return
342 $ case res of
343 FL.Partial s1 -> Continue 0 $ Tuple' i1 s1
344 FL.Done _ ->
345 Error
346 $ "takeBetween: the collecting fold terminated after"
347 ++ " consuming" ++ show i1 ++ " elements"
348 ++ " minimum" ++ show low ++ " elements needed"
349 | otherwise = do
350 res <- fstep s a
351 case res of
352 FL.Partial s1 ->
353 if i1 >= high
354 then Done 0 <$> fextract s1
355 else return $ Partial 0 $ Tuple' i1 s1
356 FL.Done b -> return $ Done 0 b
358 where
360 i1 = i + 1
362 extract (Tuple' i s)
363 | i >= low && i <= high = fextract s
364 | otherwise = throwM $ ParseError err
366 where
368 err =
369 "takeBetween: Expecting alteast " ++ show low
370 ++ " elements, got " ++ show i
372-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
373--
374-- /Pre-release/
375--
376{-# INLINE takeEQ #-}
377takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
378takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
380 where
382 cnt = max n 0
384 initial = do
385 res <- finitial
386 return $ case res of
387 FL.Partial s -> IPartial $ Tuple' 0 s
388 FL.Done b ->
389 if cnt == 0
390 then IDone b
391 else IError
392 $ "takeEQ: Expecting exactly " ++ show cnt
393 ++ " elements, fold terminated without"
394 ++ " consuming any elements"
396 step (Tuple' i r) a
397 | i1 < cnt = do
398 res <- fstep r a
399 return
400 $ case res of
401 FL.Partial s -> Continue 0 $ Tuple' i1 s
402 FL.Done _ ->
403 Error
404 $ "takeEQ: Expecting exactly " ++ show cnt
405 ++ " elements, fold terminated on " ++ show i1
406 | i1 == cnt = do
407 res <- fstep r a
408 Done 0
409 <$> case res of
410 FL.Partial s -> fextract s
411 FL.Done b -> return b
412 -- XXX we should not reach here when initial returns Step type
413 -- reachable only when n == 0
414 | otherwise = Done 1 <$> fextract r
416 where
418 i1 = i + 1
420 extract (Tuple' i r)
421 | i == 0 && cnt == 0 = fextract r
422 | otherwise =
423 throwM
424 $ ParseError
425 $ "takeEQ: Expecting exactly " ++ show cnt
426 ++ " elements, input terminated on " ++ show i
428-- | See 'Streamly.Internal.Data.Parser.takeGE'.
429--
430-- /Pre-release/
431--
432{-# INLINE takeGE #-}
433takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
434takeGE n (Fold fstep finitial fextract) = Parser step initial extract
436 where
438 cnt = max n 0
439 initial = do
440 res <- finitial
441 return $ case res of
442 FL.Partial s -> IPartial $ Tuple' 0 s
443 FL.Done b ->
444 if cnt == 0
445 then IDone b
446 else IError
447 $ "takeGE: Expecting at least " ++ show cnt
448 ++ " elements, fold terminated without"
449 ++ " consuming any elements"
451 step (Tuple' i r) a
452 | i1 < cnt = do
453 res <- fstep r a
454 return
455 $ case res of
456 FL.Partial s -> Continue 0 $ Tuple' i1 s
457 FL.Done _ ->
458 Error
459 $ "takeGE: Expecting at least " ++ show cnt
460 ++ " elements, fold terminated on " ++ show i1
461 | otherwise = do
462 res <- fstep r a
463 return
464 $ case res of
465 FL.Partial s -> Partial 0 $ Tuple' i1 s
466 FL.Done b -> Done 0 b
468 where
470 i1 = i + 1
472 extract (Tuple' i r)
473 | i >= cnt = fextract r
474 | otherwise =
475 throwM
476 $ ParseError
477 $ "takeGE: Expecting at least " ++ show cnt
478 ++ " elements, input terminated on " ++ show i
480-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
481--
482-- /Pre-release/
483--
484{-# INLINE takeWhile #-}
485takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
486takeWhile predicate (Fold fstep finitial fextract) =
487 Parser step initial fextract
489 where
491 initial = do
492 res <- finitial
493 return $ case res of
494 FL.Partial s -> IPartial s
495 FL.Done b -> IDone b
497 step s a =
498 if predicate a
499 then do
500 fres <- fstep s a
501 return
502 $ case fres of
503 FL.Partial s1 -> Partial 0 s1
504 FL.Done b -> Done 0 b
505 else Done 1 <$> fextract s
507-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
508--
509-- /Pre-release/
510--
511{-# INLINE takeWhile1 #-}
512takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
513takeWhile1 predicate (Fold fstep finitial fextract) =
514 Parser step initial extract
516 where
518 initial = do
519 res <- finitial
520 return $ case res of
521 FL.Partial s -> IPartial (Left s)
522 FL.Done _ ->
523 IError
524 $ "takeWhile1: fold terminated without consuming:"
525 ++ " any element"
527 {-# INLINE process #-}
528 process s a = do
529 res <- fstep s a
530 return
531 $ case res of
532 FL.Partial s1 -> Partial 0 (Right s1)
533 FL.Done b -> Done 0 b
535 step (Left s) a =
536 if predicate a
537 then process s a
538 else return $ Error "takeWhile1: predicate failed on first element"
539 step (Right s) a =
540 if predicate a
541 then process s a
542 else do
543 b <- fextract s
544 return $ Done 1 b
546 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
547 extract (Right s) = fextract s
549-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
550--
551-- /Pre-release/
552--
553sliceSepByP :: MonadCatch m =>
554 (a -> Bool) -> Parser m a b -> Parser m a b
555sliceSepByP cond (Parser pstep pinitial pextract) =
557 Parser step initial pextract
559 where
561 initial = pinitial
563 step s a =
564 if cond a
565 then do
566 res <- pextract s
567 return $ Done 0 res
568 else pstep s a
570-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
571--
572-- /Pre-release/
573--
574data SliceBeginWithState s = Left' s | Right' s
576{-# INLINE sliceBeginWith #-}
577sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
578sliceBeginWith cond (Fold fstep finitial fextract) =
580 Parser step initial extract
582 where
584 initial = do
585 res <- finitial
586 return $
587 case res of
588 FL.Partial s -> IPartial (Left' s)
589 FL.Done _ -> IError "sliceBeginWith : bad finitial"
591 {-# INLINE process #-}
592 process s a = do
593 res <- fstep s a
594 return
595 $ case res of
596 FL.Partial s1 -> Partial 0 (Right' s1)
597 FL.Done b -> Done 0 b
599 step (Left' s) a =
600 if cond a
601 then process s a
602 else error $ "sliceBeginWith : slice begins with an element which "
603 ++ "fails the predicate"
604 step (Right' s) a =
605 if not (cond a)
606 then process s a
607 else Done 1 <$> fextract s
609 extract (Left' s) = fextract s
610 extract (Right' s) = fextract s
612data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
614-- | See 'Streamly.Internal.Data.Parser.wordBy'.
615--
616--
617{-# INLINE wordBy #-}
618wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
619wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
621 where
623 {-# INLINE worder #-}
624 worder s a = do
625 res <- fstep s a
626 return
627 $ case res of
628 FL.Partial s1 -> Partial 0 $ WBWord s1
629 FL.Done b -> Done 0 b
631 initial = do
632 res <- finitial
633 return
634 $ case res of
635 FL.Partial s -> IPartial $ WBLeft s
636 FL.Done b -> IDone b
638 step (WBLeft s) a =
639 if not (predicate a)
640 then worder s a
641 else return $ Partial 0 $ WBLeft s
642 step (WBWord s) a =
643 if not (predicate a)
644 then worder s a
645 else do
646 b <- fextract s
647 return $ Partial 0 $ WBRight b
648 step (WBRight b) a =
649 return
650 $ if not (predicate a)
651 then Done 1 b
652 else Partial 0 $ WBRight b
654 extract (WBLeft s) = fextract s
655 extract (WBWord s) = fextract s
656 extract (WBRight b) = return b
658{-# ANN type GroupByState Fuse #-}
659data GroupByState a s
660 = GroupByInit !s
661 | GroupByGrouping !a !s
663-- | See 'Streamly.Internal.Data.Parser.groupBy'.
664--
665{-# INLINE groupBy #-}
666groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
667groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
669 where
671 {-# INLINE grouper #-}
672 grouper s a0 a = do
673 res <- fstep s a
674 return
675 $ case res of
676 FL.Done b -> Done 0 b
677 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
679 initial = do
680 res <- finitial
681 return
682 $ case res of
683 FL.Partial s -> IPartial $ GroupByInit s
684 FL.Done b -> IDone b
686 step (GroupByInit s) a = grouper s a a
687 step (GroupByGrouping a0 s) a =
688 if eq a0 a
689 then grouper s a0 a
690 else Done 1 <$> fextract s
692 extract (GroupByInit s) = fextract s
693 extract (GroupByGrouping _ s) = fextract s
695-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
696--
697{-# INLINE groupByRolling #-}
698groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
699groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
701 where
703 {-# INLINE grouper #-}
704 grouper s a = do
705 res <- fstep s a
706 return
707 $ case res of
708 FL.Done b -> Done 0 b
709 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
711 initial = do
712 res <- finitial
713 return
714 $ case res of
715 FL.Partial s -> IPartial $ GroupByInit s
716 FL.Done b -> IDone b
718 step (GroupByInit s) a = grouper s a
719 step (GroupByGrouping a0 s) a =
720 if eq a0 a
721 then grouper s a
722 else Done 1 <$> fextract s
724 extract (GroupByInit s) = fextract s
725 extract (GroupByGrouping _ s) = fextract s
727-- XXX use an Unfold instead of a list?
728-- XXX custom combinators for matching list, array and stream?
729--
730-- | See 'Streamly.Internal.Data.Parser.eqBy'.
731--
732-- /Pre-release/
733--
734{-# INLINE eqBy #-}
735eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
736eqBy cmp str = Parser step initial extract
738 where
740 initial = return $ IPartial str
742 step [] _ = return $ Done 0 ()
743 step [x] a =
744 return
745 $ if x `cmp` a
746 then Done 0 ()
747 else Error "eqBy: failed, yet to match the last element"
748 step (x:xs) a =
749 return
750 $ if x `cmp` a
751 then Continue 0 xs
752 else Error
753 $ "eqBy: failed, yet to match "
754 ++ show (length xs + 1) ++ " elements"
756 extract xs =
757 throwM
758 $ ParseError
759 $ "eqBy: end of input, yet to match "
760 ++ show (length xs) ++ " elements"
762--------------------------------------------------------------------------------
763--- Spanning
764--------------------------------------------------------------------------------
766-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
767-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
768-- input.
769--
770-- @
771-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
772--
773-- > span_ (< 1) [1,2,3]
774-- ([],[1,2,3])
775--
776-- > span_ (< 2) [1,2,3]
777-- ([1],[2,3])
778--
779-- > span_ (< 4) [1,2,3]
780-- ([1,2,3],[])
781--
782-- @
783--
784-- /Pre-release/
785{-# INLINE span #-}
786span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
787span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
789-- | Break the input stream into two groups, the first group takes the input as
790-- long as the predicate applied to the first element of the stream and next
791-- input element holds 'True', the second group takes the rest of the input.
792--
793-- /Pre-release/
794--
795{-# INLINE spanBy #-}
796spanBy ::
797 Monad m
798 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
799spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
801-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
802-- predicate is applied to the previous and the next input elements.
803--
804-- /Pre-release/
805{-# INLINE spanByRolling #-}
806spanByRolling ::
807 Monad m
808 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
809spanByRolling eq f1 f2 =
810 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
812-------------------------------------------------------------------------------
813-- nested parsers
814-------------------------------------------------------------------------------
816-- | See 'Streamly.Internal.Data.Parser.lookahead'.
817--
818-- /Pre-release/
819--
820{-# INLINE lookAhead #-}
821lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
822lookAhead (Parser step1 initial1 _) = Parser step initial extract
824 where
826 initial = do
827 res <- initial1
828 return $ case res of
829 IPartial s -> IPartial (Tuple' 0 s)
830 IDone b -> IDone b
831 IError e -> IError e
833 step (Tuple' cnt st) a = do
834 r <- step1 st a
835 let cnt1 = cnt + 1
836 return
837 $ case r of
838 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
839 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
840 Done _ b -> Done cnt1 b
841 Error err -> Error err
843 -- XXX returning an error let's us backtrack. To implement it in a way so
844 -- that it terminates on eof without an error then we need a way to
845 -- backtrack on eof, that will require extract to return 'Step' type.
846 extract (Tuple' n _) =
847 throwM
848 $ ParseError
849 $ "lookAhead: end of input after consuming "
850 ++ show n ++ " elements"
852-------------------------------------------------------------------------------
853-- Interleaving
854-------------------------------------------------------------------------------
855--
856-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
857--
858-- /Unimplemented/
859--
860{-# INLINE deintercalate #-}
861deintercalate ::
862 -- Monad m =>
863 Fold m a y -> Parser m x a
864 -> Fold m b z -> Parser m x b
865 -> Parser m x (y, z)
866deintercalate = undefined
868-------------------------------------------------------------------------------
869-- Sequential Collection
870-------------------------------------------------------------------------------
871--
872-- | See 'Streamly.Internal.Data.Parser.sequence'.
873--
874-- /Unimplemented/
875--
876{-# INLINE sequence #-}
877sequence ::
878 -- Foldable t =>
879 Fold m b c -> t (Parser m a b) -> Parser m a c
880sequence _f _p = undefined
882-------------------------------------------------------------------------------
883-- Alternative Collection
884-------------------------------------------------------------------------------
885--
886-- | See 'Streamly.Internal.Data.Parser.choice'.
887--
888-- /Unimplemented/
889--
890{-# INLINE choice #-}
891choice ::
892 -- Foldable t =>
893 t (Parser m a b) -> Parser m a b
894choice _ps = undefined
896-------------------------------------------------------------------------------
897-- Sequential Repetition
898-------------------------------------------------------------------------------
899--
900-- | See 'Streamly.Internal.Data.Parser.many'.
901--
902-- /Pre-release/
903--
904{-# INLINE many #-}
905many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
906many = splitMany
907-- many = countBetween 0 maxBound
909-- | See 'Streamly.Internal.Data.Parser.some'.
910--
911-- /Pre-release/
912--
913{-# INLINE some #-}
914some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
915some = splitSome
916-- some f p = many (takeGE 1 f) p
917-- many = countBetween 1 maxBound
919-- | See 'Streamly.Internal.Data.Parser.countBetween'.
920--
921-- /Unimplemented/
922--
923{-# INLINE countBetween #-}
924countBetween ::
925 -- MonadCatch m =>
926 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
927countBetween _m _n _p = undefined
928-- countBetween m n p f = many (takeBetween m n f) p
930-- | See 'Streamly.Internal.Data.Parser.count'.
931--
932-- /Unimplemented/
933--
934{-# INLINE count #-}
935count ::
936 -- MonadCatch m =>
937 Int -> Parser m a b -> Fold m b c -> Parser m a c
938count n = countBetween n n
939-- count n f p = many (takeEQ n f) p
941data ManyTillState fs sr sl
942 = ManyTillR Int fs sr
943 | ManyTillL Int fs sl
945-- | See 'Streamly.Internal.Data.Parser.manyTill'.
946--
947-- /Pre-release/
948--
949{-# INLINE manyTill #-}
950manyTill :: MonadCatch m
951 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
952manyTill (Fold fstep finitial fextract)
953 (Parser stepL initialL extractL)
954 (Parser stepR initialR _) =
955 Parser step initial extract
957 where
959 -- Caution: Mutual recursion
961 -- Don't inline this
962 scrutL fs p c d e = do
963 resL <- initialL
964 case resL of
965 IPartial sl -> return $ c (ManyTillL 0 fs sl)
966 IDone bl -> do
967 fr <- fstep fs bl
968 case fr of
969 FL.Partial fs1 -> scrutR fs1 p c d e
970 FL.Done fb -> return $ d fb
971 IError err -> return $ e err
973 {-# INLINE scrutR #-}
974 scrutR fs p c d e = do
975 resR <- initialR
976 case resR of
977 IPartial sr -> return $ p (ManyTillR 0 fs sr)
978 IDone _ -> d <$> fextract fs
979 IError _ -> scrutL fs p c d e
981 initial = do
982 res <- finitial
983 case res of
984 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
985 FL.Done b -> return $ IDone b
987 step (ManyTillR cnt fs st) a = do
988 r <- stepR st a
989 case r of
990 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
991 Continue n s -> do
992 assert (cnt + 1 - n >= 0) (return ())
993 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
994 Done n _ -> do
995 b <- fextract fs
996 return $ Done n b
997 Error _ -> do
998 resL <- initialL
999 case resL of
1000 IPartial sl ->
1001 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1002 IDone bl -> do
1003 fr <- fstep fs bl
1004 let cnt1 = cnt + 1
1005 p = Partial cnt
1006 c = Continue cnt
1007 d = Done cnt
1008 case fr of
1009 FL.Partial fs1 -> scrutR fs1 p c d Error
1010 FL.Done fb -> return $ Done cnt1 fb
1011 IError err -> return $ Error err
1012 -- XXX the cnt is being used only by the assert
1013 step (ManyTillL cnt fs st) a = do
1014 r <- stepL st a
1015 case r of
1016 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1017 Continue n s -> do
1018 assert (cnt + 1 - n >= 0) (return ())
1019 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1020 Done n b -> do
1021 fs1 <- fstep fs b
1022 case fs1 of
1023 FL.Partial s ->
1024 scrutR s (Partial n) (Continue n) (Done n) Error
1025 FL.Done b1 -> return $ Done n b1
1026 Error err -> return $ Error err
1028 extract (ManyTillL _ fs sR) = do
1029 res <- extractL sR >>= fstep fs
1030 case res of
1031 FL.Partial s -> fextract s
1032 FL.Done b -> return b
1033 extract (ManyTillR _ fs _) = fextract fs