git.iko.soy/streamly
on 31b599f help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
1303 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 -- * 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)
59 --
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
67 -- Grab a sequence of input elements by inspecting them
68 , takeP
69 , lookAhead
70 , takeWhile
71 , takeWhile1
72 , sliceSepByP
73 -- , sliceSepByBetween
74 , sliceBeginWith
75 -- , sliceSepWith
76 --
77 -- , frameSepBy -- parse frames escaped by an escape char/sequence
78 -- , frameEndWith
79 --
80 , wordBy
81 , groupBy
82 , groupByRolling
83 , groupByRollingEither
84 , eqBy
85 , matchBy
86 -- , prefixOf -- match any prefix of a given string
87 -- , suffixOf -- match any suffix of a given string
88 -- , infixOf -- match any substring of a given string
90 -- ** Spanning
91 , span
92 , spanBy
93 , spanByRolling
95 -- Second order parsers (parsers using parsers)
96 -- * Binary Combinators
98 -- ** Sequential Applicative
99 , serialWith
100 , split_
102 -- ** Parallel Applicatives
103 , teeWith
104 , teeWithFst
105 , teeWithMin
106 -- , teeTill -- like manyTill but parallel
108 -- ** Sequential Interleaving
109 -- Use two folds, run a primary parser, its rejected values go to the
110 -- secondary parser.
111 , deintercalate
113 -- ** Sequential Alternative
114 , alt
116 -- ** Parallel Alternatives
117 , shortest
118 , longest
119 -- , fastest
121 -- * N-ary Combinators
122 -- ** Sequential Collection
123 , sequence
124 , concatMap
126 -- ** Sequential Repetition
127 , count
128 , countBetween
129 -- , countBetweenTill
131 , many
132 , some
133 , manyTill
135 -- -- ** Special cases
136 -- XXX traditional implmentations of these may be of limited use. For
137 -- example, consider parsing lines separated by "\r\n". The main parser
138 -- will have to detect and exclude the sequence "\r\n" anyway so that we
139 -- can apply the "sep" parser.
140 --
141 -- We can instead implement these as special cases of deintercalate.
142 --
143 -- , endBy
144 -- , sepBy
145 -- , sepEndBy
146 -- , beginBy
147 -- , sepBeginBy
148 -- , sepAroundBy
150 -- -- * Distribution
151 --
152 -- A simple and stupid impl would be to just convert the stream to an array
153 -- and give the array reference to all consumers. The array can be grown on
154 -- demand by any consumer and truncated when nonbody needs it.
155 --
156 -- -- ** Distribute to collection
157 -- -- ** Distribute to repetition
159 -- -- ** Interleaved collection
160 -- Round robin
161 -- Priority based
162 -- -- ** Interleaved repetition
163 -- repeat one parser and when it fails run an error recovery parser
164 -- e.g. to find a key frame in the stream after an error
166 -- ** Collection of Alternatives
167 -- , shortestN
168 -- , longestN
169 -- , fastestN -- first N successful in time
170 -- , choiceN -- first N successful in position
171 , choice -- first successful in position
173 -- -- ** Repeated Alternatives
174 -- , retryMax -- try N times
175 -- , retryUntil -- try until successful
176 -- , retryUntilN -- try until successful n times
177 )
178where
180import Control.Exception (assert, Exception)
181import Control.Monad (when)
182import Control.Monad.Catch (MonadCatch, MonadThrow(..))
183import Fusion.Plugin.Types (Fuse(..))
184import Streamly.Internal.Data.Fold.Type (Fold(..))
185import Streamly.Internal.Data.SVar.Type (defState)
186import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
188import qualified Streamly.Internal.Data.Fold.Type as FL
189import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
191import Prelude hiding
192 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
193import Streamly.Internal.Data.Parser.ParserD.Tee
194import Streamly.Internal.Data.Parser.ParserD.Type
196--
197-- $setup
198-- >>> :m
199-- >>> :set -package streamly
200-- >>> import Prelude hiding ()
201-- >>> import qualified Streamly.Prelude as Stream
202-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
203-- >>> import qualified Streamly.Data.Fold as Fold
204-- >>> import qualified Streamly.Internal.Data.Parser as Parser
206-------------------------------------------------------------------------------
207-- Downgrade a parser to a Fold
208-------------------------------------------------------------------------------
210data ParserToFoldError =
211 InitialError String
212 | PartialError Int
213 | ContinueError Int
214 | DoneError Int
215 | ErrorError String
216 deriving Show
218instance Exception ParserToFoldError
220-- | See 'Streamly.Internal.Data.Parser.toFold'.
221--
222-- /Internal/
223--
224{-# INLINE toFold #-}
225toFold :: MonadThrow m => Parser m a b -> Fold m a b
226toFold (Parser pstep pinitial pextract) = Fold step initial pextract
228 where
230 initial = do
231 r <- pinitial
232 case r of
233 IPartial s -> return $ FL.Partial s
234 IDone b -> return $ FL.Done b
235 IError err -> throwM $ InitialError err
237 step st a = do
238 r <- pstep st a
239 case r of
240 Partial 0 s -> return $ FL.Partial s
241 Continue 0 s -> return $ FL.Partial s
242 Done 0 b -> return $ FL.Done b
243 Partial n _ -> throwM $ PartialError n
244 Continue n _ -> throwM $ ContinueError n
245 Done n _ -> throwM $ DoneError n
246 Error err -> throwM $ ErrorError err
248-------------------------------------------------------------------------------
249-- Upgrade folds to parses
250-------------------------------------------------------------------------------
251--
252-- | See 'Streamly.Internal.Data.Parser.fromFold'.
253--
254-- /Pre-release/
255--
256{-# INLINE fromFold #-}
257fromFold :: Monad m => Fold m a b -> Parser m a b
258fromFold (Fold fstep finitial fextract) = Parser step initial fextract
260 where
262 initial = do
263 res <- finitial
264 return
265 $ case res of
266 FL.Partial s1 -> IPartial s1
267 FL.Done b -> IDone b
269 step s a = do
270 res <- fstep s a
271 return
272 $ case res of
273 FL.Partial s1 -> Partial 0 s1
274 FL.Done b -> Done 0 b
276-------------------------------------------------------------------------------
277-- Failing Parsers
278-------------------------------------------------------------------------------
280-- | See 'Streamly.Internal.Data.Parser.peek'.
281--
282-- /Pre-release/
283--
284{-# INLINE peek #-}
285peek :: MonadThrow m => Parser m a a
286peek = Parser step initial extract
288 where
290 initial = return $ IPartial ()
292 step () a = return $ Done 1 a
294 extract () = throwM $ ParseError "peek: end of input"
296-- | See 'Streamly.Internal.Data.Parser.eof'.
297--
298-- /Pre-release/
299--
300{-# INLINE eof #-}
301eof :: Monad m => Parser m a ()
302eof = Parser step initial return
304 where
306 initial = return $ IPartial ()
308 step () _ = return $ Error "eof: not at end of input"
310-- | See 'Streamly.Internal.Data.Parser.satisfy'.
311--
312-- /Pre-release/
313--
314{-# INLINE satisfy #-}
315satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
316satisfy predicate = Parser step initial extract
318 where
320 initial = return $ IPartial ()
322 step () a = return $
323 if predicate a
324 then Done 0 a
325 else Error "satisfy: predicate failed"
327 extract _ = throwM $ ParseError "satisfy: end of input"
329-- | See 'Streamly.Internal.Data.Parser.next'.
330--
331-- /Pre-release/
332--
333{-# INLINE next #-}
334next :: Monad m => Parser m a (Maybe a)
335next = Parser step initial extract
336 where
337 initial = pure $ IPartial ()
338 step _ a = pure $ Done 0 (Just a)
339 extract _ = pure Nothing
341-- | See 'Streamly.Internal.Data.Parser.maybe'.
342--
343-- /Pre-release/
344--
345{-# INLINE maybe #-}
346maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
347maybe parserF = Parser step initial extract
349 where
351 initial = return $ IPartial ()
353 step () a = return $
354 case parserF a of
355 Just b -> Done 0 b
356 Nothing -> Error "maybe: predicate failed"
358 extract _ = throwM $ ParseError "maybe: end of input"
360-- | See 'Streamly.Internal.Data.Parser.either'.
361--
362-- /Pre-release/
363--
364{-# INLINE either #-}
365either :: MonadThrow m => (a -> Either String b) -> Parser m a b
366either parserF = Parser step initial extract
368 where
370 initial = return $ IPartial ()
372 step () a = return $
373 case parserF a of
374 Right b -> Done 0 b
375 Left err -> Error $ "either: " ++ err
377 extract _ = throwM $ ParseError "either: end of input"
379-------------------------------------------------------------------------------
380-- Taking elements
381-------------------------------------------------------------------------------
383-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
384{-# ANN type Tuple'Fused Fuse #-}
385data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
387-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
388--
389-- /Pre-release/
390--
391{-# INLINE takeBetween #-}
392takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
393takeBetween low high (Fold fstep finitial fextract) =
395 Parser step initial (extract streamErr)
397 where
399 streamErr i =
400 "takeBetween: Expecting alteast " ++ show low
401 ++ " elements, got " ++ show i
403 invalidRange =
404 "takeBetween: lower bound - " ++ show low
405 ++ " is greater than higher bound - " ++ show high
407 foldErr :: Int -> String
408 foldErr i =
409 "takeBetween: the collecting fold terminated after"
410 ++ " consuming" ++ show i ++ " elements"
411 ++ " minimum" ++ show low ++ " elements needed"
413 -- Exactly the same as snext except different constructors, we can possibly
414 -- deduplicate the two.
415 {-# INLINE inext #-}
416 inext i res =
417 let i1 = i + 1
418 in case res of
419 FL.Partial s -> do
420 let s1 = Tuple'Fused i1 s
421 if i1 < high
422 -- XXX ideally this should be a Continue instead
423 then return $ IPartial s1
424 else IDone <$> extract foldErr s1
425 FL.Done b ->
426 return
427 $ if i1 >= low
428 then IDone b
429 else IError (foldErr i1)
431 initial = do
432 when (low >= 0 && high >= 0 && low > high)
433 $ throwM $ ParseError invalidRange
435 finitial >>= inext (-1)
437 -- Keep the impl same as inext
438 {-# INLINE snext #-}
439 snext i res =
440 let i1 = i + 1
441 in case res of
442 FL.Partial s -> do
443 let s1 = Tuple'Fused i1 s
444 if i1 < high
445 then return $ Continue 0 s1
446 else Done 0 <$> extract foldErr s1
447 FL.Done b ->
448 return
449 $ if i1 >= low
450 then Done 0 b
451 else Error (foldErr i1)
453 step (Tuple'Fused i s) a = fstep s a >>= snext i
455 extract f (Tuple'Fused i s)
456 | i >= low && i <= high = fextract s
457 | otherwise = throwM $ ParseError (f i)
459-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
460--
461-- /Pre-release/
462--
463{-# INLINE takeEQ #-}
464takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
465takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
467 where
469 cnt = max n 0
471 initial = do
472 res <- finitial
473 return $ case res of
474 FL.Partial s -> IPartial $ Tuple' 0 s
475 FL.Done b ->
476 if cnt == 0
477 then IDone b
478 else IError
479 $ "takeEQ: Expecting exactly " ++ show cnt
480 ++ " elements, fold terminated without"
481 ++ " consuming any elements"
483 step (Tuple' i r) a
484 | i1 < cnt = do
485 res <- fstep r a
486 return
487 $ case res of
488 FL.Partial s -> Continue 0 $ Tuple' i1 s
489 FL.Done _ ->
490 Error
491 $ "takeEQ: Expecting exactly " ++ show cnt
492 ++ " elements, fold terminated on " ++ show i1
493 | i1 == cnt = do
494 res <- fstep r a
495 Done 0
496 <$> case res of
497 FL.Partial s -> fextract s
498 FL.Done b -> return b
499 -- XXX we should not reach here when initial returns Step type
500 -- reachable only when n == 0
501 | otherwise = Done 1 <$> fextract r
503 where
505 i1 = i + 1
507 extract (Tuple' i r)
508 | i == 0 && cnt == 0 = fextract r
509 | otherwise =
510 throwM
511 $ ParseError
512 $ "takeEQ: Expecting exactly " ++ show cnt
513 ++ " elements, input terminated on " ++ show i
515-- | See 'Streamly.Internal.Data.Parser.takeGE'.
516--
517-- /Pre-release/
518--
519{-# INLINE takeGE #-}
520takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
521takeGE n (Fold fstep finitial fextract) = Parser step initial extract
523 where
525 cnt = max n 0
526 initial = do
527 res <- finitial
528 return $ case res of
529 FL.Partial s -> IPartial $ Tuple' 0 s
530 FL.Done b ->
531 if cnt == 0
532 then IDone b
533 else IError
534 $ "takeGE: Expecting at least " ++ show cnt
535 ++ " elements, fold terminated without"
536 ++ " consuming any elements"
538 step (Tuple' i r) a
539 | i1 < cnt = do
540 res <- fstep r a
541 return
542 $ case res of
543 FL.Partial s -> Continue 0 $ Tuple' i1 s
544 FL.Done _ ->
545 Error
546 $ "takeGE: Expecting at least " ++ show cnt
547 ++ " elements, fold terminated on " ++ show i1
548 | otherwise = do
549 res <- fstep r a
550 return
551 $ case res of
552 FL.Partial s -> Partial 0 $ Tuple' i1 s
553 FL.Done b -> Done 0 b
555 where
557 i1 = i + 1
559 extract (Tuple' i r)
560 | i >= cnt = fextract r
561 | otherwise =
562 throwM
563 $ ParseError
564 $ "takeGE: Expecting at least " ++ show cnt
565 ++ " elements, input terminated on " ++ show i
567-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
568--
569-- /Pre-release/
570--
571{-# INLINE takeWhile #-}
572takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
573takeWhile predicate (Fold fstep finitial fextract) =
574 Parser step initial fextract
576 where
578 initial = do
579 res <- finitial
580 return $ case res of
581 FL.Partial s -> IPartial s
582 FL.Done b -> IDone b
584 step s a =
585 if predicate a
586 then do
587 fres <- fstep s a
588 return
589 $ case fres of
590 FL.Partial s1 -> Partial 0 s1
591 FL.Done b -> Done 0 b
592 else Done 1 <$> fextract s
594-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
595--
596-- /Pre-release/
597--
598{-# INLINE takeWhile1 #-}
599takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
600takeWhile1 predicate (Fold fstep finitial fextract) =
601 Parser step initial extract
603 where
605 initial = do
606 res <- finitial
607 return $ case res of
608 FL.Partial s -> IPartial (Left s)
609 FL.Done _ ->
610 IError
611 $ "takeWhile1: fold terminated without consuming:"
612 ++ " any element"
614 {-# INLINE process #-}
615 process s a = do
616 res <- fstep s a
617 return
618 $ case res of
619 FL.Partial s1 -> Partial 0 (Right s1)
620 FL.Done b -> Done 0 b
622 step (Left s) a =
623 if predicate a
624 then process s a
625 else return $ Error "takeWhile1: predicate failed on first element"
626 step (Right s) a =
627 if predicate a
628 then process s a
629 else do
630 b <- fextract s
631 return $ Done 1 b
633 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
634 extract (Right s) = fextract s
636-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
637--
638-- /Pre-release/
639--
640sliceSepByP :: MonadCatch m =>
641 (a -> Bool) -> Parser m a b -> Parser m a b
642sliceSepByP cond (Parser pstep pinitial pextract) =
644 Parser step initial pextract
646 where
648 initial = pinitial
650 step s a =
651 if cond a
652 then do
653 res <- pextract s
654 return $ Done 0 res
655 else pstep s a
657-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
658--
659-- /Pre-release/
660--
661data SliceBeginWithState s = Left' s | Right' s
663{-# INLINE sliceBeginWith #-}
664sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
665sliceBeginWith cond (Fold fstep finitial fextract) =
667 Parser step initial extract
669 where
671 initial = do
672 res <- finitial
673 return $
674 case res of
675 FL.Partial s -> IPartial (Left' s)
676 FL.Done _ -> IError "sliceBeginWith : bad finitial"
678 {-# INLINE process #-}
679 process s a = do
680 res <- fstep s a
681 return
682 $ case res of
683 FL.Partial s1 -> Partial 0 (Right' s1)
684 FL.Done b -> Done 0 b
686 step (Left' s) a =
687 if cond a
688 then process s a
689 else error $ "sliceBeginWith : slice begins with an element which "
690 ++ "fails the predicate"
691 step (Right' s) a =
692 if not (cond a)
693 then process s a
694 else Done 1 <$> fextract s
696 extract (Left' s) = fextract s
697 extract (Right' s) = fextract s
699data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
701-- | See 'Streamly.Internal.Data.Parser.wordBy'.
702--
703--
704{-# INLINE wordBy #-}
705wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
706wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
708 where
710 {-# INLINE worder #-}
711 worder s a = do
712 res <- fstep s a
713 return
714 $ case res of
715 FL.Partial s1 -> Partial 0 $ WBWord s1
716 FL.Done b -> Done 0 b
718 initial = do
719 res <- finitial
720 return
721 $ case res of
722 FL.Partial s -> IPartial $ WBLeft s
723 FL.Done b -> IDone b
725 step (WBLeft s) a =
726 if not (predicate a)
727 then worder s a
728 else return $ Partial 0 $ WBLeft s
729 step (WBWord s) a =
730 if not (predicate a)
731 then worder s a
732 else do
733 b <- fextract s
734 return $ Partial 0 $ WBRight b
735 step (WBRight b) a =
736 return
737 $ if not (predicate a)
738 then Done 1 b
739 else Partial 0 $ WBRight b
741 extract (WBLeft s) = fextract s
742 extract (WBWord s) = fextract s
743 extract (WBRight b) = return b
745{-# ANN type GroupByState Fuse #-}
746data GroupByState a s
747 = GroupByInit !s
748 | GroupByGrouping !a !s
750-- | See 'Streamly.Internal.Data.Parser.groupBy'.
751--
752{-# INLINE groupBy #-}
753groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
754groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
756 where
758 {-# INLINE grouper #-}
759 grouper s a0 a = do
760 res <- fstep s a
761 return
762 $ case res of
763 FL.Done b -> Done 0 b
764 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
766 initial = do
767 res <- finitial
768 return
769 $ case res of
770 FL.Partial s -> IPartial $ GroupByInit s
771 FL.Done b -> IDone b
773 step (GroupByInit s) a = grouper s a a
774 step (GroupByGrouping a0 s) a =
775 if eq a0 a
776 then grouper s a0 a
777 else Done 1 <$> fextract s
779 extract (GroupByInit s) = fextract s
780 extract (GroupByGrouping _ s) = fextract s
782-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
783--
784{-# INLINE groupByRolling #-}
785groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
786groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
788 where
790 {-# INLINE grouper #-}
791 grouper s a = do
792 res <- fstep s a
793 return
794 $ case res of
795 FL.Done b -> Done 0 b
796 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
798 initial = do
799 res <- finitial
800 return
801 $ case res of
802 FL.Partial s -> IPartial $ GroupByInit s
803 FL.Done b -> IDone b
805 step (GroupByInit s) a = grouper s a
806 step (GroupByGrouping a0 s) a =
807 if eq a0 a
808 then grouper s a
809 else Done 1 <$> fextract s
811 extract (GroupByInit s) = fextract s
812 extract (GroupByGrouping _ s) = fextract s
814{-# ANN type GroupByStatePair Fuse #-}
815data GroupByStatePair a s1 s2
816 = GroupByInitPair !s1 !s2
817 | GroupByGroupingPair !a !s1 !s2
818 | GroupByGroupingPairL !a !s1 !s2
819 | GroupByGroupingPairR !a !s1 !s2
821{-# INLINE groupByRollingEither #-}
822groupByRollingEither :: MonadCatch m =>
823 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
824groupByRollingEither
825 eq
826 (Fold fstep1 finitial1 fextract1)
827 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
829 where
831 {-# INLINE grouper #-}
832 grouper s1 s2 a = do
833 return $ Continue 0 (GroupByGroupingPair a s1 s2)
835 {-# INLINE grouperL2 #-}
836 grouperL2 s1 s2 a = do
837 res <- fstep1 s1 a
838 return
839 $ case res of
840 FL.Done b -> Done 0 (Left b)
841 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
843 {-# INLINE grouperL #-}
844 grouperL s1 s2 a0 a = do
845 res <- fstep1 s1 a0
846 case res of
847 FL.Done b -> return $ Done 0 (Left b)
848 FL.Partial s11 -> grouperL2 s11 s2 a
850 {-# INLINE grouperR2 #-}
851 grouperR2 s1 s2 a = do
852 res <- fstep2 s2 a
853 return
854 $ case res of
855 FL.Done b -> Done 0 (Right b)
856 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
858 {-# INLINE grouperR #-}
859 grouperR s1 s2 a0 a = do
860 res <- fstep2 s2 a0
861 case res of
862 FL.Done b -> return $ Done 0 (Right b)
863 FL.Partial s21 -> grouperR2 s1 s21 a
865 initial = do
866 res1 <- finitial1
867 res2 <- finitial2
868 return
869 $ case res1 of
870 FL.Partial s1 ->
871 case res2 of
872 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
873 FL.Done b -> IDone (Right b)
874 FL.Done b -> IDone (Left b)
876 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
878 step (GroupByGroupingPair a0 s1 s2) a =
879 if not (eq a0 a)
880 then grouperL s1 s2 a0 a
881 else grouperR s1 s2 a0 a
883 step (GroupByGroupingPairL a0 s1 s2) a =
884 if not (eq a0 a)
885 then grouperL2 s1 s2 a
886 else Done 1 . Left <$> fextract1 s1
888 step (GroupByGroupingPairR a0 s1 s2) a =
889 if eq a0 a
890 then grouperR2 s1 s2 a
891 else Done 1 . Right <$> fextract2 s2
893 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
894 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
895 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
896 extract (GroupByGroupingPair a s1 _) = do
897 res <- fstep1 s1 a
898 case res of
899 FL.Done b -> return $ Left b
900 FL.Partial s11 -> Left <$> fextract1 s11
902-- XXX use an Unfold instead of a list?
903-- XXX custom combinators for matching list, array and stream?
904-- XXX rename to listBy?
905--
906-- | See 'Streamly.Internal.Data.Parser.eqBy'.
907--
908-- /Pre-release/
909--
910{-# INLINE eqBy #-}
911eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
912eqBy cmp str = Parser step initial extract
914 where
916 -- XXX Should return IDone in initial for [] case
917 initial = return $ IPartial str
919 step [] _ = return $ Done 0 ()
920 step [x] a =
921 return
922 $ if x `cmp` a
923 then Done 0 ()
924 else Error "eqBy: failed, yet to match the last element"
925 step (x:xs) a =
926 return
927 $ if x `cmp` a
928 then Continue 0 xs
929 else Error
930 $ "eqBy: failed, yet to match "
931 ++ show (length xs + 1) ++ " elements"
933 extract xs =
934 throwM
935 $ ParseError
936 $ "eqBy: end of input, yet to match "
937 ++ show (length xs) ++ " elements"
939-- XXX rename to streamBy?
940-- | Like eqBy but uses a stream instead of a list
941{-# INLINE matchBy #-}
942matchBy :: MonadThrow m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
943matchBy cmp (D.Stream sstep state) = Parser step initial extract
945 where
947 initial = do
948 r <- sstep defState state
949 case r of
950 D.Yield x s -> return $ IPartial (Just x, s)
951 D.Stop -> return $ IDone ()
952 -- Need Skip/Continue in initial to loop right here
953 D.Skip s -> return $ IPartial (Nothing, s)
955 step (Just x, st) a =
956 if x `cmp` a
957 then do
958 r <- sstep defState st
959 return
960 $ case r of
961 D.Yield x1 s -> Continue 0 (Just x1, s)
962 D.Stop -> Done 0 ()
963 D.Skip s -> Continue 1 (Nothing, s)
964 else return $ Error "match: mismtach occurred"
965 step (Nothing, st) a = do
966 r <- sstep defState st
967 return
968 $ case r of
969 D.Yield x s -> do
970 if x `cmp` a
971 then Continue 0 (Nothing, s)
972 else Error "match: mismatch occurred"
973 D.Stop -> Done 1 ()
974 D.Skip s -> Continue 1 (Nothing, s)
976 extract _ = throwM $ ParseError "match: end of input"
978--------------------------------------------------------------------------------
979--- Spanning
980--------------------------------------------------------------------------------
982-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
983-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
984-- input.
985--
986-- @
987-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
988--
989-- > span_ (< 1) [1,2,3]
990-- ([],[1,2,3])
991--
992-- > span_ (< 2) [1,2,3]
993-- ([1],[2,3])
994--
995-- > span_ (< 4) [1,2,3]
996-- ([1,2,3],[])
997--
998-- @
999--
1000-- /Pre-release/
1001{-# INLINE span #-}
1002span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1003span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1005-- | Break the input stream into two groups, the first group takes the input as
1006-- long as the predicate applied to the first element of the stream and next
1007-- input element holds 'True', the second group takes the rest of the input.
1009-- /Pre-release/
1011{-# INLINE spanBy #-}
1012spanBy ::
1013 Monad m
1014 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1015spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1017-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1018-- predicate is applied to the previous and the next input elements.
1020-- /Pre-release/
1021{-# INLINE spanByRolling #-}
1022spanByRolling ::
1023 Monad m
1024 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1025spanByRolling eq f1 f2 =
1026 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1028-------------------------------------------------------------------------------
1029-- nested parsers
1030-------------------------------------------------------------------------------
1032-- | See 'Streamly.Internal.Data.Parser.takeP'.
1034-- /Internal/
1035{-# INLINE takeP #-}
1036takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1037takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1039 where
1041 initial = do
1042 res <- pinitial
1043 case res of
1044 IPartial s ->
1045 if lim > 0
1046 then return $ IPartial $ Tuple' 0 s
1047 else IDone <$> pextract s
1048 IDone b -> return $ IDone b
1049 IError e -> return $ IError e
1051 step (Tuple' cnt r) a = do
1052 assert (cnt < lim) (return ())
1053 res <- pstep r a
1054 let cnt1 = cnt + 1
1055 case res of
1056 Partial 0 s -> do
1057 assert (cnt1 >= 0) (return ())
1058 if cnt1 < lim
1059 then return $ Partial 0 $ Tuple' cnt1 s
1060 else Done 0 <$> pextract s
1061 Continue 0 s -> do
1062 assert (cnt1 >= 0) (return ())
1063 if cnt1 < lim
1064 then return $ Continue 0 $ Tuple' cnt1 s
1065 -- XXX This should error out?
1066 -- If designed properly, this will probably error out.
1067 -- "pextract" should error out
1068 --
1069 -- By Harendra,
1070 --
1071 -- This is a tricky case, we have the following options:
1072 -- 1. Done 0 with extract as you have written
1073 -- 2. Done n, will require buffering elements
1074 -- 3. Use a backtracking fold and not a parser, once we have
1075 -- backtracking in folds
1076 else Done 0 <$> pextract s
1077 Partial n s -> do
1078 let taken = cnt1 - n
1079 assert (taken >= 0) (return ())
1080 return $ Partial n $ Tuple' taken s
1081 Continue n s -> do
1082 let taken = cnt1 - n
1083 assert (taken >= 0) (return ())
1084 return $ Continue n $ Tuple' taken s
1085 Done n b -> return $ Done n b
1086 Error str -> return $ Error str
1088 extract (Tuple' _ r) = pextract r
1090-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1092-- /Pre-release/
1094{-# INLINE lookAhead #-}
1095lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1096lookAhead (Parser step1 initial1 _) = Parser step initial extract
1098 where
1100 initial = do
1101 res <- initial1
1102 return $ case res of
1103 IPartial s -> IPartial (Tuple' 0 s)
1104 IDone b -> IDone b
1105 IError e -> IError e
1107 step (Tuple' cnt st) a = do
1108 r <- step1 st a
1109 let cnt1 = cnt + 1
1110 return
1111 $ case r of
1112 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1113 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1114 Done _ b -> Done cnt1 b
1115 Error err -> Error err
1117 -- XXX returning an error let's us backtrack. To implement it in a way so
1118 -- that it terminates on eof without an error then we need a way to
1119 -- backtrack on eof, that will require extract to return 'Step' type.
1120 extract (Tuple' n _) =
1121 throwM
1122 $ ParseError
1123 $ "lookAhead: end of input after consuming "
1124 ++ show n ++ " elements"
1126-------------------------------------------------------------------------------
1127-- Interleaving
1128-------------------------------------------------------------------------------
1130-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1132-- /Unimplemented/
1134{-# INLINE deintercalate #-}
1135deintercalate ::
1136 -- Monad m =>
1137 Fold m a y -> Parser m x a
1138 -> Fold m b z -> Parser m x b
1139 -> Parser m x (y, z)
1140deintercalate = undefined
1142-------------------------------------------------------------------------------
1143-- Sequential Collection
1144-------------------------------------------------------------------------------
1146-- | See 'Streamly.Internal.Data.Parser.sequence'.
1148-- /Unimplemented/
1150{-# INLINE sequence #-}
1151sequence ::
1152 -- Foldable t =>
1153 Fold m b c -> t (Parser m a b) -> Parser m a c
1154sequence _f _p = undefined
1156-------------------------------------------------------------------------------
1157-- Alternative Collection
1158-------------------------------------------------------------------------------
1160-- | See 'Streamly.Internal.Data.Parser.choice'.
1162-- /Broken/
1164{-# INLINE choice #-}
1165choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
1166choice = foldl1 shortest
1168-------------------------------------------------------------------------------
1169-- Sequential Repetition
1170-------------------------------------------------------------------------------
1172-- | See 'Streamly.Internal.Data.Parser.many'.
1174-- /Pre-release/
1176{-# INLINE many #-}
1177many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1178many = splitMany
1179-- many = countBetween 0 maxBound
1181-- | See 'Streamly.Internal.Data.Parser.some'.
1183-- /Pre-release/
1185{-# INLINE some #-}
1186some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1187some = splitSome
1188-- some f p = many (takeGE 1 f) p
1189-- many = countBetween 1 maxBound
1191-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1193-- /Unimplemented/
1195{-# INLINE countBetween #-}
1196countBetween ::
1197 -- MonadCatch m =>
1198 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1199countBetween _m _n _p = undefined
1200-- countBetween m n p f = many (takeBetween m n f) p
1202-- | See 'Streamly.Internal.Data.Parser.count'.
1204-- /Unimplemented/
1206{-# INLINE count #-}
1207count ::
1208 -- MonadCatch m =>
1209 Int -> Parser m a b -> Fold m b c -> Parser m a c
1210count n = countBetween n n
1211-- count n f p = many (takeEQ n f) p
1213data ManyTillState fs sr sl
1214 = ManyTillR Int fs sr
1215 | ManyTillL Int fs sl
1217-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1219-- /Pre-release/
1221{-# INLINE manyTill #-}
1222manyTill :: MonadCatch m
1223 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1224manyTill (Fold fstep finitial fextract)
1225 (Parser stepL initialL extractL)
1226 (Parser stepR initialR _) =
1227 Parser step initial extract
1229 where
1231 -- Caution: Mutual recursion
1233 scrutL fs p c d e = do
1234 resL <- initialL
1235 case resL of
1236 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1237 IDone bl -> do
1238 fr <- fstep fs bl
1239 case fr of
1240 FL.Partial fs1 -> scrutR fs1 p c d e
1241 FL.Done fb -> return $ d fb
1242 IError err -> return $ e err
1244 scrutR fs p c d e = do
1245 resR <- initialR
1246 case resR of
1247 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1248 IDone _ -> d <$> fextract fs
1249 IError _ -> scrutL fs p c d e
1251 initial = do
1252 res <- finitial
1253 case res of
1254 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1255 FL.Done b -> return $ IDone b
1257 step (ManyTillR cnt fs st) a = do
1258 r <- stepR st a
1259 case r of
1260 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1261 Continue n s -> do
1262 assert (cnt + 1 - n >= 0) (return ())
1263 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1264 Done n _ -> do
1265 b <- fextract fs
1266 return $ Done n b
1267 Error _ -> do
1268 resL <- initialL
1269 case resL of
1270 IPartial sl ->
1271 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1272 IDone bl -> do
1273 fr <- fstep fs bl
1274 let cnt1 = cnt + 1
1275 p = Partial cnt
1276 c = Continue cnt
1277 d = Done cnt
1278 case fr of
1279 FL.Partial fs1 -> scrutR fs1 p c d Error
1280 FL.Done fb -> return $ Done cnt1 fb
1281 IError err -> return $ Error err
1282 -- XXX the cnt is being used only by the assert
1283 step (ManyTillL cnt fs st) a = do
1284 r <- stepL st a
1285 case r of
1286 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1287 Continue n s -> do
1288 assert (cnt + 1 - n >= 0) (return ())
1289 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1290 Done n b -> do
1291 fs1 <- fstep fs b
1292 case fs1 of
1293 FL.Partial s ->
1294 scrutR s (Partial n) (Continue n) (Done n) Error
1295 FL.Done b1 -> return $ Done n b1
1296 Error err -> return $ Error err
1298 extract (ManyTillL _ fs sR) = do
1299 res <- extractL sR >>= fstep fs
1300 case res of
1301 FL.Partial s -> fextract s
1302 FL.Done b -> return b
1303 extract (ManyTillR _ fs _) = fextract fs