git.iko.soy/streamly
on 5dbf2ac help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
1298 lines 38 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 -- * Element parsers
37 , peek
38 , eof
39 , satisfy
40 , next
41 , maybe
42 , either
44 -- * Sequence parsers
45 --
46 -- Parsers chained in series, if one parser terminates the composition
47 -- terminates. Currently we are using folds to collect the output of the
48 -- parsers but we can use Parsers instead of folds to make the composition
49 -- more powerful. For example, we can do:
50 --
51 -- sliceSepByMax cond n p = sliceBy cond (take n p)
52 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
53 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
54 --
55 -- Grab a sequence of input elements without inspecting them
56 , takeBetween
57 -- , take -- take -- takeBetween 0 n
58 -- , takeLE1 -- take1 -- takeBetween 1 n
59 , takeEQ -- takeBetween n n
60 , takeGE -- takeBetween n maxBound
62 -- Grab a sequence of input elements by inspecting them
63 , takeP
64 , lookAhead
65 , takeWhile
66 , takeWhile1
67 , sliceSepByP
68 -- , sliceSepByBetween
69 , sliceBeginWith
70 -- , sliceSepWith
71 --
72 -- , frameSepBy -- parse frames escaped by an escape char/sequence
73 -- , frameEndWith
74 --
75 , wordBy
76 , groupBy
77 , groupByRolling
78 , groupByRollingEither
79 , eqBy
80 , matchBy
81 -- , prefixOf -- match any prefix of a given string
82 -- , suffixOf -- match any suffix of a given string
83 -- , infixOf -- match any substring of a given string
85 -- ** Spanning
86 , span
87 , spanBy
88 , spanByRolling
90 -- Second order parsers (parsers using parsers)
91 -- * Binary Combinators
93 -- ** Sequential Applicative
94 , serialWith
95 , split_
97 -- ** Parallel Applicatives
98 , teeWith
99 , teeWithFst
100 , teeWithMin
101 -- , teeTill -- like manyTill but parallel
103 -- ** Sequential Interleaving
104 -- Use two folds, run a primary parser, its rejected values go to the
105 -- secondary parser.
106 , deintercalate
108 -- ** Sequential Alternative
109 , alt
111 -- ** Parallel Alternatives
112 , shortest
113 , longest
114 -- , fastest
116 -- * N-ary Combinators
117 -- ** Sequential Collection
118 , sequence
119 , concatMap
121 -- ** Sequential Repetition
122 , count
123 , countBetween
124 -- , countBetweenTill
126 , many
127 , some
128 , manyTill
130 -- -- ** Special cases
131 -- XXX traditional implmentations of these may be of limited use. For
132 -- example, consider parsing lines separated by "\r\n". The main parser
133 -- will have to detect and exclude the sequence "\r\n" anyway so that we
134 -- can apply the "sep" parser.
135 --
136 -- We can instead implement these as special cases of deintercalate.
137 --
138 -- , endBy
139 -- , sepBy
140 -- , sepEndBy
141 -- , beginBy
142 -- , sepBeginBy
143 -- , sepAroundBy
145 -- -- * Distribution
146 --
147 -- A simple and stupid impl would be to just convert the stream to an array
148 -- and give the array reference to all consumers. The array can be grown on
149 -- demand by any consumer and truncated when nonbody needs it.
150 --
151 -- -- ** Distribute to collection
152 -- -- ** Distribute to repetition
154 -- -- ** Interleaved collection
155 -- Round robin
156 -- Priority based
157 -- -- ** Interleaved repetition
158 -- repeat one parser and when it fails run an error recovery parser
159 -- e.g. to find a key frame in the stream after an error
161 -- ** Collection of Alternatives
162 -- , shortestN
163 -- , longestN
164 -- , fastestN -- first N successful in time
165 -- , choiceN -- first N successful in position
166 , choice -- first successful in position
168 -- -- ** Repeated Alternatives
169 -- , retryMax -- try N times
170 -- , retryUntil -- try until successful
171 -- , retryUntilN -- try until successful n times
172 )
173where
175import Control.Exception (assert, Exception)
176import Control.Monad (when)
177import Control.Monad.Catch (MonadCatch, MonadThrow(..))
178import Fusion.Plugin.Types (Fuse(..))
179import Streamly.Internal.Data.Fold.Type (Fold(..))
180import Streamly.Internal.Data.SVar.Type (defState)
181import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
183import qualified Streamly.Internal.Data.Fold.Type as FL
184import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
186import Prelude hiding
187 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
188import Streamly.Internal.Data.Parser.ParserD.Tee
189import Streamly.Internal.Data.Parser.ParserD.Type
191--
192-- $setup
193-- >>> :m
194-- >>> :set -package streamly
195-- >>> import Prelude hiding ()
196-- >>> import qualified Streamly.Prelude as Stream
197-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
198-- >>> import qualified Streamly.Data.Fold as Fold
199-- >>> import qualified Streamly.Internal.Data.Parser as Parser
201-------------------------------------------------------------------------------
202-- Downgrade a parser to a Fold
203-------------------------------------------------------------------------------
205data ParserToFoldError =
206 InitialError String
207 | PartialError Int
208 | ContinueError Int
209 | DoneError Int
210 | ErrorError String
211 deriving Show
213instance Exception ParserToFoldError
215-- | See 'Streamly.Internal.Data.Parser.toFold'.
216--
217-- /Internal/
218--
219{-# INLINE toFold #-}
220toFold :: MonadThrow m => Parser m a b -> Fold m a b
221toFold (Parser pstep pinitial pextract) = Fold step initial pextract
223 where
225 initial = do
226 r <- pinitial
227 case r of
228 IPartial s -> return $ FL.Partial s
229 IDone b -> return $ FL.Done b
230 IError err -> throwM $ InitialError err
232 step st a = do
233 r <- pstep st a
234 case r of
235 Partial 0 s -> return $ FL.Partial s
236 Continue 0 s -> return $ FL.Partial s
237 Done 0 b -> return $ FL.Done b
238 Partial n _ -> throwM $ PartialError n
239 Continue n _ -> throwM $ ContinueError n
240 Done n _ -> throwM $ DoneError n
241 Error err -> throwM $ ErrorError err
243-------------------------------------------------------------------------------
244-- Upgrade folds to parses
245-------------------------------------------------------------------------------
246--
247-- | See 'Streamly.Internal.Data.Parser.fromFold'.
248--
249-- /Pre-release/
250--
251{-# INLINE fromFold #-}
252fromFold :: Monad m => Fold m a b -> Parser m a b
253fromFold (Fold fstep finitial fextract) = Parser step initial fextract
255 where
257 initial = do
258 res <- finitial
259 return
260 $ case res of
261 FL.Partial s1 -> IPartial s1
262 FL.Done b -> IDone b
264 step s a = do
265 res <- fstep s a
266 return
267 $ case res of
268 FL.Partial s1 -> Partial 0 s1
269 FL.Done b -> Done 0 b
271-------------------------------------------------------------------------------
272-- Failing Parsers
273-------------------------------------------------------------------------------
275-- | See 'Streamly.Internal.Data.Parser.peek'.
276--
277-- /Pre-release/
278--
279{-# INLINE peek #-}
280peek :: MonadThrow m => Parser m a a
281peek = Parser step initial extract
283 where
285 initial = return $ IPartial ()
287 step () a = return $ Done 1 a
289 extract () = throwM $ ParseError "peek: end of input"
291-- | See 'Streamly.Internal.Data.Parser.eof'.
292--
293-- /Pre-release/
294--
295{-# INLINE eof #-}
296eof :: Monad m => Parser m a ()
297eof = Parser step initial return
299 where
301 initial = return $ IPartial ()
303 step () _ = return $ Error "eof: not at end of input"
305-- | See 'Streamly.Internal.Data.Parser.satisfy'.
306--
307-- /Pre-release/
308--
309{-# INLINE satisfy #-}
310satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
311satisfy predicate = Parser step initial extract
313 where
315 initial = return $ IPartial ()
317 step () a = return $
318 if predicate a
319 then Done 0 a
320 else Error "satisfy: predicate failed"
322 extract _ = throwM $ ParseError "satisfy: end of input"
324-- | See 'Streamly.Internal.Data.Parser.next'.
325--
326-- /Pre-release/
327--
328{-# INLINE next #-}
329next :: Monad m => Parser m a (Maybe a)
330next = Parser step initial extract
331 where
332 initial = pure $ IPartial ()
333 step _ a = pure $ Done 0 (Just a)
334 extract _ = pure Nothing
336-- | See 'Streamly.Internal.Data.Parser.maybe'.
337--
338-- /Pre-release/
339--
340{-# INLINE maybe #-}
341maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
342maybe parserF = Parser step initial extract
344 where
346 initial = return $ IPartial ()
348 step () a = return $
349 case parserF a of
350 Just b -> Done 0 b
351 Nothing -> Error "maybe: predicate failed"
353 extract _ = throwM $ ParseError "maybe: end of input"
355-- | See 'Streamly.Internal.Data.Parser.either'.
356--
357-- /Pre-release/
358--
359{-# INLINE either #-}
360either :: MonadThrow m => (a -> Either String b) -> Parser m a b
361either parserF = Parser step initial extract
363 where
365 initial = return $ IPartial ()
367 step () a = return $
368 case parserF a of
369 Right b -> Done 0 b
370 Left err -> Error $ "either: " ++ err
372 extract _ = throwM $ ParseError "either: end of input"
374-------------------------------------------------------------------------------
375-- Taking elements
376-------------------------------------------------------------------------------
378-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
379{-# ANN type Tuple'Fused Fuse #-}
380data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
382-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
383--
384-- /Pre-release/
385--
386{-# INLINE takeBetween #-}
387takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
388takeBetween low high (Fold fstep finitial fextract) =
390 Parser step initial (extract streamErr)
392 where
394 streamErr i =
395 "takeBetween: Expecting alteast " ++ show low
396 ++ " elements, got " ++ show i
398 invalidRange =
399 "takeBetween: lower bound - " ++ show low
400 ++ " is greater than higher bound - " ++ show high
402 foldErr :: Int -> String
403 foldErr i =
404 "takeBetween: the collecting fold terminated after"
405 ++ " consuming" ++ show i ++ " elements"
406 ++ " minimum" ++ show low ++ " elements needed"
408 -- Exactly the same as snext except different constructors, we can possibly
409 -- deduplicate the two.
410 {-# INLINE inext #-}
411 inext i res =
412 let i1 = i + 1
413 in case res of
414 FL.Partial s -> do
415 let s1 = Tuple'Fused i1 s
416 if i1 < high
417 -- XXX ideally this should be a Continue instead
418 then return $ IPartial s1
419 else IDone <$> extract foldErr s1
420 FL.Done b ->
421 return
422 $ if i1 >= low
423 then IDone b
424 else IError (foldErr i1)
426 initial = do
427 when (low >= 0 && high >= 0 && low > high)
428 $ throwM $ ParseError invalidRange
430 finitial >>= inext (-1)
432 -- Keep the impl same as inext
433 {-# INLINE snext #-}
434 snext i res =
435 let i1 = i + 1
436 in case res of
437 FL.Partial s -> do
438 let s1 = Tuple'Fused i1 s
439 if i1 < high
440 then return $ Continue 0 s1
441 else Done 0 <$> extract foldErr s1
442 FL.Done b ->
443 return
444 $ if i1 >= low
445 then Done 0 b
446 else Error (foldErr i1)
448 step (Tuple'Fused i s) a = fstep s a >>= snext i
450 extract f (Tuple'Fused i s)
451 | i >= low && i <= high = fextract s
452 | otherwise = throwM $ ParseError (f i)
454-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
455--
456-- /Pre-release/
457--
458{-# INLINE takeEQ #-}
459takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
460takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
462 where
464 cnt = max n 0
466 initial = do
467 res <- finitial
468 return $ case res of
469 FL.Partial s -> IPartial $ Tuple' 0 s
470 FL.Done b ->
471 if cnt == 0
472 then IDone b
473 else IError
474 $ "takeEQ: Expecting exactly " ++ show cnt
475 ++ " elements, fold terminated without"
476 ++ " consuming any elements"
478 step (Tuple' i r) a
479 | i1 < cnt = do
480 res <- fstep r a
481 return
482 $ case res of
483 FL.Partial s -> Continue 0 $ Tuple' i1 s
484 FL.Done _ ->
485 Error
486 $ "takeEQ: Expecting exactly " ++ show cnt
487 ++ " elements, fold terminated on " ++ show i1
488 | i1 == cnt = do
489 res <- fstep r a
490 Done 0
491 <$> case res of
492 FL.Partial s -> fextract s
493 FL.Done b -> return b
494 -- XXX we should not reach here when initial returns Step type
495 -- reachable only when n == 0
496 | otherwise = Done 1 <$> fextract r
498 where
500 i1 = i + 1
502 extract (Tuple' i r)
503 | i == 0 && cnt == 0 = fextract r
504 | otherwise =
505 throwM
506 $ ParseError
507 $ "takeEQ: Expecting exactly " ++ show cnt
508 ++ " elements, input terminated on " ++ show i
510-- | See 'Streamly.Internal.Data.Parser.takeGE'.
511--
512-- /Pre-release/
513--
514{-# INLINE takeGE #-}
515takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
516takeGE n (Fold fstep finitial fextract) = Parser step initial extract
518 where
520 cnt = max n 0
521 initial = do
522 res <- finitial
523 return $ case res of
524 FL.Partial s -> IPartial $ Tuple' 0 s
525 FL.Done b ->
526 if cnt == 0
527 then IDone b
528 else IError
529 $ "takeGE: Expecting at least " ++ show cnt
530 ++ " elements, fold terminated without"
531 ++ " consuming any elements"
533 step (Tuple' i r) a
534 | i1 < cnt = do
535 res <- fstep r a
536 return
537 $ case res of
538 FL.Partial s -> Continue 0 $ Tuple' i1 s
539 FL.Done _ ->
540 Error
541 $ "takeGE: Expecting at least " ++ show cnt
542 ++ " elements, fold terminated on " ++ show i1
543 | otherwise = do
544 res <- fstep r a
545 return
546 $ case res of
547 FL.Partial s -> Partial 0 $ Tuple' i1 s
548 FL.Done b -> Done 0 b
550 where
552 i1 = i + 1
554 extract (Tuple' i r)
555 | i >= cnt = fextract r
556 | otherwise =
557 throwM
558 $ ParseError
559 $ "takeGE: Expecting at least " ++ show cnt
560 ++ " elements, input terminated on " ++ show i
562-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
563--
564-- /Pre-release/
565--
566{-# INLINE takeWhile #-}
567takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
568takeWhile predicate (Fold fstep finitial fextract) =
569 Parser step initial fextract
571 where
573 initial = do
574 res <- finitial
575 return $ case res of
576 FL.Partial s -> IPartial s
577 FL.Done b -> IDone b
579 step s a =
580 if predicate a
581 then do
582 fres <- fstep s a
583 return
584 $ case fres of
585 FL.Partial s1 -> Partial 0 s1
586 FL.Done b -> Done 0 b
587 else Done 1 <$> fextract s
589-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
590--
591-- /Pre-release/
592--
593{-# INLINE takeWhile1 #-}
594takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
595takeWhile1 predicate (Fold fstep finitial fextract) =
596 Parser step initial extract
598 where
600 initial = do
601 res <- finitial
602 return $ case res of
603 FL.Partial s -> IPartial (Left s)
604 FL.Done _ ->
605 IError
606 $ "takeWhile1: fold terminated without consuming:"
607 ++ " any element"
609 {-# INLINE process #-}
610 process s a = do
611 res <- fstep s a
612 return
613 $ case res of
614 FL.Partial s1 -> Partial 0 (Right s1)
615 FL.Done b -> Done 0 b
617 step (Left s) a =
618 if predicate a
619 then process s a
620 else return $ Error "takeWhile1: predicate failed on first element"
621 step (Right s) a =
622 if predicate a
623 then process s a
624 else do
625 b <- fextract s
626 return $ Done 1 b
628 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
629 extract (Right s) = fextract s
631-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
632--
633-- /Pre-release/
634--
635sliceSepByP :: MonadCatch m =>
636 (a -> Bool) -> Parser m a b -> Parser m a b
637sliceSepByP cond (Parser pstep pinitial pextract) =
639 Parser step initial pextract
641 where
643 initial = pinitial
645 step s a =
646 if cond a
647 then do
648 res <- pextract s
649 return $ Done 0 res
650 else pstep s a
652-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
653--
654-- /Pre-release/
655--
656data SliceBeginWithState s = Left' s | Right' s
658{-# INLINE sliceBeginWith #-}
659sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
660sliceBeginWith cond (Fold fstep finitial fextract) =
662 Parser step initial extract
664 where
666 initial = do
667 res <- finitial
668 return $
669 case res of
670 FL.Partial s -> IPartial (Left' s)
671 FL.Done _ -> IError "sliceBeginWith : bad finitial"
673 {-# INLINE process #-}
674 process s a = do
675 res <- fstep s a
676 return
677 $ case res of
678 FL.Partial s1 -> Partial 0 (Right' s1)
679 FL.Done b -> Done 0 b
681 step (Left' s) a =
682 if cond a
683 then process s a
684 else error $ "sliceBeginWith : slice begins with an element which "
685 ++ "fails the predicate"
686 step (Right' s) a =
687 if not (cond a)
688 then process s a
689 else Done 1 <$> fextract s
691 extract (Left' s) = fextract s
692 extract (Right' s) = fextract s
694data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
696-- | See 'Streamly.Internal.Data.Parser.wordBy'.
697--
698--
699{-# INLINE wordBy #-}
700wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
701wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
703 where
705 {-# INLINE worder #-}
706 worder s a = do
707 res <- fstep s a
708 return
709 $ case res of
710 FL.Partial s1 -> Partial 0 $ WBWord s1
711 FL.Done b -> Done 0 b
713 initial = do
714 res <- finitial
715 return
716 $ case res of
717 FL.Partial s -> IPartial $ WBLeft s
718 FL.Done b -> IDone b
720 step (WBLeft s) a =
721 if not (predicate a)
722 then worder s a
723 else return $ Partial 0 $ WBLeft s
724 step (WBWord s) a =
725 if not (predicate a)
726 then worder s a
727 else do
728 b <- fextract s
729 return $ Partial 0 $ WBRight b
730 step (WBRight b) a =
731 return
732 $ if not (predicate a)
733 then Done 1 b
734 else Partial 0 $ WBRight b
736 extract (WBLeft s) = fextract s
737 extract (WBWord s) = fextract s
738 extract (WBRight b) = return b
740{-# ANN type GroupByState Fuse #-}
741data GroupByState a s
742 = GroupByInit !s
743 | GroupByGrouping !a !s
745-- | See 'Streamly.Internal.Data.Parser.groupBy'.
746--
747{-# INLINE groupBy #-}
748groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
749groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
751 where
753 {-# INLINE grouper #-}
754 grouper s a0 a = do
755 res <- fstep s a
756 return
757 $ case res of
758 FL.Done b -> Done 0 b
759 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
761 initial = do
762 res <- finitial
763 return
764 $ case res of
765 FL.Partial s -> IPartial $ GroupByInit s
766 FL.Done b -> IDone b
768 step (GroupByInit s) a = grouper s a a
769 step (GroupByGrouping a0 s) a =
770 if eq a0 a
771 then grouper s a0 a
772 else Done 1 <$> fextract s
774 extract (GroupByInit s) = fextract s
775 extract (GroupByGrouping _ s) = fextract s
777-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
778--
779{-# INLINE groupByRolling #-}
780groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
781groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
783 where
785 {-# INLINE grouper #-}
786 grouper s a = do
787 res <- fstep s a
788 return
789 $ case res of
790 FL.Done b -> Done 0 b
791 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
793 initial = do
794 res <- finitial
795 return
796 $ case res of
797 FL.Partial s -> IPartial $ GroupByInit s
798 FL.Done b -> IDone b
800 step (GroupByInit s) a = grouper s a
801 step (GroupByGrouping a0 s) a =
802 if eq a0 a
803 then grouper s a
804 else Done 1 <$> fextract s
806 extract (GroupByInit s) = fextract s
807 extract (GroupByGrouping _ s) = fextract s
809{-# ANN type GroupByStatePair Fuse #-}
810data GroupByStatePair a s1 s2
811 = GroupByInitPair !s1 !s2
812 | GroupByGroupingPair !a !s1 !s2
813 | GroupByGroupingPairL !a !s1 !s2
814 | GroupByGroupingPairR !a !s1 !s2
816{-# INLINE groupByRollingEither #-}
817groupByRollingEither :: MonadCatch m =>
818 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
819groupByRollingEither
820 eq
821 (Fold fstep1 finitial1 fextract1)
822 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
824 where
826 {-# INLINE grouper #-}
827 grouper s1 s2 a = do
828 return $ Continue 0 (GroupByGroupingPair a s1 s2)
830 {-# INLINE grouperL2 #-}
831 grouperL2 s1 s2 a = do
832 res <- fstep1 s1 a
833 return
834 $ case res of
835 FL.Done b -> Done 0 (Left b)
836 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
838 {-# INLINE grouperL #-}
839 grouperL s1 s2 a0 a = do
840 res <- fstep1 s1 a0
841 case res of
842 FL.Done b -> return $ Done 0 (Left b)
843 FL.Partial s11 -> grouperL2 s11 s2 a
845 {-# INLINE grouperR2 #-}
846 grouperR2 s1 s2 a = do
847 res <- fstep2 s2 a
848 return
849 $ case res of
850 FL.Done b -> Done 0 (Right b)
851 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
853 {-# INLINE grouperR #-}
854 grouperR s1 s2 a0 a = do
855 res <- fstep2 s2 a0
856 case res of
857 FL.Done b -> return $ Done 0 (Right b)
858 FL.Partial s21 -> grouperR2 s1 s21 a
860 initial = do
861 res1 <- finitial1
862 res2 <- finitial2
863 return
864 $ case res1 of
865 FL.Partial s1 ->
866 case res2 of
867 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
868 FL.Done b -> IDone (Right b)
869 FL.Done b -> IDone (Left b)
871 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
873 step (GroupByGroupingPair a0 s1 s2) a =
874 if not (eq a0 a)
875 then grouperL s1 s2 a0 a
876 else grouperR s1 s2 a0 a
878 step (GroupByGroupingPairL a0 s1 s2) a =
879 if not (eq a0 a)
880 then grouperL2 s1 s2 a
881 else Done 1 . Left <$> fextract1 s1
883 step (GroupByGroupingPairR a0 s1 s2) a =
884 if eq a0 a
885 then grouperR2 s1 s2 a
886 else Done 1 . Right <$> fextract2 s2
888 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
889 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
890 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
891 extract (GroupByGroupingPair a s1 _) = do
892 res <- fstep1 s1 a
893 case res of
894 FL.Done b -> return $ Left b
895 FL.Partial s11 -> Left <$> fextract1 s11
897-- XXX use an Unfold instead of a list?
898-- XXX custom combinators for matching list, array and stream?
899-- XXX rename to listBy?
900--
901-- | See 'Streamly.Internal.Data.Parser.eqBy'.
902--
903-- /Pre-release/
904--
905{-# INLINE eqBy #-}
906eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
907eqBy cmp str = Parser step initial extract
909 where
911 -- XXX Should return IDone in initial for [] case
912 initial = return $ IPartial str
914 step [] _ = return $ Done 0 ()
915 step [x] a =
916 return
917 $ if x `cmp` a
918 then Done 0 ()
919 else Error "eqBy: failed, yet to match the last element"
920 step (x:xs) a =
921 return
922 $ if x `cmp` a
923 then Continue 0 xs
924 else Error
925 $ "eqBy: failed, yet to match "
926 ++ show (length xs + 1) ++ " elements"
928 extract xs =
929 throwM
930 $ ParseError
931 $ "eqBy: end of input, yet to match "
932 ++ show (length xs) ++ " elements"
934-- XXX rename to streamBy?
935-- | Like eqBy but uses a stream instead of a list
936{-# INLINE matchBy #-}
937matchBy :: MonadThrow m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
938matchBy cmp (D.Stream sstep state) = Parser step initial extract
940 where
942 initial = do
943 r <- sstep defState state
944 case r of
945 D.Yield x s -> return $ IPartial (Just x, s)
946 D.Stop -> return $ IDone ()
947 -- Need Skip/Continue in initial to loop right here
948 D.Skip s -> return $ IPartial (Nothing, s)
950 step (Just x, st) a =
951 if x `cmp` a
952 then do
953 r <- sstep defState st
954 return
955 $ case r of
956 D.Yield x1 s -> Continue 0 (Just x1, s)
957 D.Stop -> Done 0 ()
958 D.Skip s -> Continue 1 (Nothing, s)
959 else return $ Error "match: mismtach occurred"
960 step (Nothing, st) a = do
961 r <- sstep defState st
962 return
963 $ case r of
964 D.Yield x s -> do
965 if x `cmp` a
966 then Continue 0 (Nothing, s)
967 else Error "match: mismatch occurred"
968 D.Stop -> Done 1 ()
969 D.Skip s -> Continue 1 (Nothing, s)
971 extract _ = throwM $ ParseError "match: end of input"
973--------------------------------------------------------------------------------
974--- Spanning
975--------------------------------------------------------------------------------
977-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
978-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
979-- input.
980--
981-- @
982-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
983--
984-- > span_ (< 1) [1,2,3]
985-- ([],[1,2,3])
986--
987-- > span_ (< 2) [1,2,3]
988-- ([1],[2,3])
989--
990-- > span_ (< 4) [1,2,3]
991-- ([1,2,3],[])
992--
993-- @
994--
995-- /Pre-release/
996{-# INLINE span #-}
997span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
998span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1000-- | Break the input stream into two groups, the first group takes the input as
1001-- long as the predicate applied to the first element of the stream and next
1002-- input element holds 'True', the second group takes the rest of the input.
1004-- /Pre-release/
1006{-# INLINE spanBy #-}
1007spanBy ::
1008 Monad m
1009 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1010spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1012-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1013-- predicate is applied to the previous and the next input elements.
1015-- /Pre-release/
1016{-# INLINE spanByRolling #-}
1017spanByRolling ::
1018 Monad m
1019 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1020spanByRolling eq f1 f2 =
1021 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1023-------------------------------------------------------------------------------
1024-- nested parsers
1025-------------------------------------------------------------------------------
1027-- | See 'Streamly.Internal.Data.Parser.takeP'.
1029-- /Internal/
1030{-# INLINE takeP #-}
1031takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1032takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1034 where
1036 initial = do
1037 res <- pinitial
1038 case res of
1039 IPartial s ->
1040 if lim > 0
1041 then return $ IPartial $ Tuple' 0 s
1042 else IDone <$> pextract s
1043 IDone b -> return $ IDone b
1044 IError e -> return $ IError e
1046 step (Tuple' cnt r) a = do
1047 assert (cnt < lim) (return ())
1048 res <- pstep r a
1049 let cnt1 = cnt + 1
1050 case res of
1051 Partial 0 s -> do
1052 assert (cnt1 >= 0) (return ())
1053 if cnt1 < lim
1054 then return $ Partial 0 $ Tuple' cnt1 s
1055 else Done 0 <$> pextract s
1056 Continue 0 s -> do
1057 assert (cnt1 >= 0) (return ())
1058 if cnt1 < lim
1059 then return $ Continue 0 $ Tuple' cnt1 s
1060 -- XXX This should error out?
1061 -- If designed properly, this will probably error out.
1062 -- "pextract" should error out
1063 --
1064 -- By Harendra,
1065 --
1066 -- This is a tricky case, we have the following options:
1067 -- 1. Done 0 with extract as you have written
1068 -- 2. Done n, will require buffering elements
1069 -- 3. Use a backtracking fold and not a parser, once we have
1070 -- backtracking in folds
1071 else Done 0 <$> pextract s
1072 Partial n s -> do
1073 let taken = cnt1 - n
1074 assert (taken >= 0) (return ())
1075 return $ Partial n $ Tuple' taken s
1076 Continue n s -> do
1077 let taken = cnt1 - n
1078 assert (taken >= 0) (return ())
1079 return $ Continue n $ Tuple' taken s
1080 Done n b -> return $ Done n b
1081 Error str -> return $ Error str
1083 extract (Tuple' _ r) = pextract r
1085-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1087-- /Pre-release/
1089{-# INLINE lookAhead #-}
1090lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1091lookAhead (Parser step1 initial1 _) = Parser step initial extract
1093 where
1095 initial = do
1096 res <- initial1
1097 return $ case res of
1098 IPartial s -> IPartial (Tuple' 0 s)
1099 IDone b -> IDone b
1100 IError e -> IError e
1102 step (Tuple' cnt st) a = do
1103 r <- step1 st a
1104 let cnt1 = cnt + 1
1105 return
1106 $ case r of
1107 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1108 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1109 Done _ b -> Done cnt1 b
1110 Error err -> Error err
1112 -- XXX returning an error let's us backtrack. To implement it in a way so
1113 -- that it terminates on eof without an error then we need a way to
1114 -- backtrack on eof, that will require extract to return 'Step' type.
1115 extract (Tuple' n _) =
1116 throwM
1117 $ ParseError
1118 $ "lookAhead: end of input after consuming "
1119 ++ show n ++ " elements"
1121-------------------------------------------------------------------------------
1122-- Interleaving
1123-------------------------------------------------------------------------------
1125-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1127-- /Unimplemented/
1129{-# INLINE deintercalate #-}
1130deintercalate ::
1131 -- Monad m =>
1132 Fold m a y -> Parser m x a
1133 -> Fold m b z -> Parser m x b
1134 -> Parser m x (y, z)
1135deintercalate = undefined
1137-------------------------------------------------------------------------------
1138-- Sequential Collection
1139-------------------------------------------------------------------------------
1141-- | See 'Streamly.Internal.Data.Parser.sequence'.
1143-- /Unimplemented/
1145{-# INLINE sequence #-}
1146sequence ::
1147 -- Foldable t =>
1148 Fold m b c -> t (Parser m a b) -> Parser m a c
1149sequence _f _p = undefined
1151-------------------------------------------------------------------------------
1152-- Alternative Collection
1153-------------------------------------------------------------------------------
1155-- | See 'Streamly.Internal.Data.Parser.choice'.
1157-- /Broken/
1159{-# INLINE choice #-}
1160choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
1161choice = foldl1 shortest
1163-------------------------------------------------------------------------------
1164-- Sequential Repetition
1165-------------------------------------------------------------------------------
1167-- | See 'Streamly.Internal.Data.Parser.many'.
1169-- /Pre-release/
1171{-# INLINE many #-}
1172many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1173many = splitMany
1174-- many = countBetween 0 maxBound
1176-- | See 'Streamly.Internal.Data.Parser.some'.
1178-- /Pre-release/
1180{-# INLINE some #-}
1181some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1182some = splitSome
1183-- some f p = many (takeGE 1 f) p
1184-- many = countBetween 1 maxBound
1186-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1188-- /Unimplemented/
1190{-# INLINE countBetween #-}
1191countBetween ::
1192 -- MonadCatch m =>
1193 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1194countBetween _m _n _p = undefined
1195-- countBetween m n p f = many (takeBetween m n f) p
1197-- | See 'Streamly.Internal.Data.Parser.count'.
1199-- /Unimplemented/
1201{-# INLINE count #-}
1202count ::
1203 -- MonadCatch m =>
1204 Int -> Parser m a b -> Fold m b c -> Parser m a c
1205count n = countBetween n n
1206-- count n f p = many (takeEQ n f) p
1208data ManyTillState fs sr sl
1209 = ManyTillR Int fs sr
1210 | ManyTillL Int fs sl
1212-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1214-- /Pre-release/
1216{-# INLINE manyTill #-}
1217manyTill :: MonadCatch m
1218 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1219manyTill (Fold fstep finitial fextract)
1220 (Parser stepL initialL extractL)
1221 (Parser stepR initialR _) =
1222 Parser step initial extract
1224 where
1226 -- Caution: Mutual recursion
1228 scrutL fs p c d e = do
1229 resL <- initialL
1230 case resL of
1231 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1232 IDone bl -> do
1233 fr <- fstep fs bl
1234 case fr of
1235 FL.Partial fs1 -> scrutR fs1 p c d e
1236 FL.Done fb -> return $ d fb
1237 IError err -> return $ e err
1239 scrutR fs p c d e = do
1240 resR <- initialR
1241 case resR of
1242 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1243 IDone _ -> d <$> fextract fs
1244 IError _ -> scrutL fs p c d e
1246 initial = do
1247 res <- finitial
1248 case res of
1249 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1250 FL.Done b -> return $ IDone b
1252 step (ManyTillR cnt fs st) a = do
1253 r <- stepR st a
1254 case r of
1255 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1256 Continue n s -> do
1257 assert (cnt + 1 - n >= 0) (return ())
1258 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1259 Done n _ -> do
1260 b <- fextract fs
1261 return $ Done n b
1262 Error _ -> do
1263 resL <- initialL
1264 case resL of
1265 IPartial sl ->
1266 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1267 IDone bl -> do
1268 fr <- fstep fs bl
1269 let cnt1 = cnt + 1
1270 p = Partial cnt
1271 c = Continue cnt
1272 d = Done cnt
1273 case fr of
1274 FL.Partial fs1 -> scrutR fs1 p c d Error
1275 FL.Done fb -> return $ Done cnt1 fb
1276 IError err -> return $ Error err
1277 -- XXX the cnt is being used only by the assert
1278 step (ManyTillL cnt fs st) a = do
1279 r <- stepL st a
1280 case r of
1281 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1282 Continue n s -> do
1283 assert (cnt + 1 - n >= 0) (return ())
1284 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1285 Done n b -> do
1286 fs1 <- fstep fs b
1287 case fs1 of
1288 FL.Partial s ->
1289 scrutR s (Partial n) (Continue n) (Done n) Error
1290 FL.Done b1 -> return $ Done n b1
1291 Error err -> return $ Error err
1293 extract (ManyTillL _ fs sR) = do
1294 res <- extractL sR >>= fstep fs
1295 case res of
1296 FL.Partial s -> fextract s
1297 FL.Done b -> return b
1298 extract (ManyTillR _ fs _) = fextract fs