git.iko.soy/streamly
on cfcf26d help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
1251 lines 36 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 -- * Downgrade to Fold
22 , toFold
24 -- First order parsers
25 -- * Accumulators
26 , fromFold
27 , fromPure
28 , fromEffect
29 , die
30 , dieM
32 -- * Element parsers
33 , peek
34 , eof
35 , satisfy
36 , next
37 , maybe
38 , either
40 -- * Sequence parsers
41 --
42 -- Parsers chained in series, if one parser terminates the composition
43 -- terminates. Currently we are using folds to collect the output of the
44 -- parsers but we can use Parsers instead of folds to make the composition
45 -- more powerful. For example, we can do:
46 --
47 -- sliceSepByMax cond n p = sliceBy cond (take n p)
48 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
49 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
50 --
51 -- Grab a sequence of input elements without inspecting them
52 , takeBetween
53 -- , take -- take -- takeBetween 0 n
54 -- , takeLE1 -- take1 -- takeBetween 1 n
55 , takeEQ -- takeBetween n n
56 , takeGE -- takeBetween n maxBound
58 -- Grab a sequence of input elements by inspecting them
59 , takeP
60 , lookAhead
61 , takeWhile
62 , takeWhile1
63 , sliceSepByP
64 -- , sliceSepByBetween
65 , sliceBeginWith
66 -- , sliceSepWith
67 --
68 -- , frameSepBy -- parse frames escaped by an escape char/sequence
69 -- , frameEndWith
70 --
71 , wordBy
72 , groupBy
73 , groupByRolling
74 , groupByRollingEither
75 , eqBy
76 -- , prefixOf -- match any prefix of a given string
77 -- , suffixOf -- match any suffix of a given string
78 -- , infixOf -- match any substring of a given string
80 -- ** Spanning
81 , span
82 , spanBy
83 , spanByRolling
85 -- Second order parsers (parsers using parsers)
86 -- * Binary Combinators
88 -- ** Sequential Applicative
89 , serialWith
90 , split_
92 -- ** Parallel Applicatives
93 , teeWith
94 , teeWithFst
95 , teeWithMin
96 -- , teeTill -- like manyTill but parallel
98 -- ** Sequential Interleaving
99 -- Use two folds, run a primary parser, its rejected values go to the
100 -- secondary parser.
101 , deintercalate
103 -- ** Sequential Alternative
104 , alt
106 -- ** Parallel Alternatives
107 , shortest
108 , longest
109 -- , fastest
111 -- * N-ary Combinators
112 -- ** Sequential Collection
113 , sequence
114 , concatMap
116 -- ** Sequential Repetition
117 , count
118 , countBetween
119 -- , countBetweenTill
121 , many
122 , some
123 , manyTill
125 -- -- ** Special cases
126 -- XXX traditional implmentations of these may be of limited use. For
127 -- example, consider parsing lines separated by "\r\n". The main parser
128 -- will have to detect and exclude the sequence "\r\n" anyway so that we
129 -- can apply the "sep" parser.
130 --
131 -- We can instead implement these as special cases of deintercalate.
132 --
133 -- , endBy
134 -- , sepBy
135 -- , sepEndBy
136 -- , beginBy
137 -- , sepBeginBy
138 -- , sepAroundBy
140 -- -- * Distribution
141 --
142 -- A simple and stupid impl would be to just convert the stream to an array
143 -- and give the array reference to all consumers. The array can be grown on
144 -- demand by any consumer and truncated when nonbody needs it.
145 --
146 -- -- ** Distribute to collection
147 -- -- ** Distribute to repetition
149 -- -- ** Interleaved collection
150 -- Round robin
151 -- Priority based
152 -- -- ** Interleaved repetition
153 -- repeat one parser and when it fails run an error recovery parser
154 -- e.g. to find a key frame in the stream after an error
156 -- ** Collection of Alternatives
157 -- , shortestN
158 -- , longestN
159 -- , fastestN -- first N successful in time
160 -- , choiceN -- first N successful in position
161 , choice -- first successful in position
163 -- -- ** Repeated Alternatives
164 -- , retryMax -- try N times
165 -- , retryUntil -- try until successful
166 -- , retryUntilN -- try until successful n times
167 )
168where
170import Control.Exception (assert, Exception)
171import Control.Monad (when)
172import Control.Monad.Catch (MonadCatch, MonadThrow(..))
173import Fusion.Plugin.Types (Fuse(..))
174import Streamly.Internal.Data.Fold.Type (Fold(..))
175import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
177import qualified Streamly.Internal.Data.Fold.Type as FL
179import Prelude hiding
180 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
181import Streamly.Internal.Data.Parser.ParserD.Tee
182import Streamly.Internal.Data.Parser.ParserD.Type
184--
185-- $setup
186-- >>> :m
187-- >>> import Prelude hiding ()
188-- >>> import qualified Streamly.Prelude as Stream
189-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
190-- >>> import qualified Streamly.Data.Fold as Fold
191-- >>> import qualified Streamly.Internal.Data.Parser as Parser
193-------------------------------------------------------------------------------
194-- Downgrade a parser to a Fold
195-------------------------------------------------------------------------------
197data ParserToFoldError =
198 InitialError String
199 | PartialError Int
200 | ContinueError Int
201 | DoneError Int
202 | ErrorError String
203 deriving Show
205instance Exception ParserToFoldError
207-- | See 'Streamly.Internal.Data.Parser.toFold'.
208--
209-- /Internal/
210--
211{-# INLINE toFold #-}
212toFold :: MonadThrow m => Parser m a b -> Fold m a b
213toFold (Parser pstep pinitial pextract) = Fold step initial pextract
215 where
217 initial = do
218 r <- pinitial
219 case r of
220 IPartial s -> return $ FL.Partial s
221 IDone b -> return $ FL.Done b
222 IError err -> throwM $ InitialError err
224 step st a = do
225 r <- pstep st a
226 case r of
227 Partial 0 s -> return $ FL.Partial s
228 Continue 0 s -> return $ FL.Partial s
229 Done 0 b -> return $ FL.Done b
230 Partial n _ -> throwM $ PartialError n
231 Continue n _ -> throwM $ ContinueError n
232 Done n _ -> throwM $ DoneError n
233 Error err -> throwM $ ErrorError err
235-------------------------------------------------------------------------------
236-- Upgrade folds to parses
237-------------------------------------------------------------------------------
238--
239-- | See 'Streamly.Internal.Data.Parser.fromFold'.
240--
241-- /Pre-release/
242--
243{-# INLINE fromFold #-}
244fromFold :: Monad m => Fold m a b -> Parser m a b
245fromFold (Fold fstep finitial fextract) = Parser step initial fextract
247 where
249 initial = do
250 res <- finitial
251 return
252 $ case res of
253 FL.Partial s1 -> IPartial s1
254 FL.Done b -> IDone b
256 step s a = do
257 res <- fstep s a
258 return
259 $ case res of
260 FL.Partial s1 -> Partial 0 s1
261 FL.Done b -> Done 0 b
263-------------------------------------------------------------------------------
264-- Failing Parsers
265-------------------------------------------------------------------------------
267-- | See 'Streamly.Internal.Data.Parser.peek'.
268--
269-- /Pre-release/
270--
271{-# INLINABLE peek #-}
272peek :: MonadThrow m => Parser m a a
273peek = Parser step initial extract
275 where
277 initial = return $ IPartial ()
279 step () a = return $ Done 1 a
281 extract () = throwM $ ParseError "peek: end of input"
283-- | See 'Streamly.Internal.Data.Parser.eof'.
284--
285-- /Pre-release/
286--
287{-# INLINABLE eof #-}
288eof :: Monad m => Parser m a ()
289eof = Parser step initial return
291 where
293 initial = return $ IPartial ()
295 step () _ = return $ Error "eof: not at end of input"
297-- | See 'Streamly.Internal.Data.Parser.satisfy'.
298--
299-- /Pre-release/
300--
301{-# INLINE satisfy #-}
302satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
303satisfy predicate = Parser step initial extract
305 where
307 initial = return $ IPartial ()
309 step () a = return $
310 if predicate a
311 then Done 0 a
312 else Error "satisfy: predicate failed"
314 extract _ = throwM $ ParseError "satisfy: end of input"
316-- | See 'Streamly.Internal.Data.Parser.next'.
317--
318-- /Pre-release/
319--
320{-# INLINE next #-}
321next :: Monad m => Parser m a (Maybe a)
322next = Parser step initial extract
323 where
324 initial = pure $ IPartial ()
325 step _ a = pure $ Done 0 (Just a)
326 extract _ = pure Nothing
328-- | See 'Streamly.Internal.Data.Parser.maybe'.
329--
330-- /Pre-release/
331--
332{-# INLINE maybe #-}
333maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
334maybe parser = Parser step initial extract
336 where
338 initial = return $ IPartial ()
340 step () a = return $
341 case parser a of
342 Just b -> Done 0 b
343 Nothing -> Error "maybe: predicate failed"
345 extract _ = throwM $ ParseError "maybe: end of input"
347-- | See 'Streamly.Internal.Data.Parser.either'.
348--
349-- /Pre-release/
350--
351{-# INLINE either #-}
352either :: MonadThrow m => (a -> Either String b) -> Parser m a b
353either parser = Parser step initial extract
355 where
357 initial = return $ IPartial ()
359 step () a = return $
360 case parser a of
361 Right b -> Done 0 b
362 Left err -> Error $ "either: " ++ err
364 extract _ = throwM $ ParseError "either: end of input"
366-------------------------------------------------------------------------------
367-- Taking elements
368-------------------------------------------------------------------------------
370-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
371{-# ANN type Tuple'Fused Fuse #-}
372data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
374-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
375--
376-- /Pre-release/
377--
378{-# INLINE takeBetween #-}
379takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
380takeBetween low high (Fold fstep finitial fextract) =
382 Parser step initial (extract streamErr)
384 where
386 streamErr i =
387 "takeBetween: Expecting alteast " ++ show low
388 ++ " elements, got " ++ show i
390 invalidRange =
391 "takeBetween: lower bound - " ++ show low
392 ++ " is greater than higher bound - " ++ show high
394 foldErr :: Int -> String
395 foldErr i =
396 "takeBetween: the collecting fold terminated after"
397 ++ " consuming" ++ show i ++ " elements"
398 ++ " minimum" ++ show low ++ " elements needed"
400 -- Exactly the same as snext except different constructors, we can possibly
401 -- deduplicate the two.
402 {-# INLINE inext #-}
403 inext i res =
404 let i1 = i + 1
405 in case res of
406 FL.Partial s -> do
407 let s1 = Tuple'Fused i1 s
408 if i1 < high
409 -- XXX ideally this should be a Continue instead
410 then return $ IPartial s1
411 else IDone <$> extract foldErr s1
412 FL.Done b ->
413 return
414 $ if i1 >= low
415 then IDone b
416 else IError (foldErr i1)
418 initial = do
419 when (low >= 0 && high >= 0 && low > high)
420 $ throwM $ ParseError invalidRange
422 finitial >>= inext (-1)
424 -- Keep the impl same as inext
425 {-# INLINE snext #-}
426 snext i res =
427 let i1 = i + 1
428 in case res of
429 FL.Partial s -> do
430 let s1 = Tuple'Fused i1 s
431 if i1 < high
432 then return $ Continue 0 s1
433 else Done 0 <$> extract foldErr s1
434 FL.Done b ->
435 return
436 $ if i1 >= low
437 then Done 0 b
438 else Error (foldErr i1)
440 step (Tuple'Fused i s) a = fstep s a >>= snext i
442 extract f (Tuple'Fused i s)
443 | i >= low && i <= high = fextract s
444 | otherwise = throwM $ ParseError (f i)
446-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
447--
448-- /Pre-release/
449--
450{-# INLINE takeEQ #-}
451takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
452takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
454 where
456 cnt = max n 0
458 initial = do
459 res <- finitial
460 return $ case res of
461 FL.Partial s -> IPartial $ Tuple' 0 s
462 FL.Done b ->
463 if cnt == 0
464 then IDone b
465 else IError
466 $ "takeEQ: Expecting exactly " ++ show cnt
467 ++ " elements, fold terminated without"
468 ++ " consuming any elements"
470 step (Tuple' i r) a
471 | i1 < cnt = do
472 res <- fstep r a
473 return
474 $ case res of
475 FL.Partial s -> Continue 0 $ Tuple' i1 s
476 FL.Done _ ->
477 Error
478 $ "takeEQ: Expecting exactly " ++ show cnt
479 ++ " elements, fold terminated on " ++ show i1
480 | i1 == cnt = do
481 res <- fstep r a
482 Done 0
483 <$> case res of
484 FL.Partial s -> fextract s
485 FL.Done b -> return b
486 -- XXX we should not reach here when initial returns Step type
487 -- reachable only when n == 0
488 | otherwise = Done 1 <$> fextract r
490 where
492 i1 = i + 1
494 extract (Tuple' i r)
495 | i == 0 && cnt == 0 = fextract r
496 | otherwise =
497 throwM
498 $ ParseError
499 $ "takeEQ: Expecting exactly " ++ show cnt
500 ++ " elements, input terminated on " ++ show i
502-- | See 'Streamly.Internal.Data.Parser.takeGE'.
503--
504-- /Pre-release/
505--
506{-# INLINE takeGE #-}
507takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
508takeGE n (Fold fstep finitial fextract) = Parser step initial extract
510 where
512 cnt = max n 0
513 initial = do
514 res <- finitial
515 return $ case res of
516 FL.Partial s -> IPartial $ Tuple' 0 s
517 FL.Done b ->
518 if cnt == 0
519 then IDone b
520 else IError
521 $ "takeGE: Expecting at least " ++ show cnt
522 ++ " elements, fold terminated without"
523 ++ " consuming any elements"
525 step (Tuple' i r) a
526 | i1 < cnt = do
527 res <- fstep r a
528 return
529 $ case res of
530 FL.Partial s -> Continue 0 $ Tuple' i1 s
531 FL.Done _ ->
532 Error
533 $ "takeGE: Expecting at least " ++ show cnt
534 ++ " elements, fold terminated on " ++ show i1
535 | otherwise = do
536 res <- fstep r a
537 return
538 $ case res of
539 FL.Partial s -> Partial 0 $ Tuple' i1 s
540 FL.Done b -> Done 0 b
542 where
544 i1 = i + 1
546 extract (Tuple' i r)
547 | i >= cnt = fextract r
548 | otherwise =
549 throwM
550 $ ParseError
551 $ "takeGE: Expecting at least " ++ show cnt
552 ++ " elements, input terminated on " ++ show i
554-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
555--
556-- /Pre-release/
557--
558{-# INLINE takeWhile #-}
559takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
560takeWhile predicate (Fold fstep finitial fextract) =
561 Parser step initial fextract
563 where
565 initial = do
566 res <- finitial
567 return $ case res of
568 FL.Partial s -> IPartial s
569 FL.Done b -> IDone b
571 step s a =
572 if predicate a
573 then do
574 fres <- fstep s a
575 return
576 $ case fres of
577 FL.Partial s1 -> Partial 0 s1
578 FL.Done b -> Done 0 b
579 else Done 1 <$> fextract s
581-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
582--
583-- /Pre-release/
584--
585{-# INLINE takeWhile1 #-}
586takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
587takeWhile1 predicate (Fold fstep finitial fextract) =
588 Parser step initial extract
590 where
592 initial = do
593 res <- finitial
594 return $ case res of
595 FL.Partial s -> IPartial (Left s)
596 FL.Done _ ->
597 IError
598 $ "takeWhile1: fold terminated without consuming:"
599 ++ " any element"
601 {-# INLINE process #-}
602 process s a = do
603 res <- fstep s a
604 return
605 $ case res of
606 FL.Partial s1 -> Partial 0 (Right s1)
607 FL.Done b -> Done 0 b
609 step (Left s) a =
610 if predicate a
611 then process s a
612 else return $ Error "takeWhile1: predicate failed on first element"
613 step (Right s) a =
614 if predicate a
615 then process s a
616 else do
617 b <- fextract s
618 return $ Done 1 b
620 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
621 extract (Right s) = fextract s
623-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
624--
625-- /Pre-release/
626--
627sliceSepByP :: MonadCatch m =>
628 (a -> Bool) -> Parser m a b -> Parser m a b
629sliceSepByP cond (Parser pstep pinitial pextract) =
631 Parser step initial pextract
633 where
635 initial = pinitial
637 step s a =
638 if cond a
639 then do
640 res <- pextract s
641 return $ Done 0 res
642 else pstep s a
644-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
645--
646-- /Pre-release/
647--
648data SliceBeginWithState s = Left' s | Right' s
650{-# INLINE sliceBeginWith #-}
651sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
652sliceBeginWith cond (Fold fstep finitial fextract) =
654 Parser step initial extract
656 where
658 initial = do
659 res <- finitial
660 return $
661 case res of
662 FL.Partial s -> IPartial (Left' s)
663 FL.Done _ -> IError "sliceBeginWith : bad finitial"
665 {-# INLINE process #-}
666 process s a = do
667 res <- fstep s a
668 return
669 $ case res of
670 FL.Partial s1 -> Partial 0 (Right' s1)
671 FL.Done b -> Done 0 b
673 step (Left' s) a =
674 if cond a
675 then process s a
676 else error $ "sliceBeginWith : slice begins with an element which "
677 ++ "fails the predicate"
678 step (Right' s) a =
679 if not (cond a)
680 then process s a
681 else Done 1 <$> fextract s
683 extract (Left' s) = fextract s
684 extract (Right' s) = fextract s
686data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
688-- | See 'Streamly.Internal.Data.Parser.wordBy'.
689--
690--
691{-# INLINE wordBy #-}
692wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
693wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
695 where
697 {-# INLINE worder #-}
698 worder s a = do
699 res <- fstep s a
700 return
701 $ case res of
702 FL.Partial s1 -> Partial 0 $ WBWord s1
703 FL.Done b -> Done 0 b
705 initial = do
706 res <- finitial
707 return
708 $ case res of
709 FL.Partial s -> IPartial $ WBLeft s
710 FL.Done b -> IDone b
712 step (WBLeft s) a =
713 if not (predicate a)
714 then worder s a
715 else return $ Partial 0 $ WBLeft s
716 step (WBWord s) a =
717 if not (predicate a)
718 then worder s a
719 else do
720 b <- fextract s
721 return $ Partial 0 $ WBRight b
722 step (WBRight b) a =
723 return
724 $ if not (predicate a)
725 then Done 1 b
726 else Partial 0 $ WBRight b
728 extract (WBLeft s) = fextract s
729 extract (WBWord s) = fextract s
730 extract (WBRight b) = return b
732{-# ANN type GroupByState Fuse #-}
733data GroupByState a s
734 = GroupByInit !s
735 | GroupByGrouping !a !s
737-- | See 'Streamly.Internal.Data.Parser.groupBy'.
738--
739{-# INLINE groupBy #-}
740groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
741groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
743 where
745 {-# INLINE grouper #-}
746 grouper s a0 a = do
747 res <- fstep s a
748 return
749 $ case res of
750 FL.Done b -> Done 0 b
751 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
753 initial = do
754 res <- finitial
755 return
756 $ case res of
757 FL.Partial s -> IPartial $ GroupByInit s
758 FL.Done b -> IDone b
760 step (GroupByInit s) a = grouper s a a
761 step (GroupByGrouping a0 s) a =
762 if eq a0 a
763 then grouper s a0 a
764 else Done 1 <$> fextract s
766 extract (GroupByInit s) = fextract s
767 extract (GroupByGrouping _ s) = fextract s
769-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
770--
771{-# INLINE groupByRolling #-}
772groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
773groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
775 where
777 {-# INLINE grouper #-}
778 grouper s a = do
779 res <- fstep s a
780 return
781 $ case res of
782 FL.Done b -> Done 0 b
783 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
785 initial = do
786 res <- finitial
787 return
788 $ case res of
789 FL.Partial s -> IPartial $ GroupByInit s
790 FL.Done b -> IDone b
792 step (GroupByInit s) a = grouper s a
793 step (GroupByGrouping a0 s) a =
794 if eq a0 a
795 then grouper s a
796 else Done 1 <$> fextract s
798 extract (GroupByInit s) = fextract s
799 extract (GroupByGrouping _ s) = fextract s
801{-# ANN type GroupByStatePair Fuse #-}
802data GroupByStatePair a s1 s2
803 = GroupByInitPair !s1 !s2
804 | GroupByGroupingPair !a !s1 !s2
805 | GroupByGroupingPairL !a !s1 !s2
806 | GroupByGroupingPairR !a !s1 !s2
808{-# INLINABLE groupByRollingEither #-}
809groupByRollingEither :: MonadCatch m =>
810 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
811groupByRollingEither
812 eq
813 (Fold fstep1 finitial1 fextract1)
814 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
816 where
818 {-# INLINE grouper #-}
819 grouper s1 s2 a = do
820 return $ Continue 0 (GroupByGroupingPair a s1 s2)
822 {-# INLINE grouperL2 #-}
823 grouperL2 s1 s2 a = do
824 res <- fstep1 s1 a
825 return
826 $ case res of
827 FL.Done b -> Done 0 (Left b)
828 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
830 {-# INLINE grouperL #-}
831 grouperL s1 s2 a0 a = do
832 res <- fstep1 s1 a0
833 case res of
834 FL.Done b -> return $ Done 0 (Left b)
835 FL.Partial s11 -> grouperL2 s11 s2 a
837 {-# INLINE grouperR2 #-}
838 grouperR2 s1 s2 a = do
839 res <- fstep2 s2 a
840 return
841 $ case res of
842 FL.Done b -> Done 0 (Right b)
843 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
845 {-# INLINE grouperR #-}
846 grouperR s1 s2 a0 a = do
847 res <- fstep2 s2 a0
848 case res of
849 FL.Done b -> return $ Done 0 (Right b)
850 FL.Partial s21 -> grouperR2 s1 s21 a
852 initial = do
853 res1 <- finitial1
854 res2 <- finitial2
855 return
856 $ case res1 of
857 FL.Partial s1 ->
858 case res2 of
859 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
860 FL.Done b -> IDone (Right b)
861 FL.Done b -> IDone (Left b)
863 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
865 step (GroupByGroupingPair a0 s1 s2) a =
866 if not (eq a0 a)
867 then grouperL s1 s2 a0 a
868 else grouperR s1 s2 a0 a
870 step (GroupByGroupingPairL a0 s1 s2) a =
871 if not (eq a0 a)
872 then grouperL2 s1 s2 a
873 else Done 1 . Left <$> fextract1 s1
875 step (GroupByGroupingPairR a0 s1 s2) a =
876 if eq a0 a
877 then grouperR2 s1 s2 a
878 else Done 1 . Right <$> fextract2 s2
880 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
881 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
882 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
883 extract (GroupByGroupingPair a s1 _) = do
884 res <- fstep1 s1 a
885 case res of
886 FL.Done b -> return $ Left b
887 FL.Partial s11 -> Left <$> fextract1 s11
889-- XXX use an Unfold instead of a list?
890-- XXX custom combinators for matching list, array and stream?
891--
892-- | See 'Streamly.Internal.Data.Parser.eqBy'.
893--
894-- /Pre-release/
895--
896{-# INLINE eqBy #-}
897eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
898eqBy cmp str = Parser step initial extract
900 where
902 initial = return $ IPartial str
904 step [] _ = return $ Done 0 ()
905 step [x] a =
906 return
907 $ if x `cmp` a
908 then Done 0 ()
909 else Error "eqBy: failed, yet to match the last element"
910 step (x:xs) a =
911 return
912 $ if x `cmp` a
913 then Continue 0 xs
914 else Error
915 $ "eqBy: failed, yet to match "
916 ++ show (length xs + 1) ++ " elements"
918 extract xs =
919 throwM
920 $ ParseError
921 $ "eqBy: end of input, yet to match "
922 ++ show (length xs) ++ " elements"
924--------------------------------------------------------------------------------
925--- Spanning
926--------------------------------------------------------------------------------
928-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
929-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
930-- input.
931--
932-- @
933-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
934--
935-- > span_ (< 1) [1,2,3]
936-- ([],[1,2,3])
937--
938-- > span_ (< 2) [1,2,3]
939-- ([1],[2,3])
940--
941-- > span_ (< 4) [1,2,3]
942-- ([1,2,3],[])
943--
944-- @
945--
946-- /Pre-release/
947{-# INLINE span #-}
948span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
949span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
951-- | Break the input stream into two groups, the first group takes the input as
952-- long as the predicate applied to the first element of the stream and next
953-- input element holds 'True', the second group takes the rest of the input.
954--
955-- /Pre-release/
956--
957{-# INLINE spanBy #-}
958spanBy ::
959 Monad m
960 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
961spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
963-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
964-- predicate is applied to the previous and the next input elements.
965--
966-- /Pre-release/
967{-# INLINE spanByRolling #-}
968spanByRolling ::
969 Monad m
970 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
971spanByRolling eq f1 f2 =
972 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
974-------------------------------------------------------------------------------
975-- nested parsers
976-------------------------------------------------------------------------------
978-- | See 'Streamly.Internal.Data.Parser.takeP'.
979--
980-- /Internal/
981{-# INLINE takeP #-}
982takeP :: Monad m => Int -> Parser m a b -> Parser m a b
983takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
985 where
987 initial = do
988 res <- pinitial
989 case res of
990 IPartial s ->
991 if lim > 0
992 then return $ IPartial $ Tuple' 0 s
993 else IDone <$> pextract s
994 IDone b -> return $ IDone b
995 IError e -> return $ IError e
997 step (Tuple' cnt r) a = do
998 assert (cnt < lim) (return ())
999 res <- pstep r a
1000 let cnt1 = cnt + 1
1001 case res of
1002 Partial 0 s -> do
1003 assert (cnt1 >= 0) (return ())
1004 if cnt1 < lim
1005 then return $ Partial 0 $ Tuple' cnt1 s
1006 else Done 0 <$> pextract s
1007 Continue 0 s -> do
1008 assert (cnt1 >= 0) (return ())
1009 if cnt1 < lim
1010 then return $ Continue 0 $ Tuple' cnt1 s
1011 -- XXX This should error out?
1012 -- If designed properly, this will probably error out.
1013 -- "pextract" should error out
1014 --
1015 -- By Harendra,
1016 --
1017 -- This is a tricky case, we have the following options:
1018 -- 1. Done 0 with extract as you have written
1019 -- 2. Done n, will require buffering elements
1020 -- 3. Use a backtracking fold and not a parser, once we have
1021 -- backtracking in folds
1022 else Done 0 <$> pextract s
1023 Partial n s -> do
1024 let taken = cnt1 - n
1025 assert (taken >= 0) (return ())
1026 return $ Partial n $ Tuple' taken s
1027 Continue n s -> do
1028 let taken = cnt1 - n
1029 assert (taken >= 0) (return ())
1030 return $ Continue n $ Tuple' taken s
1031 Done n b -> return $ Done n b
1032 Error str -> return $ Error str
1034 extract (Tuple' _ r) = pextract r
1036-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1038-- /Pre-release/
1040{-# INLINE lookAhead #-}
1041lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1042lookAhead (Parser step1 initial1 _) = Parser step initial extract
1044 where
1046 initial = do
1047 res <- initial1
1048 return $ case res of
1049 IPartial s -> IPartial (Tuple' 0 s)
1050 IDone b -> IDone b
1051 IError e -> IError e
1053 step (Tuple' cnt st) a = do
1054 r <- step1 st a
1055 let cnt1 = cnt + 1
1056 return
1057 $ case r of
1058 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1059 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1060 Done _ b -> Done cnt1 b
1061 Error err -> Error err
1063 -- XXX returning an error let's us backtrack. To implement it in a way so
1064 -- that it terminates on eof without an error then we need a way to
1065 -- backtrack on eof, that will require extract to return 'Step' type.
1066 extract (Tuple' n _) =
1067 throwM
1068 $ ParseError
1069 $ "lookAhead: end of input after consuming "
1070 ++ show n ++ " elements"
1072-------------------------------------------------------------------------------
1073-- Interleaving
1074-------------------------------------------------------------------------------
1076-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1078-- /Unimplemented/
1080{-# INLINE deintercalate #-}
1081deintercalate ::
1082 -- Monad m =>
1083 Fold m a y -> Parser m x a
1084 -> Fold m b z -> Parser m x b
1085 -> Parser m x (y, z)
1086deintercalate = undefined
1088-------------------------------------------------------------------------------
1089-- Sequential Collection
1090-------------------------------------------------------------------------------
1092-- | See 'Streamly.Internal.Data.Parser.sequence'.
1094-- /Unimplemented/
1096{-# INLINE sequence #-}
1097sequence ::
1098 -- Foldable t =>
1099 Fold m b c -> t (Parser m a b) -> Parser m a c
1100sequence _f _p = undefined
1102-------------------------------------------------------------------------------
1103-- Alternative Collection
1104-------------------------------------------------------------------------------
1106-- | See 'Streamly.Internal.Data.Parser.choice'.
1108-- /Broken/
1110{-# INLINE choice #-}
1111choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
1112choice = foldl1 shortest
1114-------------------------------------------------------------------------------
1115-- Sequential Repetition
1116-------------------------------------------------------------------------------
1118-- | See 'Streamly.Internal.Data.Parser.many'.
1120-- /Pre-release/
1122{-# INLINE many #-}
1123many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1124many = splitMany
1125-- many = countBetween 0 maxBound
1127-- | See 'Streamly.Internal.Data.Parser.some'.
1129-- /Pre-release/
1131{-# INLINE some #-}
1132some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1133some = splitSome
1134-- some f p = many (takeGE 1 f) p
1135-- many = countBetween 1 maxBound
1137-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1139-- /Unimplemented/
1141{-# INLINE countBetween #-}
1142countBetween ::
1143 -- MonadCatch m =>
1144 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1145countBetween _m _n _p = undefined
1146-- countBetween m n p f = many (takeBetween m n f) p
1148-- | See 'Streamly.Internal.Data.Parser.count'.
1150-- /Unimplemented/
1152{-# INLINE count #-}
1153count ::
1154 -- MonadCatch m =>
1155 Int -> Parser m a b -> Fold m b c -> Parser m a c
1156count n = countBetween n n
1157-- count n f p = many (takeEQ n f) p
1159data ManyTillState fs sr sl
1160 = ManyTillR Int fs sr
1161 | ManyTillL Int fs sl
1163-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1165-- /Pre-release/
1167{-# INLINE manyTill #-}
1168manyTill :: MonadCatch m
1169 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1170manyTill (Fold fstep finitial fextract)
1171 (Parser stepL initialL extractL)
1172 (Parser stepR initialR _) =
1173 Parser step initial extract
1175 where
1177 -- Caution: Mutual recursion
1179 -- Don't inline this
1180 scrutL fs p c d e = do
1181 resL <- initialL
1182 case resL of
1183 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1184 IDone bl -> do
1185 fr <- fstep fs bl
1186 case fr of
1187 FL.Partial fs1 -> scrutR fs1 p c d e
1188 FL.Done fb -> return $ d fb
1189 IError err -> return $ e err
1191 {-# INLINE scrutR #-}
1192 scrutR fs p c d e = do
1193 resR <- initialR
1194 case resR of
1195 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1196 IDone _ -> d <$> fextract fs
1197 IError _ -> scrutL fs p c d e
1199 initial = do
1200 res <- finitial
1201 case res of
1202 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1203 FL.Done b -> return $ IDone b
1205 step (ManyTillR cnt fs st) a = do
1206 r <- stepR st a
1207 case r of
1208 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1209 Continue n s -> do
1210 assert (cnt + 1 - n >= 0) (return ())
1211 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1212 Done n _ -> do
1213 b <- fextract fs
1214 return $ Done n b
1215 Error _ -> do
1216 resL <- initialL
1217 case resL of
1218 IPartial sl ->
1219 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1220 IDone bl -> do
1221 fr <- fstep fs bl
1222 let cnt1 = cnt + 1
1223 p = Partial cnt
1224 c = Continue cnt
1225 d = Done cnt
1226 case fr of
1227 FL.Partial fs1 -> scrutR fs1 p c d Error
1228 FL.Done fb -> return $ Done cnt1 fb
1229 IError err -> return $ Error err
1230 -- XXX the cnt is being used only by the assert
1231 step (ManyTillL cnt fs st) a = do
1232 r <- stepL st a
1233 case r of
1234 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1235 Continue n s -> do
1236 assert (cnt + 1 - n >= 0) (return ())
1237 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1238 Done n b -> do
1239 fs1 <- fstep fs b
1240 case fs1 of
1241 FL.Partial s ->
1242 scrutR s (Partial n) (Continue n) (Done n) Error
1243 FL.Done b1 -> return $ Done n b1
1244 Error err -> return $ Error err
1246 extract (ManyTillL _ fs sR) = do
1247 res <- extractL sR >>= fstep fs
1248 case res of
1249 FL.Partial s -> fextract s
1250 FL.Done b -> return b
1251 extract (ManyTillR _ fs _) = fextract fs