git.iko.soy/streamly
on d08d73a help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
1422 lines 42 kB history raw
1#include "inline.hs"
3-- |
4-- Module : Streamly.Internal.Data.Parser.ParserD
5-- Copyright : (c) 2020 Composewell Technologies
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
10--
11-- Direct style parser implementation with stream fusion.
13module Streamly.Internal.Data.Parser.ParserD
14 (
15 Parser (..)
16 , ParseError (..)
17 , Step (..)
18 , Initial (..)
19 , rmapM
21 -- * Conversion to/from ParserK
22 , fromParserK
23 , toParserK
25 -- * Downgrade to Fold
26 , toFold
28 -- First order parsers
29 -- * Accumulators
30 , fromFold
31 , fromPure
32 , fromEffect
33 , die
34 , dieM
36 -- * Map on input
37 , lmap
38 , lmapM
39 , filter
41 -- * Element parsers
42 , peek
43 , eof
44 , satisfy
45 , next
46 , maybe
47 , either
49 -- * Sequence parsers
50 --
51 -- Parsers chained in series, if one parser terminates the composition
52 -- terminates. Currently we are using folds to collect the output of the
53 -- parsers but we can use Parsers instead of folds to make the composition
54 -- more powerful. For example, we can do:
55 --
56 -- sliceSepByMax cond n p = sliceBy cond (take n p)
57 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
58 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
60 -- Grab a sequence of input elements without inspecting them
61 , takeBetween
62 -- , take -- take -- takeBetween 0 n
63 -- , takeLE1 -- take1 -- takeBetween 1 n
64 , takeEQ -- takeBetween n n
65 , takeGE -- takeBetween n maxBound
66 , takeP
68 -- Grab a sequence of input elements by inspecting them
69 , lookAhead
70 , takeWhile
71 , takeWhile1
73 -- Separators
74 , sliceSepByP
75 -- , sliceSepByBetween
76 , sliceBeginWith
77 -- , sliceSepWith
79 -- Words and grouping
80 , wordBy
81 , groupBy
82 , groupByRolling
83 , groupByRollingEither
85 -- Matching strings
86 , eqBy
87 , matchBy
88 -- , prefixOf -- match any prefix of a given string
89 -- , suffixOf -- match any suffix of a given string
90 -- , infixOf -- match any substring of a given string
92 -- ** Spanning
93 , span
94 , spanBy
95 , spanByRolling
97 -- Second order parsers (parsers using parsers)
98 -- * Binary Combinators
100 -- ** Sequential Applicative
101 , serialWith
102 , split_
104 -- ** Parallel Applicatives
105 , teeWith
106 , teeWithFst
107 , teeWithMin
108 -- , teeTill -- like manyTill but parallel
110 -- ** Sequential Interleaving
111 -- Use two folds, run a primary parser, its rejected values go to the
112 -- secondary parser.
113 , deintercalate
115 -- ** Sequential Alternative
116 , alt
118 -- ** Parallel Alternatives
119 , shortest
120 , longest
121 -- , fastest
123 -- * N-ary Combinators
124 -- ** Sequential Collection
125 , sequence
126 , concatMap
128 -- ** Sequential Repetition
129 , count
130 , countBetween
131 -- , countBetweenTill
133 , many
134 , some
135 , manyTill
137 -- -- ** Special cases
138 -- XXX traditional implmentations of these may be of limited use. For
139 -- example, consider parsing lines separated by "\r\n". The main parser
140 -- will have to detect and exclude the sequence "\r\n" anyway so that we
141 -- can apply the "sep" parser.
142 --
143 -- We can instead implement these as special cases of deintercalate.
144 --
145 -- , endBy
146 -- , sepBy
147 -- , sepEndBy
148 -- , beginBy
149 -- , sepBeginBy
150 -- , sepAroundBy
152 -- -- * Distribution
153 --
154 -- A simple and stupid impl would be to just convert the stream to an array
155 -- and give the array reference to all consumers. The array can be grown on
156 -- demand by any consumer and truncated when nonbody needs it.
157 --
158 -- -- ** Distribute to collection
159 -- -- ** Distribute to repetition
161 -- -- ** Interleaved collection
162 -- Round robin
163 -- Priority based
164 -- -- ** Interleaved repetition
165 -- repeat one parser and when it fails run an error recovery parser
166 -- e.g. to find a key frame in the stream after an error
168 -- ** Collection of Alternatives
169 -- , shortestN
170 -- , longestN
171 -- , fastestN -- first N successful in time
172 -- , choiceN -- first N successful in position
173 , choice -- first successful in position
175 -- -- ** Repeated Alternatives
176 -- , retryMax -- try N times
177 -- , retryUntil -- try until successful
178 -- , retryUntilN -- try until successful n times
180 -- ** Zipping Input
181 , zipWithM
182 , zip
183 , indexed
184 , makeIndexFilter
185 , sampleFromthen
186 )
187where
189import Control.Exception (assert, Exception)
190import Control.Monad (when)
191import Control.Monad.Catch (MonadCatch, MonadThrow(..))
192import Fusion.Plugin.Types (Fuse(..))
193import Streamly.Internal.Data.Fold.Type (Fold(..))
194import Streamly.Internal.Data.SVar.Type (defState)
195import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
197import qualified Streamly.Internal.Data.Fold.Type as FL
198import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
199import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
201import Prelude hiding
202 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
203 , zip, filter)
204import Streamly.Internal.Data.Parser.ParserD.Tee
205import Streamly.Internal.Data.Parser.ParserD.Type
207--
208-- $setup
209-- >>> :m
210-- >>> :set -package streamly
211-- >>> import Prelude hiding ()
212-- >>> import qualified Streamly.Prelude as Stream
213-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
214-- >>> import qualified Streamly.Data.Fold as Fold
215-- >>> import qualified Streamly.Internal.Data.Parser as Parser
217-------------------------------------------------------------------------------
218-- Downgrade a parser to a Fold
219-------------------------------------------------------------------------------
221data ParserToFoldError =
222 InitialError String
223 | PartialError Int
224 | ContinueError Int
225 | DoneError Int
226 | ErrorError String
227 deriving Show
229instance Exception ParserToFoldError
231-- | See 'Streamly.Internal.Data.Parser.toFold'.
232--
233-- /Internal/
234--
235{-# INLINE toFold #-}
236toFold :: MonadThrow m => Parser m a b -> Fold m a b
237toFold (Parser pstep pinitial pextract) = Fold step initial pextract
239 where
241 initial = do
242 r <- pinitial
243 case r of
244 IPartial s -> return $ FL.Partial s
245 IDone b -> return $ FL.Done b
246 IError err -> throwM $ InitialError err
248 step st a = do
249 r <- pstep st a
250 case r of
251 Partial 0 s -> return $ FL.Partial s
252 Continue 0 s -> return $ FL.Partial s
253 Done 0 b -> return $ FL.Done b
254 Partial n _ -> throwM $ PartialError n
255 Continue n _ -> throwM $ ContinueError n
256 Done n _ -> throwM $ DoneError n
257 Error err -> throwM $ ErrorError err
259-------------------------------------------------------------------------------
260-- Upgrade folds to parses
261-------------------------------------------------------------------------------
262--
263-- | See 'Streamly.Internal.Data.Parser.fromFold'.
264--
265-- /Pre-release/
266--
267{-# INLINE fromFold #-}
268fromFold :: Monad m => Fold m a b -> Parser m a b
269fromFold (Fold fstep finitial fextract) = Parser step initial fextract
271 where
273 initial = do
274 res <- finitial
275 return
276 $ case res of
277 FL.Partial s1 -> IPartial s1
278 FL.Done b -> IDone b
280 step s a = do
281 res <- fstep s a
282 return
283 $ case res of
284 FL.Partial s1 -> Partial 0 s1
285 FL.Done b -> Done 0 b
287-------------------------------------------------------------------------------
288-- Failing Parsers
289-------------------------------------------------------------------------------
291-- | See 'Streamly.Internal.Data.Parser.peek'.
292--
293-- /Pre-release/
294--
295{-# INLINE peek #-}
296peek :: MonadThrow m => Parser m a a
297peek = Parser step initial extract
299 where
301 initial = return $ IPartial ()
303 step () a = return $ Done 1 a
305 extract () = throwM $ ParseError "peek: end of input"
307-- | See 'Streamly.Internal.Data.Parser.eof'.
308--
309-- /Pre-release/
310--
311{-# INLINE eof #-}
312eof :: Monad m => Parser m a ()
313eof = Parser step initial return
315 where
317 initial = return $ IPartial ()
319 step () _ = return $ Error "eof: not at end of input"
321-- | See 'Streamly.Internal.Data.Parser.satisfy'.
322--
323-- /Pre-release/
324--
325{-# INLINE satisfy #-}
326satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
327satisfy predicate = Parser step initial extract
329 where
331 initial = return $ IPartial ()
333 step () a = return $
334 if predicate a
335 then Done 0 a
336 else Error "satisfy: predicate failed"
338 extract _ = throwM $ ParseError "satisfy: end of input"
340-- | See 'Streamly.Internal.Data.Parser.next'.
341--
342-- /Pre-release/
343--
344{-# INLINE next #-}
345next :: Monad m => Parser m a (Maybe a)
346next = Parser step initial extract
347 where
348 initial = pure $ IPartial ()
349 step _ a = pure $ Done 0 (Just a)
350 extract _ = pure Nothing
352-- | See 'Streamly.Internal.Data.Parser.maybe'.
353--
354-- /Pre-release/
355--
356{-# INLINE maybe #-}
357maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
358maybe parserF = Parser step initial extract
360 where
362 initial = return $ IPartial ()
364 step () a = return $
365 case parserF a of
366 Just b -> Done 0 b
367 Nothing -> Error "maybe: predicate failed"
369 extract _ = throwM $ ParseError "maybe: end of input"
371-- | See 'Streamly.Internal.Data.Parser.either'.
372--
373-- /Pre-release/
374--
375{-# INLINE either #-}
376either :: MonadThrow m => (a -> Either String b) -> Parser m a b
377either parserF = Parser step initial extract
379 where
381 initial = return $ IPartial ()
383 step () a = return $
384 case parserF a of
385 Right b -> Done 0 b
386 Left err -> Error $ "either: " ++ err
388 extract _ = throwM $ ParseError "either: end of input"
390-------------------------------------------------------------------------------
391-- Taking elements
392-------------------------------------------------------------------------------
394-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
395{-# ANN type Tuple'Fused Fuse #-}
396data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
398-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
399--
400-- /Pre-release/
401--
402{-# INLINE takeBetween #-}
403takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
404takeBetween low high (Fold fstep finitial fextract) =
406 Parser step initial (extract streamErr)
408 where
410 streamErr i =
411 "takeBetween: Expecting alteast " ++ show low
412 ++ " elements, got " ++ show i
414 invalidRange =
415 "takeBetween: lower bound - " ++ show low
416 ++ " is greater than higher bound - " ++ show high
418 foldErr :: Int -> String
419 foldErr i =
420 "takeBetween: the collecting fold terminated after"
421 ++ " consuming" ++ show i ++ " elements"
422 ++ " minimum" ++ show low ++ " elements needed"
424 -- Exactly the same as snext except different constructors, we can possibly
425 -- deduplicate the two.
426 {-# INLINE inext #-}
427 inext i res =
428 let i1 = i + 1
429 in case res of
430 FL.Partial s -> do
431 let s1 = Tuple'Fused i1 s
432 if i1 < high
433 -- XXX ideally this should be a Continue instead
434 then return $ IPartial s1
435 else IDone <$> extract foldErr s1
436 FL.Done b ->
437 return
438 $ if i1 >= low
439 then IDone b
440 else IError (foldErr i1)
442 initial = do
443 when (low >= 0 && high >= 0 && low > high)
444 $ throwM $ ParseError invalidRange
446 finitial >>= inext (-1)
448 -- Keep the impl same as inext
449 {-# INLINE snext #-}
450 snext i res =
451 let i1 = i + 1
452 in case res of
453 FL.Partial s -> do
454 let s1 = Tuple'Fused i1 s
455 if i1 < high
456 then return $ Continue 0 s1
457 else Done 0 <$> extract foldErr s1
458 FL.Done b ->
459 return
460 $ if i1 >= low
461 then Done 0 b
462 else Error (foldErr i1)
464 step (Tuple'Fused i s) a = fstep s a >>= snext i
466 extract f (Tuple'Fused i s)
467 | i >= low && i <= high = fextract s
468 | otherwise = throwM $ ParseError (f i)
470-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
471--
472-- /Pre-release/
473--
474{-# INLINE takeEQ #-}
475takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
476takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
478 where
480 cnt = max n 0
482 initial = do
483 res <- finitial
484 return $ case res of
485 FL.Partial s -> IPartial $ Tuple' 0 s
486 FL.Done b ->
487 if cnt == 0
488 then IDone b
489 else IError
490 $ "takeEQ: Expecting exactly " ++ show cnt
491 ++ " elements, fold terminated without"
492 ++ " consuming any elements"
494 step (Tuple' i r) a
495 | i1 < cnt = do
496 res <- fstep r a
497 return
498 $ case res of
499 FL.Partial s -> Continue 0 $ Tuple' i1 s
500 FL.Done _ ->
501 Error
502 $ "takeEQ: Expecting exactly " ++ show cnt
503 ++ " elements, fold terminated on " ++ show i1
504 | i1 == cnt = do
505 res <- fstep r a
506 Done 0
507 <$> case res of
508 FL.Partial s -> fextract s
509 FL.Done b -> return b
510 -- XXX we should not reach here when initial returns Step type
511 -- reachable only when n == 0
512 | otherwise = Done 1 <$> fextract r
514 where
516 i1 = i + 1
518 extract (Tuple' i r)
519 | i == 0 && cnt == 0 = fextract r
520 | otherwise =
521 throwM
522 $ ParseError
523 $ "takeEQ: Expecting exactly " ++ show cnt
524 ++ " elements, input terminated on " ++ show i
526-- | See 'Streamly.Internal.Data.Parser.takeGE'.
527--
528-- /Pre-release/
529--
530{-# INLINE takeGE #-}
531takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
532takeGE n (Fold fstep finitial fextract) = Parser step initial extract
534 where
536 cnt = max n 0
537 initial = do
538 res <- finitial
539 return $ case res of
540 FL.Partial s -> IPartial $ Tuple' 0 s
541 FL.Done b ->
542 if cnt == 0
543 then IDone b
544 else IError
545 $ "takeGE: Expecting at least " ++ show cnt
546 ++ " elements, fold terminated without"
547 ++ " consuming any elements"
549 step (Tuple' i r) a
550 | i1 < cnt = do
551 res <- fstep r a
552 return
553 $ case res of
554 FL.Partial s -> Continue 0 $ Tuple' i1 s
555 FL.Done _ ->
556 Error
557 $ "takeGE: Expecting at least " ++ show cnt
558 ++ " elements, fold terminated on " ++ show i1
559 | otherwise = do
560 res <- fstep r a
561 return
562 $ case res of
563 FL.Partial s -> Partial 0 $ Tuple' i1 s
564 FL.Done b -> Done 0 b
566 where
568 i1 = i + 1
570 extract (Tuple' i r)
571 | i >= cnt = fextract r
572 | otherwise =
573 throwM
574 $ ParseError
575 $ "takeGE: Expecting at least " ++ show cnt
576 ++ " elements, input terminated on " ++ show i
578-------------------------------------------------------------------------------
579-- Conditional splitting
580-------------------------------------------------------------------------------
582-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
583--
584-- /Pre-release/
585--
586{-# INLINE takeWhile #-}
587takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
588takeWhile predicate (Fold fstep finitial fextract) =
589 Parser step initial fextract
591 where
593 initial = do
594 res <- finitial
595 return $ case res of
596 FL.Partial s -> IPartial s
597 FL.Done b -> IDone b
599 step s a =
600 if predicate a
601 then do
602 fres <- fstep s a
603 return
604 $ case fres of
605 FL.Partial s1 -> Partial 0 s1
606 FL.Done b -> Done 0 b
607 else Done 1 <$> fextract s
609-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
610--
611-- /Pre-release/
612--
613{-# INLINE takeWhile1 #-}
614takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
615takeWhile1 predicate (Fold fstep finitial fextract) =
616 Parser step initial extract
618 where
620 initial = do
621 res <- finitial
622 return $ case res of
623 FL.Partial s -> IPartial (Left s)
624 FL.Done _ ->
625 IError
626 $ "takeWhile1: fold terminated without consuming:"
627 ++ " any element"
629 {-# INLINE process #-}
630 process s a = do
631 res <- fstep s a
632 return
633 $ case res of
634 FL.Partial s1 -> Partial 0 (Right s1)
635 FL.Done b -> Done 0 b
637 step (Left s) a =
638 if predicate a
639 then process s a
640 else return $ Error "takeWhile1: predicate failed on first element"
641 step (Right s) a =
642 if predicate a
643 then process s a
644 else do
645 b <- fextract s
646 return $ Done 1 b
648 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
649 extract (Right s) = fextract s
651-------------------------------------------------------------------------------
652-- Separators
653-------------------------------------------------------------------------------
655-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
656--
657-- /Pre-release/
658--
659sliceSepByP :: MonadCatch m =>
660 (a -> Bool) -> Parser m a b -> Parser m a b
661sliceSepByP cond (Parser pstep pinitial pextract) =
663 Parser step initial pextract
665 where
667 initial = pinitial
669 step s a =
670 if cond a
671 then do
672 res <- pextract s
673 return $ Done 0 res
674 else pstep s a
676-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
677--
678-- /Pre-release/
679--
680data SliceBeginWithState s = Left' s | Right' s
682{-# INLINE sliceBeginWith #-}
683sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
684sliceBeginWith cond (Fold fstep finitial fextract) =
686 Parser step initial extract
688 where
690 initial = do
691 res <- finitial
692 return $
693 case res of
694 FL.Partial s -> IPartial (Left' s)
695 FL.Done _ -> IError "sliceBeginWith : bad finitial"
697 {-# INLINE process #-}
698 process s a = do
699 res <- fstep s a
700 return
701 $ case res of
702 FL.Partial s1 -> Partial 0 (Right' s1)
703 FL.Done b -> Done 0 b
705 step (Left' s) a =
706 if cond a
707 then process s a
708 else error $ "sliceBeginWith : slice begins with an element which "
709 ++ "fails the predicate"
710 step (Right' s) a =
711 if not (cond a)
712 then process s a
713 else Done 1 <$> fextract s
715 extract (Left' s) = fextract s
716 extract (Right' s) = fextract s
718-------------------------------------------------------------------------------
719-- Grouping and words
720-------------------------------------------------------------------------------
722data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
724-- | See 'Streamly.Internal.Data.Parser.wordBy'.
725--
726--
727{-# INLINE wordBy #-}
728wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
729wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
731 where
733 {-# INLINE worder #-}
734 worder s a = do
735 res <- fstep s a
736 return
737 $ case res of
738 FL.Partial s1 -> Partial 0 $ WBWord s1
739 FL.Done b -> Done 0 b
741 initial = do
742 res <- finitial
743 return
744 $ case res of
745 FL.Partial s -> IPartial $ WBLeft s
746 FL.Done b -> IDone b
748 step (WBLeft s) a =
749 if not (predicate a)
750 then worder s a
751 else return $ Partial 0 $ WBLeft s
752 step (WBWord s) a =
753 if not (predicate a)
754 then worder s a
755 else do
756 b <- fextract s
757 return $ Partial 0 $ WBRight b
758 step (WBRight b) a =
759 return
760 $ if not (predicate a)
761 then Done 1 b
762 else Partial 0 $ WBRight b
764 extract (WBLeft s) = fextract s
765 extract (WBWord s) = fextract s
766 extract (WBRight b) = return b
768{-# ANN type GroupByState Fuse #-}
769data GroupByState a s
770 = GroupByInit !s
771 | GroupByGrouping !a !s
773-- | See 'Streamly.Internal.Data.Parser.groupBy'.
774--
775{-# INLINE groupBy #-}
776groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
777groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
779 where
781 {-# INLINE grouper #-}
782 grouper s a0 a = do
783 res <- fstep s a
784 return
785 $ case res of
786 FL.Done b -> Done 0 b
787 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
789 initial = do
790 res <- finitial
791 return
792 $ case res of
793 FL.Partial s -> IPartial $ GroupByInit s
794 FL.Done b -> IDone b
796 step (GroupByInit s) a = grouper s a a
797 step (GroupByGrouping a0 s) a =
798 if eq a0 a
799 then grouper s a0 a
800 else Done 1 <$> fextract s
802 extract (GroupByInit s) = fextract s
803 extract (GroupByGrouping _ s) = fextract s
805-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
806--
807{-# INLINE groupByRolling #-}
808groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
809groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
811 where
813 {-# INLINE grouper #-}
814 grouper s a = do
815 res <- fstep s a
816 return
817 $ case res of
818 FL.Done b -> Done 0 b
819 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
821 initial = do
822 res <- finitial
823 return
824 $ case res of
825 FL.Partial s -> IPartial $ GroupByInit s
826 FL.Done b -> IDone b
828 step (GroupByInit s) a = grouper s a
829 step (GroupByGrouping a0 s) a =
830 if eq a0 a
831 then grouper s a
832 else Done 1 <$> fextract s
834 extract (GroupByInit s) = fextract s
835 extract (GroupByGrouping _ s) = fextract s
837{-# ANN type GroupByStatePair Fuse #-}
838data GroupByStatePair a s1 s2
839 = GroupByInitPair !s1 !s2
840 | GroupByGroupingPair !a !s1 !s2
841 | GroupByGroupingPairL !a !s1 !s2
842 | GroupByGroupingPairR !a !s1 !s2
844{-# INLINE groupByRollingEither #-}
845groupByRollingEither :: MonadCatch m =>
846 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
847groupByRollingEither
848 eq
849 (Fold fstep1 finitial1 fextract1)
850 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
852 where
854 {-# INLINE grouper #-}
855 grouper s1 s2 a = do
856 return $ Continue 0 (GroupByGroupingPair a s1 s2)
858 {-# INLINE grouperL2 #-}
859 grouperL2 s1 s2 a = do
860 res <- fstep1 s1 a
861 return
862 $ case res of
863 FL.Done b -> Done 0 (Left b)
864 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
866 {-# INLINE grouperL #-}
867 grouperL s1 s2 a0 a = do
868 res <- fstep1 s1 a0
869 case res of
870 FL.Done b -> return $ Done 0 (Left b)
871 FL.Partial s11 -> grouperL2 s11 s2 a
873 {-# INLINE grouperR2 #-}
874 grouperR2 s1 s2 a = do
875 res <- fstep2 s2 a
876 return
877 $ case res of
878 FL.Done b -> Done 0 (Right b)
879 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
881 {-# INLINE grouperR #-}
882 grouperR s1 s2 a0 a = do
883 res <- fstep2 s2 a0
884 case res of
885 FL.Done b -> return $ Done 0 (Right b)
886 FL.Partial s21 -> grouperR2 s1 s21 a
888 initial = do
889 res1 <- finitial1
890 res2 <- finitial2
891 return
892 $ case res1 of
893 FL.Partial s1 ->
894 case res2 of
895 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
896 FL.Done b -> IDone (Right b)
897 FL.Done b -> IDone (Left b)
899 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
901 step (GroupByGroupingPair a0 s1 s2) a =
902 if not (eq a0 a)
903 then grouperL s1 s2 a0 a
904 else grouperR s1 s2 a0 a
906 step (GroupByGroupingPairL a0 s1 s2) a =
907 if not (eq a0 a)
908 then grouperL2 s1 s2 a
909 else Done 1 . Left <$> fextract1 s1
911 step (GroupByGroupingPairR a0 s1 s2) a =
912 if eq a0 a
913 then grouperR2 s1 s2 a
914 else Done 1 . Right <$> fextract2 s2
916 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
917 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
918 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
919 extract (GroupByGroupingPair a s1 _) = do
920 res <- fstep1 s1 a
921 case res of
922 FL.Done b -> return $ Left b
923 FL.Partial s11 -> Left <$> fextract1 s11
925-- XXX use an Unfold instead of a list?
926-- XXX custom combinators for matching list, array and stream?
927-- XXX rename to listBy?
928--
929-- | See 'Streamly.Internal.Data.Parser.eqBy'.
930--
931-- /Pre-release/
932--
933{-# INLINE eqBy #-}
934eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
935eqBy cmp str = Parser step initial extract
937 where
939 -- XXX Should return IDone in initial for [] case
940 initial = return $ IPartial str
942 step [] _ = return $ Done 0 ()
943 step [x] a =
944 return
945 $ if x `cmp` a
946 then Done 0 ()
947 else Error "eqBy: failed, yet to match the last element"
948 step (x:xs) a =
949 return
950 $ if x `cmp` a
951 then Continue 0 xs
952 else Error
953 $ "eqBy: failed, yet to match "
954 ++ show (length xs + 1) ++ " elements"
956 extract xs =
957 throwM
958 $ ParseError
959 $ "eqBy: end of input, yet to match "
960 ++ show (length xs) ++ " elements"
962-- XXX rename to streamBy?
963-- | Like eqBy but uses a stream instead of a list
964{-# INLINE matchBy #-}
965matchBy :: MonadThrow m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
966matchBy cmp (D.Stream sstep state) = Parser step initial extract
968 where
970 initial = do
971 r <- sstep defState state
972 case r of
973 D.Yield x s -> return $ IPartial (Just x, s)
974 D.Stop -> return $ IDone ()
975 -- Need Skip/Continue in initial to loop right here
976 D.Skip s -> return $ IPartial (Nothing, s)
978 step (Just x, st) a =
979 if x `cmp` a
980 then do
981 r <- sstep defState st
982 return
983 $ case r of
984 D.Yield x1 s -> Continue 0 (Just x1, s)
985 D.Stop -> Done 0 ()
986 D.Skip s -> Continue 1 (Nothing, s)
987 else return $ Error "match: mismtach occurred"
988 step (Nothing, st) a = do
989 r <- sstep defState st
990 return
991 $ case r of
992 D.Yield x s -> do
993 if x `cmp` a
994 then Continue 0 (Nothing, s)
995 else Error "match: mismatch occurred"
996 D.Stop -> Done 1 ()
997 D.Skip s -> Continue 1 (Nothing, s)
999 extract _ = throwM $ ParseError "match: end of input"
1001{-# INLINE zipWithM #-}
1002zipWithM :: MonadThrow m =>
1003 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
1004zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
1005 Parser step initial extract
1007 where
1009 initial = do
1010 fres <- finitial
1011 case fres of
1012 FL.Partial fs -> do
1013 r <- sstep defState state
1014 case r of
1015 D.Yield x s -> return $ IPartial (Just x, s, fs)
1016 D.Stop -> do
1017 x <- fextract fs
1018 return $ IDone x
1019 -- Need Skip/Continue in initial to loop right here
1020 D.Skip s -> return $ IPartial (Nothing, s, fs)
1021 FL.Done x -> return $ IDone x
1023 step (Just a, st, fs) b = do
1024 c <- zf a b
1025 fres <- fstep fs c
1026 case fres of
1027 FL.Partial fs1 -> do
1028 r <- sstep defState st
1029 case r of
1030 D.Yield x1 s -> return $ Continue 0 (Just x1, s, fs1)
1031 D.Stop -> do
1032 x <- fextract fs1
1033 return $ Done 0 x
1034 D.Skip s -> return $ Continue 1 (Nothing, s, fs1)
1035 FL.Done x -> return $ Done 0 x
1036 step (Nothing, st, fs) b = do
1037 r <- sstep defState st
1038 case r of
1039 D.Yield a s -> do
1040 c <- zf a b
1041 fres <- fstep fs c
1042 case fres of
1043 FL.Partial fs1 -> return $ Continue 0 (Nothing, s, fs1)
1044 FL.Done x -> return $ Done 0 x
1045 D.Stop -> do
1046 x <- fextract fs
1047 return $ Done 1 x
1048 D.Skip s -> return $ Continue 1 (Nothing, s, fs)
1050 extract _ = throwM $ ParseError "zipWithM: end of input"
1052-- | Zip the input of a fold with a stream.
1054-- /Pre-release/
1056{-# INLINE zip #-}
1057zip :: MonadThrow m => D.Stream m a -> Fold m (a, b) x -> Parser m b x
1058zip = zipWithM (curry return)
1060-- | Pair each element of a fold input with its index, starting from index 0.
1062-- /Pre-release/
1063{-# INLINE indexed #-}
1064indexed :: forall m a b. MonadThrow m => Fold m (Int, a) b -> Parser m a b
1065indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
1067-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
1068-- function using a fold indexing function that attaches an index to each input
1069-- element and a filtering function that filters using @(index, element) ->
1070-- Bool) as predicate.
1072-- For example:
1074-- @
1075-- filterWithIndex = makeIndexFilter indexed filter
1076-- filterWithAbsTime = makeIndexFilter timestamped filter
1077-- filterWithRelTime = makeIndexFilter timeIndexed filter
1078-- @
1080-- /Pre-release/
1081{-# INLINE makeIndexFilter #-}
1082makeIndexFilter ::
1083 (Fold m (s, a) b -> Parser m a b)
1084 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
1085 -> (((s, a) -> Bool) -> Fold m a b -> Parser m a b)
1086makeIndexFilter f comb g = f . comb g . FL.lmap snd
1088-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
1089-- then every element at strides of @stride@.
1091-- /Pre-release/
1092{-# INLINE sampleFromthen #-}
1093sampleFromthen :: MonadThrow m => Int -> Int -> Fold m a b -> Parser m a b
1094sampleFromthen offset size =
1095 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
1097--------------------------------------------------------------------------------
1098--- Spanning
1099--------------------------------------------------------------------------------
1101-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1102-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1103-- input.
1105-- @
1106-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
1108-- > span_ (< 1) [1,2,3]
1109-- ([],[1,2,3])
1111-- > span_ (< 2) [1,2,3]
1112-- ([1],[2,3])
1114-- > span_ (< 4) [1,2,3]
1115-- ([1,2,3],[])
1117-- @
1119-- /Pre-release/
1120{-# INLINE span #-}
1121span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1122span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1124-- | Break the input stream into two groups, the first group takes the input as
1125-- long as the predicate applied to the first element of the stream and next
1126-- input element holds 'True', the second group takes the rest of the input.
1128-- /Pre-release/
1130{-# INLINE spanBy #-}
1131spanBy ::
1132 Monad m
1133 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1134spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1136-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1137-- predicate is applied to the previous and the next input elements.
1139-- /Pre-release/
1140{-# INLINE spanByRolling #-}
1141spanByRolling ::
1142 Monad m
1143 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1144spanByRolling eq f1 f2 =
1145 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1147-------------------------------------------------------------------------------
1148-- nested parsers
1149-------------------------------------------------------------------------------
1151-- | See 'Streamly.Internal.Data.Parser.takeP'.
1153-- /Internal/
1154{-# INLINE takeP #-}
1155takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1156takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1158 where
1160 initial = do
1161 res <- pinitial
1162 case res of
1163 IPartial s ->
1164 if lim > 0
1165 then return $ IPartial $ Tuple' 0 s
1166 else IDone <$> pextract s
1167 IDone b -> return $ IDone b
1168 IError e -> return $ IError e
1170 step (Tuple' cnt r) a = do
1171 assert (cnt < lim) (return ())
1172 res <- pstep r a
1173 let cnt1 = cnt + 1
1174 case res of
1175 Partial 0 s -> do
1176 assert (cnt1 >= 0) (return ())
1177 if cnt1 < lim
1178 then return $ Partial 0 $ Tuple' cnt1 s
1179 else Done 0 <$> pextract s
1180 Continue 0 s -> do
1181 assert (cnt1 >= 0) (return ())
1182 if cnt1 < lim
1183 then return $ Continue 0 $ Tuple' cnt1 s
1184 -- XXX This should error out?
1185 -- If designed properly, this will probably error out.
1186 -- "pextract" should error out
1187 --
1188 -- By Harendra,
1189 --
1190 -- This is a tricky case, we have the following options:
1191 -- 1. Done 0 with extract as you have written
1192 -- 2. Done n, will require buffering elements
1193 -- 3. Use a backtracking fold and not a parser, once we have
1194 -- backtracking in folds
1195 else Done 0 <$> pextract s
1196 Partial n s -> do
1197 let taken = cnt1 - n
1198 assert (taken >= 0) (return ())
1199 return $ Partial n $ Tuple' taken s
1200 Continue n s -> do
1201 let taken = cnt1 - n
1202 assert (taken >= 0) (return ())
1203 return $ Continue n $ Tuple' taken s
1204 Done n b -> return $ Done n b
1205 Error str -> return $ Error str
1207 extract (Tuple' _ r) = pextract r
1209-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1211-- /Pre-release/
1213{-# INLINE lookAhead #-}
1214lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1215lookAhead (Parser step1 initial1 _) = Parser step initial extract
1217 where
1219 initial = do
1220 res <- initial1
1221 return $ case res of
1222 IPartial s -> IPartial (Tuple' 0 s)
1223 IDone b -> IDone b
1224 IError e -> IError e
1226 step (Tuple' cnt st) a = do
1227 r <- step1 st a
1228 let cnt1 = cnt + 1
1229 return
1230 $ case r of
1231 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1232 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1233 Done _ b -> Done cnt1 b
1234 Error err -> Error err
1236 -- XXX returning an error let's us backtrack. To implement it in a way so
1237 -- that it terminates on eof without an error then we need a way to
1238 -- backtrack on eof, that will require extract to return 'Step' type.
1239 extract (Tuple' n _) =
1240 throwM
1241 $ ParseError
1242 $ "lookAhead: end of input after consuming "
1243 ++ show n ++ " elements"
1245-------------------------------------------------------------------------------
1246-- Interleaving
1247-------------------------------------------------------------------------------
1249-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1251-- /Unimplemented/
1253{-# INLINE deintercalate #-}
1254deintercalate ::
1255 -- Monad m =>
1256 Fold m a y -> Parser m x a
1257 -> Fold m b z -> Parser m x b
1258 -> Parser m x (y, z)
1259deintercalate = undefined
1261-------------------------------------------------------------------------------
1262-- Sequential Collection
1263-------------------------------------------------------------------------------
1265-- | See 'Streamly.Internal.Data.Parser.sequence'.
1267-- /Unimplemented/
1269{-# INLINE sequence #-}
1270sequence ::
1271 -- Foldable t =>
1272 Fold m b c -> t (Parser m a b) -> Parser m a c
1273sequence _f _p = undefined
1275-------------------------------------------------------------------------------
1276-- Alternative Collection
1277-------------------------------------------------------------------------------
1279-- | See 'Streamly.Internal.Data.Parser.choice'.
1281-- /Broken/
1283{-# INLINE choice #-}
1284choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
1285choice = foldl1 shortest
1287-------------------------------------------------------------------------------
1288-- Sequential Repetition
1289-------------------------------------------------------------------------------
1291-- | See 'Streamly.Internal.Data.Parser.many'.
1293-- /Pre-release/
1295{-# INLINE many #-}
1296many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1297many = splitMany
1298-- many = countBetween 0 maxBound
1300-- | See 'Streamly.Internal.Data.Parser.some'.
1302-- /Pre-release/
1304{-# INLINE some #-}
1305some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1306some = splitSome
1307-- some f p = many (takeGE 1 f) p
1308-- many = countBetween 1 maxBound
1310-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1312-- /Unimplemented/
1314{-# INLINE countBetween #-}
1315countBetween ::
1316 -- MonadCatch m =>
1317 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1318countBetween _m _n _p = undefined
1319-- countBetween m n p f = many (takeBetween m n f) p
1321-- | See 'Streamly.Internal.Data.Parser.count'.
1323-- /Unimplemented/
1325{-# INLINE count #-}
1326count ::
1327 -- MonadCatch m =>
1328 Int -> Parser m a b -> Fold m b c -> Parser m a c
1329count n = countBetween n n
1330-- count n f p = many (takeEQ n f) p
1332data ManyTillState fs sr sl
1333 = ManyTillR Int fs sr
1334 | ManyTillL Int fs sl
1336-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1338-- /Pre-release/
1340{-# INLINE manyTill #-}
1341manyTill :: MonadCatch m
1342 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1343manyTill (Fold fstep finitial fextract)
1344 (Parser stepL initialL extractL)
1345 (Parser stepR initialR _) =
1346 Parser step initial extract
1348 where
1350 -- Caution: Mutual recursion
1352 scrutL fs p c d e = do
1353 resL <- initialL
1354 case resL of
1355 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1356 IDone bl -> do
1357 fr <- fstep fs bl
1358 case fr of
1359 FL.Partial fs1 -> scrutR fs1 p c d e
1360 FL.Done fb -> return $ d fb
1361 IError err -> return $ e err
1363 scrutR fs p c d e = do
1364 resR <- initialR
1365 case resR of
1366 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1367 IDone _ -> d <$> fextract fs
1368 IError _ -> scrutL fs p c d e
1370 initial = do
1371 res <- finitial
1372 case res of
1373 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1374 FL.Done b -> return $ IDone b
1376 step (ManyTillR cnt fs st) a = do
1377 r <- stepR st a
1378 case r of
1379 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1380 Continue n s -> do
1381 assert (cnt + 1 - n >= 0) (return ())
1382 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1383 Done n _ -> do
1384 b <- fextract fs
1385 return $ Done n b
1386 Error _ -> do
1387 resL <- initialL
1388 case resL of
1389 IPartial sl ->
1390 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1391 IDone bl -> do
1392 fr <- fstep fs bl
1393 let cnt1 = cnt + 1
1394 p = Partial cnt
1395 c = Continue cnt
1396 d = Done cnt
1397 case fr of
1398 FL.Partial fs1 -> scrutR fs1 p c d Error
1399 FL.Done fb -> return $ Done cnt1 fb
1400 IError err -> return $ Error err
1401 -- XXX the cnt is being used only by the assert
1402 step (ManyTillL cnt fs st) a = do
1403 r <- stepL st a
1404 case r of
1405 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1406 Continue n s -> do
1407 assert (cnt + 1 - n >= 0) (return ())
1408 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1409 Done n b -> do
1410 fs1 <- fstep fs b
1411 case fs1 of
1412 FL.Partial s ->
1413 scrutR s (Partial n) (Continue n) (Done n) Error
1414 FL.Done b1 -> return $ Done n b1
1415 Error err -> return $ Error err
1417 extract (ManyTillL _ fs sR) = do
1418 res <- extractL sR >>= fstep fs
1419 case res of
1420 FL.Partial s -> fextract s
1421 FL.Done b -> return b
1422 extract (ManyTillR _ fs _) = fextract fs