git.iko.soy/streamly
on a322c07 help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
1091 lines 31 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 , takeP
56 , lookAhead
57 , takeWhile
58 , takeWhile1
59 , sliceSepByP
60 -- , sliceSepByBetween
61 , sliceBeginWith
62 -- , sliceSepWith
63 --
64 -- , frameSepBy -- parse frames escaped by an escape char/sequence
65 -- , frameEndWith
66 --
67 , wordBy
68 , groupBy
69 , groupByRolling
70 , eqBy
71 -- , prefixOf -- match any prefix of a given string
72 -- , suffixOf -- match any suffix of a given string
73 -- , infixOf -- match any substring of a given string
75 -- ** Spanning
76 , span
77 , spanBy
78 , spanByRolling
80 -- Second order parsers (parsers using parsers)
81 -- * Binary Combinators
83 -- ** Sequential Applicative
84 , serialWith
85 , split_
87 -- ** Parallel Applicatives
88 , teeWith
89 , teeWithFst
90 , teeWithMin
91 -- , teeTill -- like manyTill but parallel
93 -- ** Sequential Interleaving
94 -- Use two folds, run a primary parser, its rejected values go to the
95 -- secondary parser.
96 , deintercalate
98 -- ** Sequential Alternative
99 , alt
101 -- ** Parallel Alternatives
102 , shortest
103 , longest
104 -- , fastest
106 -- * N-ary Combinators
107 -- ** Sequential Collection
108 , sequence
109 , concatMap
111 -- ** Sequential Repetition
112 , count
113 , countBetween
114 -- , countBetweenTill
116 , many
117 , some
118 , manyTill
120 -- -- ** Special cases
121 -- XXX traditional implmentations of these may be of limited use. For
122 -- example, consider parsing lines separated by "\r\n". The main parser
123 -- will have to detect and exclude the sequence "\r\n" anyway so that we
124 -- can apply the "sep" parser.
125 --
126 -- We can instead implement these as special cases of deintercalate.
127 --
128 -- , endBy
129 -- , sepBy
130 -- , sepEndBy
131 -- , beginBy
132 -- , sepBeginBy
133 -- , sepAroundBy
135 -- -- * Distribution
136 --
137 -- A simple and stupid impl would be to just convert the stream to an array
138 -- and give the array reference to all consumers. The array can be grown on
139 -- demand by any consumer and truncated when nonbody needs it.
140 --
141 -- -- ** Distribute to collection
142 -- -- ** Distribute to repetition
144 -- -- ** Interleaved collection
145 -- Round robin
146 -- Priority based
147 -- -- ** Interleaved repetition
148 -- repeat one parser and when it fails run an error recovery parser
149 -- e.g. to find a key frame in the stream after an error
151 -- ** Collection of Alternatives
152 -- , shortestN
153 -- , longestN
154 -- , fastestN -- first N successful in time
155 -- , choiceN -- first N successful in position
156 , choice -- first successful in position
158 -- -- ** Repeated Alternatives
159 -- , retryMax -- try N times
160 -- , retryUntil -- try until successful
161 -- , retryUntilN -- try until successful n times
162 )
163where
165import Control.Exception (assert)
166import Control.Monad.Catch (MonadCatch, MonadThrow(..))
167import Fusion.Plugin.Types (Fuse(..))
168import Streamly.Internal.Data.Fold.Type (Fold(..))
169import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
171import qualified Streamly.Internal.Data.Fold.Type as FL
173import Prelude hiding
174 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
175import Streamly.Internal.Data.Parser.ParserD.Tee
176import Streamly.Internal.Data.Parser.ParserD.Type
178--
179-- $setup
180-- >>> :m
181-- >>> import Prelude hiding ()
182-- >>> import qualified Streamly.Prelude as Stream
183-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
184-- >>> import qualified Streamly.Data.Fold as Fold
185-- >>> import qualified Streamly.Internal.Data.Parser as Parser
187-------------------------------------------------------------------------------
188-- Upgrade folds to parses
189-------------------------------------------------------------------------------
190--
191-- | See 'Streamly.Internal.Data.Parser.fromFold'.
192--
193-- /Pre-release/
194--
195{-# INLINE fromFold #-}
196fromFold :: Monad m => Fold m a b -> Parser m a b
197fromFold (Fold fstep finitial fextract) = Parser step initial fextract
199 where
201 initial = do
202 res <- finitial
203 return
204 $ case res of
205 FL.Partial s1 -> IPartial s1
206 FL.Done b -> IDone b
208 step s a = do
209 res <- fstep s a
210 return
211 $ case res of
212 FL.Partial s1 -> Partial 0 s1
213 FL.Done b -> Done 0 b
215-------------------------------------------------------------------------------
216-- Failing Parsers
217-------------------------------------------------------------------------------
219-- | See 'Streamly.Internal.Data.Parser.peek'.
220--
221-- /Pre-release/
222--
223{-# INLINABLE peek #-}
224peek :: MonadThrow m => Parser m a a
225peek = Parser step initial extract
227 where
229 initial = return $ IPartial ()
231 step () a = return $ Done 1 a
233 extract () = throwM $ ParseError "peek: end of input"
235-- | See 'Streamly.Internal.Data.Parser.eof'.
236--
237-- /Pre-release/
238--
239{-# INLINABLE eof #-}
240eof :: Monad m => Parser m a ()
241eof = Parser step initial return
243 where
245 initial = return $ IPartial ()
247 step () _ = return $ Error "eof: not at end of input"
249-- | See 'Streamly.Internal.Data.Parser.satisfy'.
250--
251-- /Pre-release/
252--
253{-# INLINE satisfy #-}
254satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
255satisfy predicate = Parser step initial extract
257 where
259 initial = return $ IPartial ()
261 step () a = return $
262 if predicate a
263 then Done 0 a
264 else Error "satisfy: predicate failed"
266 extract _ = throwM $ ParseError "satisfy: end of input"
268-- | See 'Streamly.Internal.Data.Parser.maybe'.
269--
270-- /Pre-release/
271--
272{-# INLINE maybe #-}
273maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
274maybe parser = Parser step initial extract
276 where
278 initial = return $ IPartial ()
280 step () a = return $
281 case parser a of
282 Just b -> Done 0 b
283 Nothing -> Error "maybe: predicate failed"
285 extract _ = throwM $ ParseError "maybe: end of input"
287-- | See 'Streamly.Internal.Data.Parser.either'.
288--
289-- /Pre-release/
290--
291{-# INLINE either #-}
292either :: MonadThrow m => (a -> Either String b) -> Parser m a b
293either parser = Parser step initial extract
295 where
297 initial = return $ IPartial ()
299 step () a = return $
300 case parser a of
301 Right b -> Done 0 b
302 Left err -> Error $ "either: " ++ err
304 extract _ = throwM $ ParseError "either: end of input"
306-------------------------------------------------------------------------------
307-- Taking elements
308-------------------------------------------------------------------------------
310-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
311--
312-- /Pre-release/
313--
314{-# INLINE takeBetween #-}
315takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
316takeBetween low high (Fold fstep finitial fextract) =
318 Parser step initial extract
320 where
322 initial = do
323 res <- finitial
324 return $ case res of
325 FL.Partial s -> IPartial $ Tuple' 0 s
326 FL.Done b ->
327 if low <= 0
328 then IDone b
329 else IError
330 $ "takeBetween: the collecting fold terminated without"
331 ++ " consuming any elements"
332 ++ " minimum" ++ show low ++ " elements needed"
334 step (Tuple' i s) a
335 | low > high =
336 throwM
337 $ ParseError
338 $ "takeBetween: lower bound - " ++ show low
339 ++ " is greater than higher bound - " ++ show high
340 | high <= 0 = Done 1 <$> fextract s
341 | i1 < low = do
342 res <- fstep s a
343 return
344 $ case res of
345 FL.Partial s1 -> Continue 0 $ Tuple' i1 s1
346 FL.Done _ ->
347 Error
348 $ "takeBetween: the collecting fold terminated after"
349 ++ " consuming" ++ show i1 ++ " elements"
350 ++ " minimum" ++ show low ++ " elements needed"
351 | otherwise = do
352 res <- fstep s a
353 case res of
354 FL.Partial s1 ->
355 if i1 >= high
356 then Done 0 <$> fextract s1
357 else return $ Partial 0 $ Tuple' i1 s1
358 FL.Done b -> return $ Done 0 b
360 where
362 i1 = i + 1
364 extract (Tuple' i s)
365 | i >= low && i <= high = fextract s
366 | otherwise = throwM $ ParseError err
368 where
370 err =
371 "takeBetween: Expecting alteast " ++ show low
372 ++ " elements, got " ++ show i
374-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
375--
376-- /Pre-release/
377--
378{-# INLINE takeEQ #-}
379takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
380takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
382 where
384 cnt = max n 0
386 initial = do
387 res <- finitial
388 return $ case res of
389 FL.Partial s -> IPartial $ Tuple' 0 s
390 FL.Done b ->
391 if cnt == 0
392 then IDone b
393 else IError
394 $ "takeEQ: Expecting exactly " ++ show cnt
395 ++ " elements, fold terminated without"
396 ++ " consuming any elements"
398 step (Tuple' i r) a
399 | i1 < cnt = do
400 res <- fstep r a
401 return
402 $ case res of
403 FL.Partial s -> Continue 0 $ Tuple' i1 s
404 FL.Done _ ->
405 Error
406 $ "takeEQ: Expecting exactly " ++ show cnt
407 ++ " elements, fold terminated on " ++ show i1
408 | i1 == cnt = do
409 res <- fstep r a
410 Done 0
411 <$> case res of
412 FL.Partial s -> fextract s
413 FL.Done b -> return b
414 -- XXX we should not reach here when initial returns Step type
415 -- reachable only when n == 0
416 | otherwise = Done 1 <$> fextract r
418 where
420 i1 = i + 1
422 extract (Tuple' i r)
423 | i == 0 && cnt == 0 = fextract r
424 | otherwise =
425 throwM
426 $ ParseError
427 $ "takeEQ: Expecting exactly " ++ show cnt
428 ++ " elements, input terminated on " ++ show i
430-- | See 'Streamly.Internal.Data.Parser.takeGE'.
431--
432-- /Pre-release/
433--
434{-# INLINE takeGE #-}
435takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
436takeGE n (Fold fstep finitial fextract) = Parser step initial extract
438 where
440 cnt = max n 0
441 initial = do
442 res <- finitial
443 return $ case res of
444 FL.Partial s -> IPartial $ Tuple' 0 s
445 FL.Done b ->
446 if cnt == 0
447 then IDone b
448 else IError
449 $ "takeGE: Expecting at least " ++ show cnt
450 ++ " elements, fold terminated without"
451 ++ " consuming any elements"
453 step (Tuple' i r) a
454 | i1 < cnt = do
455 res <- fstep r a
456 return
457 $ case res of
458 FL.Partial s -> Continue 0 $ Tuple' i1 s
459 FL.Done _ ->
460 Error
461 $ "takeGE: Expecting at least " ++ show cnt
462 ++ " elements, fold terminated on " ++ show i1
463 | otherwise = do
464 res <- fstep r a
465 return
466 $ case res of
467 FL.Partial s -> Partial 0 $ Tuple' i1 s
468 FL.Done b -> Done 0 b
470 where
472 i1 = i + 1
474 extract (Tuple' i r)
475 | i >= cnt = fextract r
476 | otherwise =
477 throwM
478 $ ParseError
479 $ "takeGE: Expecting at least " ++ show cnt
480 ++ " elements, input terminated on " ++ show i
482-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
483--
484-- /Pre-release/
485--
486{-# INLINE takeWhile #-}
487takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
488takeWhile predicate (Fold fstep finitial fextract) =
489 Parser step initial fextract
491 where
493 initial = do
494 res <- finitial
495 return $ case res of
496 FL.Partial s -> IPartial s
497 FL.Done b -> IDone b
499 step s a =
500 if predicate a
501 then do
502 fres <- fstep s a
503 return
504 $ case fres of
505 FL.Partial s1 -> Partial 0 s1
506 FL.Done b -> Done 0 b
507 else Done 1 <$> fextract s
509-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
510--
511-- /Pre-release/
512--
513{-# INLINE takeWhile1 #-}
514takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
515takeWhile1 predicate (Fold fstep finitial fextract) =
516 Parser step initial extract
518 where
520 initial = do
521 res <- finitial
522 return $ case res of
523 FL.Partial s -> IPartial (Left s)
524 FL.Done _ ->
525 IError
526 $ "takeWhile1: fold terminated without consuming:"
527 ++ " any element"
529 {-# INLINE process #-}
530 process s a = do
531 res <- fstep s a
532 return
533 $ case res of
534 FL.Partial s1 -> Partial 0 (Right s1)
535 FL.Done b -> Done 0 b
537 step (Left s) a =
538 if predicate a
539 then process s a
540 else return $ Error "takeWhile1: predicate failed on first element"
541 step (Right s) a =
542 if predicate a
543 then process s a
544 else do
545 b <- fextract s
546 return $ Done 1 b
548 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
549 extract (Right s) = fextract s
551-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
552--
553-- /Pre-release/
554--
555sliceSepByP :: MonadCatch m =>
556 (a -> Bool) -> Parser m a b -> Parser m a b
557sliceSepByP cond (Parser pstep pinitial pextract) =
559 Parser step initial pextract
561 where
563 initial = pinitial
565 step s a =
566 if cond a
567 then do
568 res <- pextract s
569 return $ Done 0 res
570 else pstep s a
572-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
573--
574-- /Pre-release/
575--
576data SliceBeginWithState s = Left' s | Right' s
578{-# INLINE sliceBeginWith #-}
579sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
580sliceBeginWith cond (Fold fstep finitial fextract) =
582 Parser step initial extract
584 where
586 initial = do
587 res <- finitial
588 return $
589 case res of
590 FL.Partial s -> IPartial (Left' s)
591 FL.Done _ -> IError "sliceBeginWith : bad finitial"
593 {-# INLINE process #-}
594 process s a = do
595 res <- fstep s a
596 return
597 $ case res of
598 FL.Partial s1 -> Partial 0 (Right' s1)
599 FL.Done b -> Done 0 b
601 step (Left' s) a =
602 if cond a
603 then process s a
604 else error $ "sliceBeginWith : slice begins with an element which "
605 ++ "fails the predicate"
606 step (Right' s) a =
607 if not (cond a)
608 then process s a
609 else Done 1 <$> fextract s
611 extract (Left' s) = fextract s
612 extract (Right' s) = fextract s
614data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
616-- | See 'Streamly.Internal.Data.Parser.wordBy'.
617--
618--
619{-# INLINE wordBy #-}
620wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
621wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
623 where
625 {-# INLINE worder #-}
626 worder s a = do
627 res <- fstep s a
628 return
629 $ case res of
630 FL.Partial s1 -> Partial 0 $ WBWord s1
631 FL.Done b -> Done 0 b
633 initial = do
634 res <- finitial
635 return
636 $ case res of
637 FL.Partial s -> IPartial $ WBLeft s
638 FL.Done b -> IDone b
640 step (WBLeft s) a =
641 if not (predicate a)
642 then worder s a
643 else return $ Partial 0 $ WBLeft s
644 step (WBWord s) a =
645 if not (predicate a)
646 then worder s a
647 else do
648 b <- fextract s
649 return $ Partial 0 $ WBRight b
650 step (WBRight b) a =
651 return
652 $ if not (predicate a)
653 then Done 1 b
654 else Partial 0 $ WBRight b
656 extract (WBLeft s) = fextract s
657 extract (WBWord s) = fextract s
658 extract (WBRight b) = return b
660{-# ANN type GroupByState Fuse #-}
661data GroupByState a s
662 = GroupByInit !s
663 | GroupByGrouping !a !s
665-- | See 'Streamly.Internal.Data.Parser.groupBy'.
666--
667{-# INLINE groupBy #-}
668groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
669groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
671 where
673 {-# INLINE grouper #-}
674 grouper s a0 a = do
675 res <- fstep s a
676 return
677 $ case res of
678 FL.Done b -> Done 0 b
679 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
681 initial = do
682 res <- finitial
683 return
684 $ case res of
685 FL.Partial s -> IPartial $ GroupByInit s
686 FL.Done b -> IDone b
688 step (GroupByInit s) a = grouper s a a
689 step (GroupByGrouping a0 s) a =
690 if eq a0 a
691 then grouper s a0 a
692 else Done 1 <$> fextract s
694 extract (GroupByInit s) = fextract s
695 extract (GroupByGrouping _ s) = fextract s
697-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
698--
699{-# INLINE groupByRolling #-}
700groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
701groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
703 where
705 {-# INLINE grouper #-}
706 grouper s a = do
707 res <- fstep s a
708 return
709 $ case res of
710 FL.Done b -> Done 0 b
711 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
713 initial = do
714 res <- finitial
715 return
716 $ case res of
717 FL.Partial s -> IPartial $ GroupByInit s
718 FL.Done b -> IDone b
720 step (GroupByInit s) a = grouper s a
721 step (GroupByGrouping a0 s) a =
722 if eq a0 a
723 then grouper s a
724 else Done 1 <$> fextract s
726 extract (GroupByInit s) = fextract s
727 extract (GroupByGrouping _ s) = fextract s
729-- XXX use an Unfold instead of a list?
730-- XXX custom combinators for matching list, array and stream?
731--
732-- | See 'Streamly.Internal.Data.Parser.eqBy'.
733--
734-- /Pre-release/
735--
736{-# INLINE eqBy #-}
737eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
738eqBy cmp str = Parser step initial extract
740 where
742 initial = return $ IPartial str
744 step [] _ = return $ Done 0 ()
745 step [x] a =
746 return
747 $ if x `cmp` a
748 then Done 0 ()
749 else Error "eqBy: failed, yet to match the last element"
750 step (x:xs) a =
751 return
752 $ if x `cmp` a
753 then Continue 0 xs
754 else Error
755 $ "eqBy: failed, yet to match "
756 ++ show (length xs + 1) ++ " elements"
758 extract xs =
759 throwM
760 $ ParseError
761 $ "eqBy: end of input, yet to match "
762 ++ show (length xs) ++ " elements"
764--------------------------------------------------------------------------------
765--- Spanning
766--------------------------------------------------------------------------------
768-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
769-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
770-- input.
771--
772-- @
773-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
774--
775-- > span_ (< 1) [1,2,3]
776-- ([],[1,2,3])
777--
778-- > span_ (< 2) [1,2,3]
779-- ([1],[2,3])
780--
781-- > span_ (< 4) [1,2,3]
782-- ([1,2,3],[])
783--
784-- @
785--
786-- /Pre-release/
787{-# INLINE span #-}
788span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
789span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
791-- | Break the input stream into two groups, the first group takes the input as
792-- long as the predicate applied to the first element of the stream and next
793-- input element holds 'True', the second group takes the rest of the input.
794--
795-- /Pre-release/
796--
797{-# INLINE spanBy #-}
798spanBy ::
799 Monad m
800 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
801spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
803-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
804-- predicate is applied to the previous and the next input elements.
805--
806-- /Pre-release/
807{-# INLINE spanByRolling #-}
808spanByRolling ::
809 Monad m
810 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
811spanByRolling eq f1 f2 =
812 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
814-------------------------------------------------------------------------------
815-- nested parsers
816-------------------------------------------------------------------------------
818-- | See 'Streamly.Internal.Data.Parser.takeP'.
819--
820-- /Internal/
821{-# INLINE takeP #-}
822takeP :: Monad m => Int -> Parser m a b -> Parser m a b
823takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
825 where
827 initial = do
828 res <- pinitial
829 case res of
830 IPartial s ->
831 if lim > 0
832 then return $ IPartial $ Tuple' 0 s
833 else IDone <$> pextract s
834 IDone b -> return $ IDone b
835 IError e -> return $ IError e
837 step (Tuple' cnt r) a = do
838 assert (cnt < lim) (return ())
839 res <- pstep r a
840 let cnt1 = cnt + 1
841 case res of
842 Partial 0 s -> do
843 assert (cnt1 >= 0) (return ())
844 if cnt1 < lim
845 then return $ Partial 0 $ Tuple' cnt1 s
846 else Done 0 <$> pextract s
847 Continue 0 s -> do
848 assert (cnt1 >= 0) (return ())
849 if cnt1 < lim
850 then return $ Continue 0 $ Tuple' cnt1 s
851 -- XXX This should error out?
852 -- If designed properly, this will probably error out.
853 -- "pextract" should error out
854 --
855 -- By Harendra,
856 --
857 -- This is a tricky case, we have the following options:
858 -- 1. Done 0 with extract as you have written
859 -- 2. Done n, will require buffering elements
860 -- 3. Use a backtracking fold and not a parser, once we have
861 -- backtracking in folds
862 else Done 0 <$> pextract s
863 Partial n s -> do
864 let taken = cnt1 - n
865 assert (taken >= 0) (return ())
866 return $ Partial n $ Tuple' taken s
867 Continue n s -> do
868 let taken = cnt1 - n
869 assert (taken >= 0) (return ())
870 return $ Continue n $ Tuple' taken s
871 Done n b -> return $ Done n b
872 Error str -> return $ Error str
874 extract (Tuple' _ r) = pextract r
876-- | See 'Streamly.Internal.Data.Parser.lookahead'.
877--
878-- /Pre-release/
879--
880{-# INLINE lookAhead #-}
881lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
882lookAhead (Parser step1 initial1 _) = Parser step initial extract
884 where
886 initial = do
887 res <- initial1
888 return $ case res of
889 IPartial s -> IPartial (Tuple' 0 s)
890 IDone b -> IDone b
891 IError e -> IError e
893 step (Tuple' cnt st) a = do
894 r <- step1 st a
895 let cnt1 = cnt + 1
896 return
897 $ case r of
898 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
899 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
900 Done _ b -> Done cnt1 b
901 Error err -> Error err
903 -- XXX returning an error let's us backtrack. To implement it in a way so
904 -- that it terminates on eof without an error then we need a way to
905 -- backtrack on eof, that will require extract to return 'Step' type.
906 extract (Tuple' n _) =
907 throwM
908 $ ParseError
909 $ "lookAhead: end of input after consuming "
910 ++ show n ++ " elements"
912-------------------------------------------------------------------------------
913-- Interleaving
914-------------------------------------------------------------------------------
915--
916-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
917--
918-- /Unimplemented/
919--
920{-# INLINE deintercalate #-}
921deintercalate ::
922 -- Monad m =>
923 Fold m a y -> Parser m x a
924 -> Fold m b z -> Parser m x b
925 -> Parser m x (y, z)
926deintercalate = undefined
928-------------------------------------------------------------------------------
929-- Sequential Collection
930-------------------------------------------------------------------------------
931--
932-- | See 'Streamly.Internal.Data.Parser.sequence'.
933--
934-- /Unimplemented/
935--
936{-# INLINE sequence #-}
937sequence ::
938 -- Foldable t =>
939 Fold m b c -> t (Parser m a b) -> Parser m a c
940sequence _f _p = undefined
942-------------------------------------------------------------------------------
943-- Alternative Collection
944-------------------------------------------------------------------------------
946-- | See 'Streamly.Internal.Data.Parser.choice'.
947--
948-- /Broken/
949--
950{-# INLINE choice #-}
951choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
952choice = foldl1 shortest
954-------------------------------------------------------------------------------
955-- Sequential Repetition
956-------------------------------------------------------------------------------
957--
958-- | See 'Streamly.Internal.Data.Parser.many'.
959--
960-- /Pre-release/
961--
962{-# INLINE many #-}
963many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
964many = splitMany
965-- many = countBetween 0 maxBound
967-- | See 'Streamly.Internal.Data.Parser.some'.
968--
969-- /Pre-release/
970--
971{-# INLINE some #-}
972some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
973some = splitSome
974-- some f p = many (takeGE 1 f) p
975-- many = countBetween 1 maxBound
977-- | See 'Streamly.Internal.Data.Parser.countBetween'.
978--
979-- /Unimplemented/
980--
981{-# INLINE countBetween #-}
982countBetween ::
983 -- MonadCatch m =>
984 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
985countBetween _m _n _p = undefined
986-- countBetween m n p f = many (takeBetween m n f) p
988-- | See 'Streamly.Internal.Data.Parser.count'.
989--
990-- /Unimplemented/
991--
992{-# INLINE count #-}
993count ::
994 -- MonadCatch m =>
995 Int -> Parser m a b -> Fold m b c -> Parser m a c
996count n = countBetween n n
997-- count n f p = many (takeEQ n f) p
999data ManyTillState fs sr sl
1000 = ManyTillR Int fs sr
1001 | ManyTillL Int fs sl
1003-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1005-- /Pre-release/
1007{-# INLINE manyTill #-}
1008manyTill :: MonadCatch m
1009 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1010manyTill (Fold fstep finitial fextract)
1011 (Parser stepL initialL extractL)
1012 (Parser stepR initialR _) =
1013 Parser step initial extract
1015 where
1017 -- Caution: Mutual recursion
1019 -- Don't inline this
1020 scrutL fs p c d e = do
1021 resL <- initialL
1022 case resL of
1023 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1024 IDone bl -> do
1025 fr <- fstep fs bl
1026 case fr of
1027 FL.Partial fs1 -> scrutR fs1 p c d e
1028 FL.Done fb -> return $ d fb
1029 IError err -> return $ e err
1031 {-# INLINE scrutR #-}
1032 scrutR fs p c d e = do
1033 resR <- initialR
1034 case resR of
1035 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1036 IDone _ -> d <$> fextract fs
1037 IError _ -> scrutL fs p c d e
1039 initial = do
1040 res <- finitial
1041 case res of
1042 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1043 FL.Done b -> return $ IDone b
1045 step (ManyTillR cnt fs st) a = do
1046 r <- stepR st a
1047 case r of
1048 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1049 Continue n s -> do
1050 assert (cnt + 1 - n >= 0) (return ())
1051 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1052 Done n _ -> do
1053 b <- fextract fs
1054 return $ Done n b
1055 Error _ -> do
1056 resL <- initialL
1057 case resL of
1058 IPartial sl ->
1059 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1060 IDone bl -> do
1061 fr <- fstep fs bl
1062 let cnt1 = cnt + 1
1063 p = Partial cnt
1064 c = Continue cnt
1065 d = Done cnt
1066 case fr of
1067 FL.Partial fs1 -> scrutR fs1 p c d Error
1068 FL.Done fb -> return $ Done cnt1 fb
1069 IError err -> return $ Error err
1070 -- XXX the cnt is being used only by the assert
1071 step (ManyTillL cnt fs st) a = do
1072 r <- stepL st a
1073 case r of
1074 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1075 Continue n s -> do
1076 assert (cnt + 1 - n >= 0) (return ())
1077 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1078 Done n b -> do
1079 fs1 <- fstep fs b
1080 case fs1 of
1081 FL.Partial s ->
1082 scrutR s (Partial n) (Continue n) (Done n) Error
1083 FL.Done b1 -> return $ Done n b1
1084 Error err -> return $ Error err
1086 extract (ManyTillL _ fs sR) = do
1087 res <- extractL sR >>= fstep fs
1088 case res of
1089 FL.Partial s -> fextract s
1090 FL.Done b -> return b
1091 extract (ManyTillR _ fs _) = fextract fs