git.iko.soy/streamly
on aaa775b help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
1254 lines 36 kB history raw
1#include "inline.hs"
3-- |
4-- Module : Streamly.Internal.Data.Parser.ParserD
5-- Copyright : (c) 2020 Composewell Technologies
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
10--
11-- Direct style parser implementation with stream fusion.
13module Streamly.Internal.Data.Parser.ParserD
14 (
15 Parser (..)
16 , ParseError (..)
17 , Step (..)
18 , Initial (..)
19 , rmapM
21 -- * 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 -- , prefixOf -- match any prefix of a given string
81 -- , suffixOf -- match any suffix of a given string
82 -- , infixOf -- match any substring of a given string
84 -- ** Spanning
85 , span
86 , spanBy
87 , spanByRolling
89 -- Second order parsers (parsers using parsers)
90 -- * Binary Combinators
92 -- ** Sequential Applicative
93 , serialWith
94 , split_
96 -- ** Parallel Applicatives
97 , teeWith
98 , teeWithFst
99 , teeWithMin
100 -- , teeTill -- like manyTill but parallel
102 -- ** Sequential Interleaving
103 -- Use two folds, run a primary parser, its rejected values go to the
104 -- secondary parser.
105 , deintercalate
107 -- ** Sequential Alternative
108 , alt
110 -- ** Parallel Alternatives
111 , shortest
112 , longest
113 -- , fastest
115 -- * N-ary Combinators
116 -- ** Sequential Collection
117 , sequence
118 , concatMap
120 -- ** Sequential Repetition
121 , count
122 , countBetween
123 -- , countBetweenTill
125 , many
126 , some
127 , manyTill
129 -- -- ** Special cases
130 -- XXX traditional implmentations of these may be of limited use. For
131 -- example, consider parsing lines separated by "\r\n". The main parser
132 -- will have to detect and exclude the sequence "\r\n" anyway so that we
133 -- can apply the "sep" parser.
134 --
135 -- We can instead implement these as special cases of deintercalate.
136 --
137 -- , endBy
138 -- , sepBy
139 -- , sepEndBy
140 -- , beginBy
141 -- , sepBeginBy
142 -- , sepAroundBy
144 -- -- * Distribution
145 --
146 -- A simple and stupid impl would be to just convert the stream to an array
147 -- and give the array reference to all consumers. The array can be grown on
148 -- demand by any consumer and truncated when nonbody needs it.
149 --
150 -- -- ** Distribute to collection
151 -- -- ** Distribute to repetition
153 -- -- ** Interleaved collection
154 -- Round robin
155 -- Priority based
156 -- -- ** Interleaved repetition
157 -- repeat one parser and when it fails run an error recovery parser
158 -- e.g. to find a key frame in the stream after an error
160 -- ** Collection of Alternatives
161 -- , shortestN
162 -- , longestN
163 -- , fastestN -- first N successful in time
164 -- , choiceN -- first N successful in position
165 , choice -- first successful in position
167 -- -- ** Repeated Alternatives
168 -- , retryMax -- try N times
169 -- , retryUntil -- try until successful
170 -- , retryUntilN -- try until successful n times
171 )
172where
174import Control.Exception (assert, Exception)
175import Control.Monad (when)
176import Control.Monad.Catch (MonadCatch, MonadThrow(..))
177import Fusion.Plugin.Types (Fuse(..))
178import Streamly.Internal.Data.Fold.Type (Fold(..))
179import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
181import qualified Streamly.Internal.Data.Fold.Type as FL
183import Prelude hiding
184 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
185import Streamly.Internal.Data.Parser.ParserD.Tee
186import Streamly.Internal.Data.Parser.ParserD.Type
188--
189-- $setup
190-- >>> :m
191-- >>> :set -package streamly
192-- >>> import Prelude hiding ()
193-- >>> import qualified Streamly.Prelude as Stream
194-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
195-- >>> import qualified Streamly.Data.Fold as Fold
196-- >>> import qualified Streamly.Internal.Data.Parser as Parser
198-------------------------------------------------------------------------------
199-- Downgrade a parser to a Fold
200-------------------------------------------------------------------------------
202data ParserToFoldError =
203 InitialError String
204 | PartialError Int
205 | ContinueError Int
206 | DoneError Int
207 | ErrorError String
208 deriving Show
210instance Exception ParserToFoldError
212-- | See 'Streamly.Internal.Data.Parser.toFold'.
213--
214-- /Internal/
215--
216{-# INLINE toFold #-}
217toFold :: MonadThrow m => Parser m a b -> Fold m a b
218toFold (Parser pstep pinitial pextract) = Fold step initial pextract
220 where
222 initial = do
223 r <- pinitial
224 case r of
225 IPartial s -> return $ FL.Partial s
226 IDone b -> return $ FL.Done b
227 IError err -> throwM $ InitialError err
229 step st a = do
230 r <- pstep st a
231 case r of
232 Partial 0 s -> return $ FL.Partial s
233 Continue 0 s -> return $ FL.Partial s
234 Done 0 b -> return $ FL.Done b
235 Partial n _ -> throwM $ PartialError n
236 Continue n _ -> throwM $ ContinueError n
237 Done n _ -> throwM $ DoneError n
238 Error err -> throwM $ ErrorError err
240-------------------------------------------------------------------------------
241-- Upgrade folds to parses
242-------------------------------------------------------------------------------
243--
244-- | See 'Streamly.Internal.Data.Parser.fromFold'.
245--
246-- /Pre-release/
247--
248{-# INLINE fromFold #-}
249fromFold :: Monad m => Fold m a b -> Parser m a b
250fromFold (Fold fstep finitial fextract) = Parser step initial fextract
252 where
254 initial = do
255 res <- finitial
256 return
257 $ case res of
258 FL.Partial s1 -> IPartial s1
259 FL.Done b -> IDone b
261 step s a = do
262 res <- fstep s a
263 return
264 $ case res of
265 FL.Partial s1 -> Partial 0 s1
266 FL.Done b -> Done 0 b
268-------------------------------------------------------------------------------
269-- Failing Parsers
270-------------------------------------------------------------------------------
272-- | See 'Streamly.Internal.Data.Parser.peek'.
273--
274-- /Pre-release/
275--
276{-# INLINE peek #-}
277peek :: MonadThrow m => Parser m a a
278peek = Parser step initial extract
280 where
282 initial = return $ IPartial ()
284 step () a = return $ Done 1 a
286 extract () = throwM $ ParseError "peek: end of input"
288-- | See 'Streamly.Internal.Data.Parser.eof'.
289--
290-- /Pre-release/
291--
292{-# INLINE eof #-}
293eof :: Monad m => Parser m a ()
294eof = Parser step initial return
296 where
298 initial = return $ IPartial ()
300 step () _ = return $ Error "eof: not at end of input"
302-- | See 'Streamly.Internal.Data.Parser.satisfy'.
303--
304-- /Pre-release/
305--
306{-# INLINE satisfy #-}
307satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
308satisfy predicate = Parser step initial extract
310 where
312 initial = return $ IPartial ()
314 step () a = return $
315 if predicate a
316 then Done 0 a
317 else Error "satisfy: predicate failed"
319 extract _ = throwM $ ParseError "satisfy: end of input"
321-- | See 'Streamly.Internal.Data.Parser.next'.
322--
323-- /Pre-release/
324--
325{-# INLINE next #-}
326next :: Monad m => Parser m a (Maybe a)
327next = Parser step initial extract
328 where
329 initial = pure $ IPartial ()
330 step _ a = pure $ Done 0 (Just a)
331 extract _ = pure Nothing
333-- | See 'Streamly.Internal.Data.Parser.maybe'.
334--
335-- /Pre-release/
336--
337{-# INLINE maybe #-}
338maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
339maybe parserF = Parser step initial extract
341 where
343 initial = return $ IPartial ()
345 step () a = return $
346 case parserF a of
347 Just b -> Done 0 b
348 Nothing -> Error "maybe: predicate failed"
350 extract _ = throwM $ ParseError "maybe: end of input"
352-- | See 'Streamly.Internal.Data.Parser.either'.
353--
354-- /Pre-release/
355--
356{-# INLINE either #-}
357either :: MonadThrow m => (a -> Either String b) -> Parser m a b
358either parserF = Parser step initial extract
360 where
362 initial = return $ IPartial ()
364 step () a = return $
365 case parserF a of
366 Right b -> Done 0 b
367 Left err -> Error $ "either: " ++ err
369 extract _ = throwM $ ParseError "either: end of input"
371-------------------------------------------------------------------------------
372-- Taking elements
373-------------------------------------------------------------------------------
375-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
376{-# ANN type Tuple'Fused Fuse #-}
377data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
379-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
380--
381-- /Pre-release/
382--
383{-# INLINE takeBetween #-}
384takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
385takeBetween low high (Fold fstep finitial fextract) =
387 Parser step initial (extract streamErr)
389 where
391 streamErr i =
392 "takeBetween: Expecting alteast " ++ show low
393 ++ " elements, got " ++ show i
395 invalidRange =
396 "takeBetween: lower bound - " ++ show low
397 ++ " is greater than higher bound - " ++ show high
399 foldErr :: Int -> String
400 foldErr i =
401 "takeBetween: the collecting fold terminated after"
402 ++ " consuming" ++ show i ++ " elements"
403 ++ " minimum" ++ show low ++ " elements needed"
405 -- Exactly the same as snext except different constructors, we can possibly
406 -- deduplicate the two.
407 {-# INLINE inext #-}
408 inext i res =
409 let i1 = i + 1
410 in case res of
411 FL.Partial s -> do
412 let s1 = Tuple'Fused i1 s
413 if i1 < high
414 -- XXX ideally this should be a Continue instead
415 then return $ IPartial s1
416 else IDone <$> extract foldErr s1
417 FL.Done b ->
418 return
419 $ if i1 >= low
420 then IDone b
421 else IError (foldErr i1)
423 initial = do
424 when (low >= 0 && high >= 0 && low > high)
425 $ throwM $ ParseError invalidRange
427 finitial >>= inext (-1)
429 -- Keep the impl same as inext
430 {-# INLINE snext #-}
431 snext i res =
432 let i1 = i + 1
433 in case res of
434 FL.Partial s -> do
435 let s1 = Tuple'Fused i1 s
436 if i1 < high
437 then return $ Continue 0 s1
438 else Done 0 <$> extract foldErr s1
439 FL.Done b ->
440 return
441 $ if i1 >= low
442 then Done 0 b
443 else Error (foldErr i1)
445 step (Tuple'Fused i s) a = fstep s a >>= snext i
447 extract f (Tuple'Fused i s)
448 | i >= low && i <= high = fextract s
449 | otherwise = throwM $ ParseError (f i)
451-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
452--
453-- /Pre-release/
454--
455{-# INLINE takeEQ #-}
456takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
457takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
459 where
461 cnt = max n 0
463 initial = do
464 res <- finitial
465 return $ case res of
466 FL.Partial s -> IPartial $ Tuple' 0 s
467 FL.Done b ->
468 if cnt == 0
469 then IDone b
470 else IError
471 $ "takeEQ: Expecting exactly " ++ show cnt
472 ++ " elements, fold terminated without"
473 ++ " consuming any elements"
475 step (Tuple' i r) a
476 | i1 < cnt = do
477 res <- fstep r a
478 return
479 $ case res of
480 FL.Partial s -> Continue 0 $ Tuple' i1 s
481 FL.Done _ ->
482 Error
483 $ "takeEQ: Expecting exactly " ++ show cnt
484 ++ " elements, fold terminated on " ++ show i1
485 | i1 == cnt = do
486 res <- fstep r a
487 Done 0
488 <$> case res of
489 FL.Partial s -> fextract s
490 FL.Done b -> return b
491 -- XXX we should not reach here when initial returns Step type
492 -- reachable only when n == 0
493 | otherwise = Done 1 <$> fextract r
495 where
497 i1 = i + 1
499 extract (Tuple' i r)
500 | i == 0 && cnt == 0 = fextract r
501 | otherwise =
502 throwM
503 $ ParseError
504 $ "takeEQ: Expecting exactly " ++ show cnt
505 ++ " elements, input terminated on " ++ show i
507-- | See 'Streamly.Internal.Data.Parser.takeGE'.
508--
509-- /Pre-release/
510--
511{-# INLINE takeGE #-}
512takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
513takeGE n (Fold fstep finitial fextract) = Parser step initial extract
515 where
517 cnt = max n 0
518 initial = do
519 res <- finitial
520 return $ case res of
521 FL.Partial s -> IPartial $ Tuple' 0 s
522 FL.Done b ->
523 if cnt == 0
524 then IDone b
525 else IError
526 $ "takeGE: Expecting at least " ++ show cnt
527 ++ " elements, fold terminated without"
528 ++ " consuming any elements"
530 step (Tuple' i r) a
531 | i1 < cnt = do
532 res <- fstep r a
533 return
534 $ case res of
535 FL.Partial s -> Continue 0 $ Tuple' i1 s
536 FL.Done _ ->
537 Error
538 $ "takeGE: Expecting at least " ++ show cnt
539 ++ " elements, fold terminated on " ++ show i1
540 | otherwise = do
541 res <- fstep r a
542 return
543 $ case res of
544 FL.Partial s -> Partial 0 $ Tuple' i1 s
545 FL.Done b -> Done 0 b
547 where
549 i1 = i + 1
551 extract (Tuple' i r)
552 | i >= cnt = fextract r
553 | otherwise =
554 throwM
555 $ ParseError
556 $ "takeGE: Expecting at least " ++ show cnt
557 ++ " elements, input terminated on " ++ show i
559-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
560--
561-- /Pre-release/
562--
563{-# INLINE takeWhile #-}
564takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
565takeWhile predicate (Fold fstep finitial fextract) =
566 Parser step initial fextract
568 where
570 initial = do
571 res <- finitial
572 return $ case res of
573 FL.Partial s -> IPartial s
574 FL.Done b -> IDone b
576 step s a =
577 if predicate a
578 then do
579 fres <- fstep s a
580 return
581 $ case fres of
582 FL.Partial s1 -> Partial 0 s1
583 FL.Done b -> Done 0 b
584 else Done 1 <$> fextract s
586-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
587--
588-- /Pre-release/
589--
590{-# INLINE takeWhile1 #-}
591takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
592takeWhile1 predicate (Fold fstep finitial fextract) =
593 Parser step initial extract
595 where
597 initial = do
598 res <- finitial
599 return $ case res of
600 FL.Partial s -> IPartial (Left s)
601 FL.Done _ ->
602 IError
603 $ "takeWhile1: fold terminated without consuming:"
604 ++ " any element"
606 {-# INLINE process #-}
607 process s a = do
608 res <- fstep s a
609 return
610 $ case res of
611 FL.Partial s1 -> Partial 0 (Right s1)
612 FL.Done b -> Done 0 b
614 step (Left s) a =
615 if predicate a
616 then process s a
617 else return $ Error "takeWhile1: predicate failed on first element"
618 step (Right s) a =
619 if predicate a
620 then process s a
621 else do
622 b <- fextract s
623 return $ Done 1 b
625 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
626 extract (Right s) = fextract s
628-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
629--
630-- /Pre-release/
631--
632sliceSepByP :: MonadCatch m =>
633 (a -> Bool) -> Parser m a b -> Parser m a b
634sliceSepByP cond (Parser pstep pinitial pextract) =
636 Parser step initial pextract
638 where
640 initial = pinitial
642 step s a =
643 if cond a
644 then do
645 res <- pextract s
646 return $ Done 0 res
647 else pstep s a
649-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
650--
651-- /Pre-release/
652--
653data SliceBeginWithState s = Left' s | Right' s
655{-# INLINE sliceBeginWith #-}
656sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
657sliceBeginWith cond (Fold fstep finitial fextract) =
659 Parser step initial extract
661 where
663 initial = do
664 res <- finitial
665 return $
666 case res of
667 FL.Partial s -> IPartial (Left' s)
668 FL.Done _ -> IError "sliceBeginWith : bad finitial"
670 {-# INLINE process #-}
671 process s a = do
672 res <- fstep s a
673 return
674 $ case res of
675 FL.Partial s1 -> Partial 0 (Right' s1)
676 FL.Done b -> Done 0 b
678 step (Left' s) a =
679 if cond a
680 then process s a
681 else error $ "sliceBeginWith : slice begins with an element which "
682 ++ "fails the predicate"
683 step (Right' s) a =
684 if not (cond a)
685 then process s a
686 else Done 1 <$> fextract s
688 extract (Left' s) = fextract s
689 extract (Right' s) = fextract s
691data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
693-- | See 'Streamly.Internal.Data.Parser.wordBy'.
694--
695--
696{-# INLINE wordBy #-}
697wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
698wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
700 where
702 {-# INLINE worder #-}
703 worder s a = do
704 res <- fstep s a
705 return
706 $ case res of
707 FL.Partial s1 -> Partial 0 $ WBWord s1
708 FL.Done b -> Done 0 b
710 initial = do
711 res <- finitial
712 return
713 $ case res of
714 FL.Partial s -> IPartial $ WBLeft s
715 FL.Done b -> IDone b
717 step (WBLeft s) a =
718 if not (predicate a)
719 then worder s a
720 else return $ Partial 0 $ WBLeft s
721 step (WBWord s) a =
722 if not (predicate a)
723 then worder s a
724 else do
725 b <- fextract s
726 return $ Partial 0 $ WBRight b
727 step (WBRight b) a =
728 return
729 $ if not (predicate a)
730 then Done 1 b
731 else Partial 0 $ WBRight b
733 extract (WBLeft s) = fextract s
734 extract (WBWord s) = fextract s
735 extract (WBRight b) = return b
737{-# ANN type GroupByState Fuse #-}
738data GroupByState a s
739 = GroupByInit !s
740 | GroupByGrouping !a !s
742-- | See 'Streamly.Internal.Data.Parser.groupBy'.
743--
744{-# INLINE groupBy #-}
745groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
746groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
748 where
750 {-# INLINE grouper #-}
751 grouper s a0 a = do
752 res <- fstep s a
753 return
754 $ case res of
755 FL.Done b -> Done 0 b
756 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
758 initial = do
759 res <- finitial
760 return
761 $ case res of
762 FL.Partial s -> IPartial $ GroupByInit s
763 FL.Done b -> IDone b
765 step (GroupByInit s) a = grouper s a a
766 step (GroupByGrouping a0 s) a =
767 if eq a0 a
768 then grouper s a0 a
769 else Done 1 <$> fextract s
771 extract (GroupByInit s) = fextract s
772 extract (GroupByGrouping _ s) = fextract s
774-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
775--
776{-# INLINE groupByRolling #-}
777groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
778groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
780 where
782 {-# INLINE grouper #-}
783 grouper s a = do
784 res <- fstep s a
785 return
786 $ case res of
787 FL.Done b -> Done 0 b
788 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
790 initial = do
791 res <- finitial
792 return
793 $ case res of
794 FL.Partial s -> IPartial $ GroupByInit s
795 FL.Done b -> IDone b
797 step (GroupByInit s) a = grouper s a
798 step (GroupByGrouping a0 s) a =
799 if eq a0 a
800 then grouper s a
801 else Done 1 <$> fextract s
803 extract (GroupByInit s) = fextract s
804 extract (GroupByGrouping _ s) = fextract s
806{-# ANN type GroupByStatePair Fuse #-}
807data GroupByStatePair a s1 s2
808 = GroupByInitPair !s1 !s2
809 | GroupByGroupingPair !a !s1 !s2
810 | GroupByGroupingPairL !a !s1 !s2
811 | GroupByGroupingPairR !a !s1 !s2
813{-# INLINE groupByRollingEither #-}
814groupByRollingEither :: MonadCatch m =>
815 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
816groupByRollingEither
817 eq
818 (Fold fstep1 finitial1 fextract1)
819 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
821 where
823 {-# INLINE grouper #-}
824 grouper s1 s2 a = do
825 return $ Continue 0 (GroupByGroupingPair a s1 s2)
827 {-# INLINE grouperL2 #-}
828 grouperL2 s1 s2 a = do
829 res <- fstep1 s1 a
830 return
831 $ case res of
832 FL.Done b -> Done 0 (Left b)
833 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
835 {-# INLINE grouperL #-}
836 grouperL s1 s2 a0 a = do
837 res <- fstep1 s1 a0
838 case res of
839 FL.Done b -> return $ Done 0 (Left b)
840 FL.Partial s11 -> grouperL2 s11 s2 a
842 {-# INLINE grouperR2 #-}
843 grouperR2 s1 s2 a = do
844 res <- fstep2 s2 a
845 return
846 $ case res of
847 FL.Done b -> Done 0 (Right b)
848 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
850 {-# INLINE grouperR #-}
851 grouperR s1 s2 a0 a = do
852 res <- fstep2 s2 a0
853 case res of
854 FL.Done b -> return $ Done 0 (Right b)
855 FL.Partial s21 -> grouperR2 s1 s21 a
857 initial = do
858 res1 <- finitial1
859 res2 <- finitial2
860 return
861 $ case res1 of
862 FL.Partial s1 ->
863 case res2 of
864 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
865 FL.Done b -> IDone (Right b)
866 FL.Done b -> IDone (Left b)
868 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
870 step (GroupByGroupingPair a0 s1 s2) a =
871 if not (eq a0 a)
872 then grouperL s1 s2 a0 a
873 else grouperR s1 s2 a0 a
875 step (GroupByGroupingPairL a0 s1 s2) a =
876 if not (eq a0 a)
877 then grouperL2 s1 s2 a
878 else Done 1 . Left <$> fextract1 s1
880 step (GroupByGroupingPairR a0 s1 s2) a =
881 if eq a0 a
882 then grouperR2 s1 s2 a
883 else Done 1 . Right <$> fextract2 s2
885 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
886 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
887 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
888 extract (GroupByGroupingPair a s1 _) = do
889 res <- fstep1 s1 a
890 case res of
891 FL.Done b -> return $ Left b
892 FL.Partial s11 -> Left <$> fextract1 s11
894-- XXX use an Unfold instead of a list?
895-- XXX custom combinators for matching list, array and stream?
896--
897-- | See 'Streamly.Internal.Data.Parser.eqBy'.
898--
899-- /Pre-release/
900--
901{-# INLINE eqBy #-}
902eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
903eqBy cmp str = Parser step initial extract
905 where
907 initial = return $ IPartial str
909 step [] _ = return $ Done 0 ()
910 step [x] a =
911 return
912 $ if x `cmp` a
913 then Done 0 ()
914 else Error "eqBy: failed, yet to match the last element"
915 step (x:xs) a =
916 return
917 $ if x `cmp` a
918 then Continue 0 xs
919 else Error
920 $ "eqBy: failed, yet to match "
921 ++ show (length xs + 1) ++ " elements"
923 extract xs =
924 throwM
925 $ ParseError
926 $ "eqBy: end of input, yet to match "
927 ++ show (length xs) ++ " elements"
929--------------------------------------------------------------------------------
930--- Spanning
931--------------------------------------------------------------------------------
933-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
934-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
935-- input.
936--
937-- @
938-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
939--
940-- > span_ (< 1) [1,2,3]
941-- ([],[1,2,3])
942--
943-- > span_ (< 2) [1,2,3]
944-- ([1],[2,3])
945--
946-- > span_ (< 4) [1,2,3]
947-- ([1,2,3],[])
948--
949-- @
950--
951-- /Pre-release/
952{-# INLINE span #-}
953span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
954span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
956-- | Break the input stream into two groups, the first group takes the input as
957-- long as the predicate applied to the first element of the stream and next
958-- input element holds 'True', the second group takes the rest of the input.
959--
960-- /Pre-release/
961--
962{-# INLINE spanBy #-}
963spanBy ::
964 Monad m
965 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
966spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
968-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
969-- predicate is applied to the previous and the next input elements.
970--
971-- /Pre-release/
972{-# INLINE spanByRolling #-}
973spanByRolling ::
974 Monad m
975 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
976spanByRolling eq f1 f2 =
977 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
979-------------------------------------------------------------------------------
980-- nested parsers
981-------------------------------------------------------------------------------
983-- | See 'Streamly.Internal.Data.Parser.takeP'.
984--
985-- /Internal/
986{-# INLINE takeP #-}
987takeP :: Monad m => Int -> Parser m a b -> Parser m a b
988takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
990 where
992 initial = do
993 res <- pinitial
994 case res of
995 IPartial s ->
996 if lim > 0
997 then return $ IPartial $ Tuple' 0 s
998 else IDone <$> pextract s
999 IDone b -> return $ IDone b
1000 IError e -> return $ IError e
1002 step (Tuple' cnt r) a = do
1003 assert (cnt < lim) (return ())
1004 res <- pstep r a
1005 let cnt1 = cnt + 1
1006 case res of
1007 Partial 0 s -> do
1008 assert (cnt1 >= 0) (return ())
1009 if cnt1 < lim
1010 then return $ Partial 0 $ Tuple' cnt1 s
1011 else Done 0 <$> pextract s
1012 Continue 0 s -> do
1013 assert (cnt1 >= 0) (return ())
1014 if cnt1 < lim
1015 then return $ Continue 0 $ Tuple' cnt1 s
1016 -- XXX This should error out?
1017 -- If designed properly, this will probably error out.
1018 -- "pextract" should error out
1019 --
1020 -- By Harendra,
1021 --
1022 -- This is a tricky case, we have the following options:
1023 -- 1. Done 0 with extract as you have written
1024 -- 2. Done n, will require buffering elements
1025 -- 3. Use a backtracking fold and not a parser, once we have
1026 -- backtracking in folds
1027 else Done 0 <$> pextract s
1028 Partial n s -> do
1029 let taken = cnt1 - n
1030 assert (taken >= 0) (return ())
1031 return $ Partial n $ Tuple' taken s
1032 Continue n s -> do
1033 let taken = cnt1 - n
1034 assert (taken >= 0) (return ())
1035 return $ Continue n $ Tuple' taken s
1036 Done n b -> return $ Done n b
1037 Error str -> return $ Error str
1039 extract (Tuple' _ r) = pextract r
1041-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1043-- /Pre-release/
1045{-# INLINE lookAhead #-}
1046lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1047lookAhead (Parser step1 initial1 _) = Parser step initial extract
1049 where
1051 initial = do
1052 res <- initial1
1053 return $ case res of
1054 IPartial s -> IPartial (Tuple' 0 s)
1055 IDone b -> IDone b
1056 IError e -> IError e
1058 step (Tuple' cnt st) a = do
1059 r <- step1 st a
1060 let cnt1 = cnt + 1
1061 return
1062 $ case r of
1063 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1064 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1065 Done _ b -> Done cnt1 b
1066 Error err -> Error err
1068 -- XXX returning an error let's us backtrack. To implement it in a way so
1069 -- that it terminates on eof without an error then we need a way to
1070 -- backtrack on eof, that will require extract to return 'Step' type.
1071 extract (Tuple' n _) =
1072 throwM
1073 $ ParseError
1074 $ "lookAhead: end of input after consuming "
1075 ++ show n ++ " elements"
1077-------------------------------------------------------------------------------
1078-- Interleaving
1079-------------------------------------------------------------------------------
1081-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1083-- /Unimplemented/
1085{-# INLINE deintercalate #-}
1086deintercalate ::
1087 -- Monad m =>
1088 Fold m a y -> Parser m x a
1089 -> Fold m b z -> Parser m x b
1090 -> Parser m x (y, z)
1091deintercalate = undefined
1093-------------------------------------------------------------------------------
1094-- Sequential Collection
1095-------------------------------------------------------------------------------
1097-- | See 'Streamly.Internal.Data.Parser.sequence'.
1099-- /Unimplemented/
1101{-# INLINE sequence #-}
1102sequence ::
1103 -- Foldable t =>
1104 Fold m b c -> t (Parser m a b) -> Parser m a c
1105sequence _f _p = undefined
1107-------------------------------------------------------------------------------
1108-- Alternative Collection
1109-------------------------------------------------------------------------------
1111-- | See 'Streamly.Internal.Data.Parser.choice'.
1113-- /Broken/
1115{-# INLINE choice #-}
1116choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
1117choice = foldl1 shortest
1119-------------------------------------------------------------------------------
1120-- Sequential Repetition
1121-------------------------------------------------------------------------------
1123-- | See 'Streamly.Internal.Data.Parser.many'.
1125-- /Pre-release/
1127{-# INLINE many #-}
1128many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1129many = splitMany
1130-- many = countBetween 0 maxBound
1132-- | See 'Streamly.Internal.Data.Parser.some'.
1134-- /Pre-release/
1136{-# INLINE some #-}
1137some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1138some = splitSome
1139-- some f p = many (takeGE 1 f) p
1140-- many = countBetween 1 maxBound
1142-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1144-- /Unimplemented/
1146{-# INLINE countBetween #-}
1147countBetween ::
1148 -- MonadCatch m =>
1149 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1150countBetween _m _n _p = undefined
1151-- countBetween m n p f = many (takeBetween m n f) p
1153-- | See 'Streamly.Internal.Data.Parser.count'.
1155-- /Unimplemented/
1157{-# INLINE count #-}
1158count ::
1159 -- MonadCatch m =>
1160 Int -> Parser m a b -> Fold m b c -> Parser m a c
1161count n = countBetween n n
1162-- count n f p = many (takeEQ n f) p
1164data ManyTillState fs sr sl
1165 = ManyTillR Int fs sr
1166 | ManyTillL Int fs sl
1168-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1170-- /Pre-release/
1172{-# INLINE manyTill #-}
1173manyTill :: MonadCatch m
1174 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1175manyTill (Fold fstep finitial fextract)
1176 (Parser stepL initialL extractL)
1177 (Parser stepR initialR _) =
1178 Parser step initial extract
1180 where
1182 -- Caution: Mutual recursion
1184 scrutL fs p c d e = do
1185 resL <- initialL
1186 case resL of
1187 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1188 IDone bl -> do
1189 fr <- fstep fs bl
1190 case fr of
1191 FL.Partial fs1 -> scrutR fs1 p c d e
1192 FL.Done fb -> return $ d fb
1193 IError err -> return $ e err
1195 scrutR fs p c d e = do
1196 resR <- initialR
1197 case resR of
1198 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1199 IDone _ -> d <$> fextract fs
1200 IError _ -> scrutL fs p c d e
1202 initial = do
1203 res <- finitial
1204 case res of
1205 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1206 FL.Done b -> return $ IDone b
1208 step (ManyTillR cnt fs st) a = do
1209 r <- stepR st a
1210 case r of
1211 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1212 Continue n s -> do
1213 assert (cnt + 1 - n >= 0) (return ())
1214 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1215 Done n _ -> do
1216 b <- fextract fs
1217 return $ Done n b
1218 Error _ -> do
1219 resL <- initialL
1220 case resL of
1221 IPartial sl ->
1222 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1223 IDone bl -> do
1224 fr <- fstep fs bl
1225 let cnt1 = cnt + 1
1226 p = Partial cnt
1227 c = Continue cnt
1228 d = Done cnt
1229 case fr of
1230 FL.Partial fs1 -> scrutR fs1 p c d Error
1231 FL.Done fb -> return $ Done cnt1 fb
1232 IError err -> return $ Error err
1233 -- XXX the cnt is being used only by the assert
1234 step (ManyTillL cnt fs st) a = do
1235 r <- stepL st a
1236 case r of
1237 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1238 Continue n s -> do
1239 assert (cnt + 1 - n >= 0) (return ())
1240 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1241 Done n b -> do
1242 fs1 <- fstep fs b
1243 case fs1 of
1244 FL.Partial s ->
1245 scrutR s (Partial n) (Continue n) (Done n) Error
1246 FL.Done b1 -> return $ Done n b1
1247 Error err -> return $ Error err
1249 extract (ManyTillL _ fs sR) = do
1250 res <- extractL sR >>= fstep fs
1251 case res of
1252 FL.Partial s -> fextract s
1253 FL.Done b -> return b
1254 extract (ManyTillR _ fs _) = fextract fs