git.iko.soy/streamly
on cbccb77 help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
2063 lines 63 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 , postscan
40 , filter
42 -- * Element parsers
43 , peek
44 , eof
45 , satisfy
46 , next
47 , maybe
48 , either
50 -- * Sequence parsers
51 --
52 -- Parsers chained in series, if one parser terminates the composition
53 -- terminates. Currently we are using folds to collect the output of the
54 -- parsers but we can use Parsers instead of folds to make the composition
55 -- more powerful. For example, we can do:
56 --
57 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
58 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
59 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
61 -- Grab a sequence of input elements without inspecting them
62 , takeBetween
63 -- , take -- take -- takeBetween 0 n
64 , takeEQ -- takeBetween n n
65 , takeGE -- takeBetween n maxBound
66 -- , takeGE1 -- take1 -- takeBetween 1 n
67 , takeP
69 -- Grab a sequence of input elements by inspecting them
70 , lookAhead
71 , takeWhile
72 , takeWhileP
73 , takeWhile1
75 -- Separators
76 , takeEndBy
77 , takeEndBy_
78 , takeEndByEsc
79 , takeStartBy
80 , takeFramedBy_
81 , takeFramedByEsc_
82 , takeFramedByGeneric
84 -- Words and grouping
85 , wordBy
86 , wordFramedBy
87 , wordQuotedBy
88 , groupBy
89 , groupByRolling
90 , groupByRollingEither
92 -- Matching strings
93 , eqBy
94 , matchBy
95 -- , prefixOf -- match any prefix of a given string
96 -- , suffixOf -- match any suffix of a given string
97 -- , infixOf -- match any substring of a given string
99 -- ** Spanning
100 , span
101 , spanBy
102 , spanByRolling
104 -- Second order parsers (parsers using parsers)
105 -- * Binary Combinators
107 -- ** Sequential Applicative
108 , serialWith
109 , split_
111 -- ** Parallel Applicatives
112 , teeWith
113 , teeWithFst
114 , teeWithMin
115 -- , teeTill -- like manyTill but parallel
117 -- ** Sequential Interleaving
118 -- Use two folds, run a primary parser, its rejected values go to the
119 -- secondary parser.
120 , deintercalate
121 , sepBy
123 -- ** Sequential Alternative
124 , alt
126 -- ** Parallel Alternatives
127 , shortest
128 , longest
129 -- , fastest
131 -- * N-ary Combinators
132 -- ** Sequential Collection
133 , sequence
134 , concatMap
136 -- ** Sequential Repetition
137 , count
138 , countBetween
139 -- , countBetweenTill
141 , many
142 , manyP
143 , some
144 , manyTill
146 -- -- ** Special cases
147 -- XXX traditional implmentations of these may be of limited use. For
148 -- example, consider parsing lines separated by "\r\n". The main parser
149 -- will have to detect and exclude the sequence "\r\n" anyway so that we
150 -- can apply the "sep" parser.
151 --
152 -- We can instead implement these as special cases of deintercalate.
153 --
154 -- , endBy
155 -- , sepBy
156 -- , sepEndBy
157 -- , beginBy
158 -- , sepBeginBy
159 -- , sepAroundBy
161 -- -- * Distribution
162 --
163 -- A simple and stupid impl would be to just convert the stream to an array
164 -- and give the array reference to all consumers. The array can be grown on
165 -- demand by any consumer and truncated when nonbody needs it.
166 --
167 -- -- ** Distribute to collection
168 -- -- ** Distribute to repetition
170 -- -- ** Interleaved collection
171 -- Round robin
172 -- Priority based
173 -- -- ** Interleaved repetition
174 -- repeat one parser and when it fails run an error recovery parser
175 -- e.g. to find a key frame in the stream after an error
177 -- ** Collection of Alternatives
178 -- , shortestN
179 -- , longestN
180 -- , fastestN -- first N successful in time
181 -- , choiceN -- first N successful in position
182 , choice -- first successful in position
184 -- -- ** Repeated Alternatives
185 -- , retryMax -- try N times
186 -- , retryUntil -- try until successful
187 -- , retryUntilN -- try until successful n times
189 -- ** Zipping Input
190 , zipWithM
191 , zip
192 , indexed
193 , makeIndexFilter
194 , sampleFromthen
195 )
196where
198import Control.Exception (assert, Exception)
199import Control.Monad (when)
200import Control.Monad.Catch (MonadCatch, MonadThrow(..))
201import Data.Bifunctor (first)
202import Fusion.Plugin.Types (Fuse(..))
203import Streamly.Internal.Data.Fold.Type (Fold(..))
204import Streamly.Internal.Data.SVar.Type (defState)
205import Streamly.Internal.Data.Either.Strict (Either'(..))
206import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
207import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
209import qualified Streamly.Internal.Data.Fold.Type as FL
210import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
211import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
213import Prelude hiding
214 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
215 , zip, filter)
216import Streamly.Internal.Data.Parser.ParserD.Tee
217import Streamly.Internal.Data.Parser.ParserD.Type
219--
220-- $setup
221-- >>> :m
222-- >>> :set -package streamly
223-- >>> import Prelude hiding ()
224-- >>> import qualified Data.Maybe as Maybe
225-- >>> import qualified Streamly.Prelude as Stream
226-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
227-- >>> import qualified Streamly.Data.Fold as Fold
228-- >>> import qualified Streamly.Internal.Data.Parser as Parser
230-------------------------------------------------------------------------------
231-- Downgrade a parser to a Fold
232-------------------------------------------------------------------------------
234data ParserToFoldError =
235 InitialError String
236 | PartialError Int
237 | ContinueError Int
238 | DoneError Int
239 | ErrorError String
240 deriving Show
242instance Exception ParserToFoldError
244-- | See 'Streamly.Internal.Data.Parser.toFold'.
245--
246-- /Internal/
247--
248{-# INLINE toFold #-}
249toFold :: MonadThrow m => Parser m a b -> Fold m a b
250toFold (Parser pstep pinitial pextract) = Fold step initial pextract
252 where
254 initial = do
255 r <- pinitial
256 case r of
257 IPartial s -> return $ FL.Partial s
258 IDone b -> return $ FL.Done b
259 IError err -> throwM $ InitialError err
261 step st a = do
262 r <- pstep st a
263 case r of
264 Partial 0 s -> return $ FL.Partial s
265 Continue 0 s -> return $ FL.Partial s
266 Done 0 b -> return $ FL.Done b
267 Partial n _ -> throwM $ PartialError n
268 Continue n _ -> throwM $ ContinueError n
269 Done n _ -> throwM $ DoneError n
270 Error err -> throwM $ ErrorError err
272-------------------------------------------------------------------------------
273-- Upgrade folds to parses
274-------------------------------------------------------------------------------
275--
276-- | See 'Streamly.Internal.Data.Parser.fromFold'.
277--
278-- /Pre-release/
279--
280{-# INLINE fromFold #-}
281fromFold :: Monad m => Fold m a b -> Parser m a b
282fromFold (Fold fstep finitial fextract) = Parser step initial fextract
284 where
286 initial = do
287 res <- finitial
288 return
289 $ case res of
290 FL.Partial s1 -> IPartial s1
291 FL.Done b -> IDone b
293 step s a = do
294 res <- fstep s a
295 return
296 $ case res of
297 FL.Partial s1 -> Partial 0 s1
298 FL.Done b -> Done 0 b
300-------------------------------------------------------------------------------
301-- Failing Parsers
302-------------------------------------------------------------------------------
304-- | See 'Streamly.Internal.Data.Parser.peek'.
305--
306-- /Pre-release/
307--
308{-# INLINE peek #-}
309peek :: MonadThrow m => Parser m a a
310peek = Parser step initial extract
312 where
314 initial = return $ IPartial ()
316 step () a = return $ Done 1 a
318 extract () = throwM $ ParseError "peek: end of input"
320-- | See 'Streamly.Internal.Data.Parser.eof'.
321--
322-- /Pre-release/
323--
324{-# INLINE eof #-}
325eof :: Monad m => Parser m a ()
326eof = Parser step initial return
328 where
330 initial = return $ IPartial ()
332 step () _ = return $ Error "eof: not at end of input"
334-- | See 'Streamly.Internal.Data.Parser.next'.
335--
336-- /Pre-release/
337--
338{-# INLINE next #-}
339next :: Monad m => Parser m a (Maybe a)
340next = Parser step initial extract
341 where
342 initial = pure $ IPartial ()
343 step _ a = pure $ Done 0 (Just a)
344 extract _ = pure Nothing
346-- | See 'Streamly.Internal.Data.Parser.either'.
347--
348-- /Pre-release/
349--
350{-# INLINE either #-}
351either :: MonadThrow m => (a -> Either String b) -> Parser m a b
352either f = Parser step initial extract
354 where
356 initial = return $ IPartial ()
358 step () a = return $
359 case f a of
360 Right b -> Done 0 b
361 Left err -> Error err
363 extract _ = throwM $ ParseError "end of input"
365-- | See 'Streamly.Internal.Data.Parser.maybe'.
366--
367-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
368-- >>> maybe f = Parser.either (toEither . f)
369--
370-- /Pre-release/
371--
372{-# INLINE maybe #-}
373maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
374-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
375maybe parserF = Parser step initial extract
377 where
379 initial = return $ IPartial ()
381 step () a = return $
382 case parserF a of
383 Just b -> Done 0 b
384 Nothing -> Error "maybe: predicate failed"
386 extract _ = throwM $ ParseError "maybe: end of input"
388-- | See 'Streamly.Internal.Data.Parser.satisfy'.
389--
390-- >>> toMaybe f x = if f x then Just x else Nothing
391-- >>> satisfy f = Parser.maybe (toMaybe f)
392--
393-- /Pre-release/
394--
395{-# INLINE satisfy #-}
396satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
397-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
398satisfy predicate = Parser step initial extract
400 where
402 initial = return $ IPartial ()
404 step () a = return $
405 if predicate a
406 then Done 0 a
407 else Error "satisfy: predicate failed"
409 extract _ = throwM $ ParseError "satisfy: end of input"
411-------------------------------------------------------------------------------
412-- Taking elements
413-------------------------------------------------------------------------------
415-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
416{-# ANN type Tuple'Fused Fuse #-}
417data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
419-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
420--
421-- /Pre-release/
422--
423{-# INLINE takeBetween #-}
424takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
425takeBetween low high (Fold fstep finitial fextract) =
427 Parser step initial (extract streamErr)
429 where
431 streamErr i =
432 "takeBetween: Expecting alteast " ++ show low
433 ++ " elements, got " ++ show i
435 invalidRange =
436 "takeBetween: lower bound - " ++ show low
437 ++ " is greater than higher bound - " ++ show high
439 foldErr :: Int -> String
440 foldErr i =
441 "takeBetween: the collecting fold terminated after"
442 ++ " consuming" ++ show i ++ " elements"
443 ++ " minimum" ++ show low ++ " elements needed"
445 -- Exactly the same as snext except different constructors, we can possibly
446 -- deduplicate the two.
447 {-# INLINE inext #-}
448 inext i res =
449 let i1 = i + 1
450 in case res of
451 FL.Partial s -> do
452 let s1 = Tuple'Fused i1 s
453 if i1 < high
454 -- XXX ideally this should be a Continue instead
455 then return $ IPartial s1
456 else IDone <$> extract foldErr s1
457 FL.Done b ->
458 return
459 $ if i1 >= low
460 then IDone b
461 else IError (foldErr i1)
463 initial = do
464 when (low >= 0 && high >= 0 && low > high)
465 $ throwM $ ParseError invalidRange
467 finitial >>= inext (-1)
469 -- Keep the impl same as inext
470 {-# INLINE snext #-}
471 snext i res =
472 let i1 = i + 1
473 in case res of
474 FL.Partial s -> do
475 let s1 = Tuple'Fused i1 s
476 if i1 < high
477 then return $ Continue 0 s1
478 else Done 0 <$> extract foldErr s1
479 FL.Done b ->
480 return
481 $ if i1 >= low
482 then Done 0 b
483 else Error (foldErr i1)
485 step (Tuple'Fused i s) a = fstep s a >>= snext i
487 extract f (Tuple'Fused i s)
488 | i >= low && i <= high = fextract s
489 | otherwise = throwM $ ParseError (f i)
491-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
492--
493-- /Pre-release/
494--
495{-# INLINE takeEQ #-}
496takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
497takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
499 where
501 cnt = max n 0
503 initial = do
504 res <- finitial
505 return $ case res of
506 FL.Partial s -> IPartial $ Tuple' 0 s
507 FL.Done b ->
508 if cnt == 0
509 then IDone b
510 else IError
511 $ "takeEQ: Expecting exactly " ++ show cnt
512 ++ " elements, fold terminated without"
513 ++ " consuming any elements"
515 step (Tuple' i r) a
516 | i1 < cnt = do
517 res <- fstep r a
518 return
519 $ case res of
520 FL.Partial s -> Continue 0 $ Tuple' i1 s
521 FL.Done _ ->
522 Error
523 $ "takeEQ: Expecting exactly " ++ show cnt
524 ++ " elements, fold terminated on " ++ show i1
525 | i1 == cnt = do
526 res <- fstep r a
527 Done 0
528 <$> case res of
529 FL.Partial s -> fextract s
530 FL.Done b -> return b
531 -- XXX we should not reach here when initial returns Step type
532 -- reachable only when n == 0
533 | otherwise = Done 1 <$> fextract r
535 where
537 i1 = i + 1
539 extract (Tuple' i r)
540 | i == 0 && cnt == 0 = fextract r
541 | otherwise =
542 throwM
543 $ ParseError
544 $ "takeEQ: Expecting exactly " ++ show cnt
545 ++ " elements, input terminated on " ++ show i
547-- | See 'Streamly.Internal.Data.Parser.takeGE'.
548--
549-- /Pre-release/
550--
551{-# INLINE takeGE #-}
552takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
553takeGE n (Fold fstep finitial fextract) = Parser step initial extract
555 where
557 cnt = max n 0
558 initial = do
559 res <- finitial
560 return $ case res of
561 FL.Partial s -> IPartial $ Tuple' 0 s
562 FL.Done b ->
563 if cnt == 0
564 then IDone b
565 else IError
566 $ "takeGE: Expecting at least " ++ show cnt
567 ++ " elements, fold terminated without"
568 ++ " consuming any elements"
570 step (Tuple' i r) a
571 | i1 < cnt = do
572 res <- fstep r a
573 return
574 $ case res of
575 FL.Partial s -> Continue 0 $ Tuple' i1 s
576 FL.Done _ ->
577 Error
578 $ "takeGE: Expecting at least " ++ show cnt
579 ++ " elements, fold terminated on " ++ show i1
580 | otherwise = do
581 res <- fstep r a
582 return
583 $ case res of
584 FL.Partial s -> Partial 0 $ Tuple' i1 s
585 FL.Done b -> Done 0 b
587 where
589 i1 = i + 1
591 extract (Tuple' i r)
592 | i >= cnt = fextract r
593 | otherwise =
594 throwM
595 $ ParseError
596 $ "takeGE: Expecting at least " ++ show cnt
597 ++ " elements, input terminated on " ++ show i
599-------------------------------------------------------------------------------
600-- Conditional splitting
601-------------------------------------------------------------------------------
603-- | See 'Streamly.Internal.Data.Parser.takeWhileP'.
604--
605-- /Pre-release/
606--
607{-# INLINE takeWhileP #-}
608takeWhileP :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b
609takeWhileP predicate (Parser pstep pinitial pextract) =
610 Parser step pinitial pextract
612 where
614 step s a =
615 if predicate a
616 then pstep s a
617 else Done 1 <$> pextract s
619-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
620--
621-- /Pre-release/
622--
623{-# INLINE takeWhile #-}
624takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
625takeWhile predicate (Fold fstep finitial fextract) =
626 Parser step initial fextract
628 where
630 initial = do
631 res <- finitial
632 return $ case res of
633 FL.Partial s -> IPartial s
634 FL.Done b -> IDone b
636 step s a =
637 if predicate a
638 then do
639 fres <- fstep s a
640 return
641 $ case fres of
642 FL.Partial s1 -> Partial 0 s1
643 FL.Done b -> Done 0 b
644 else Done 1 <$> fextract s
646-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
647--
648-- /Pre-release/
649--
650{-# INLINE takeWhile1 #-}
651takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
652takeWhile1 predicate (Fold fstep finitial fextract) =
653 Parser step initial extract
655 where
657 initial = do
658 res <- finitial
659 return $ case res of
660 FL.Partial s -> IPartial (Left' s)
661 FL.Done _ ->
662 IError
663 $ "takeWhile1: fold terminated without consuming:"
664 ++ " any element"
666 {-# INLINE process #-}
667 process s a = do
668 res <- fstep s a
669 return
670 $ case res of
671 FL.Partial s1 -> Partial 0 (Right' s1)
672 FL.Done b -> Done 0 b
674 step (Left' s) a =
675 if predicate a
676 then process s a
677 else return $ Error "takeWhile1: predicate failed on first element"
678 step (Right' s) a =
679 if predicate a
680 then process s a
681 else do
682 b <- fextract s
683 return $ Done 1 b
685 extract (Left' _) = throwM $ ParseError "takeWhile1: end of input"
686 extract (Right' s) = fextract s
688-------------------------------------------------------------------------------
689-- Separators
690-------------------------------------------------------------------------------
692{-# INLINE takeFramedByGeneric #-}
693takeFramedByGeneric :: MonadThrow m =>
694 Maybe (a -> Bool)
695 -> Maybe (a -> Bool)
696 -> Maybe (a -> Bool)
697 -> Fold m a b
698 -> Parser m a b
699takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
701 Parser step initial extract
703 where
705 initial = do
706 res <- finitial
707 return $
708 case res of
709 FL.Partial s -> IPartial (FrameEscInit s)
710 FL.Done _ ->
711 error "takeFramedByGeneric: fold done without input"
713 {-# INLINE process #-}
714 process s a n = do
715 res <- fstep s a
716 return
717 $ case res of
718 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
719 FL.Done b -> Done 0 b
721 {-# INLINE processNoEsc #-}
722 processNoEsc s a n =
723 case end of
724 Just isEnd ->
725 case begin of
726 Just isBegin ->
727 -- takeFramedBy case
728 if isEnd a
729 then
730 if n == 0
731 then Done 0 <$> fextract s
732 else process s a (n - 1)
733 else
734 let n1 = if isBegin a then n + 1 else n
735 in process s a n1
736 Nothing -> -- takeEndBy case
737 if isEnd a
738 then Done 0 <$> fextract s
739 else process s a n
740 Nothing -> -- takeStartBy case
741 case begin of
742 Just isBegin ->
743 if isBegin a
744 then Done 0 <$> fextract s
745 else process s a n
746 Nothing ->
747 error $ "takeFramedByGeneric: "
748 ++ "Both begin and end frame predicate missing"
750 {-# INLINE processCheckEsc #-}
751 processCheckEsc s a n =
752 case esc of
753 Just isEsc ->
754 if isEsc a
755 then return $ Partial 0 $ FrameEscEsc s n
756 else processNoEsc s a n
757 Nothing -> processNoEsc s a n
759 step (FrameEscInit s) a =
760 case begin of
761 Just isBegin ->
762 if isBegin a
763 then return $ Partial 0 (FrameEscGo s 0)
764 else return $ Error "takeFramedByGeneric: missing frame start"
765 Nothing ->
766 case end of
767 Just isEnd ->
768 if isEnd a
769 then Done 0 <$> fextract s
770 else processCheckEsc s a 0
771 Nothing ->
772 error "Both begin and end frame predicate missing"
773 step (FrameEscGo s n) a = processCheckEsc s a n
774 step (FrameEscEsc s n) a = process s a n
776 err = throwM . ParseError
778 extract (FrameEscInit _) =
779 err "takeFramedByGeneric: empty token"
780 extract (FrameEscGo s _) =
781 case begin of
782 Just _ ->
783 case end of
784 Nothing -> fextract s
785 Just _ -> err "takeFramedByGeneric: missing frame end"
786 Nothing -> err "takeFramedByGeneric: missing closing frame"
787 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
789-- | See 'Streamly.Internal.Data.Parser.takeEndBy'.
790--
791-- /Pre-release/
792--
793{-# INLINE takeEndBy #-}
794takeEndBy :: MonadCatch m => (a -> Bool) -> Parser m a b -> Parser m a b
795takeEndBy cond (Parser pstep pinitial pextract) =
797 Parser step initial pextract
799 where
801 initial = pinitial
803 step s a = do
804 res <- pstep s a
805 if not (cond a)
806 then return res
807 else extractStep pextract res
809-- | See 'Streamly.Internal.Data.Parser.takeEndByEsc'.
810--
811-- /Pre-release/
812--
813{-# INLINE takeEndByEsc #-}
814takeEndByEsc :: MonadCatch m =>
815 (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b
816takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
818 Parser step initial extract
820 where
822 initial = first Left' <$> pinitial
824 step (Left' s) a = do
825 if isEsc a
826 then return $ Partial 0 $ Right' s
827 else do
828 res <- pstep s a
829 if not (isSep a)
830 then return $ mapStateStep Left' res
831 else extractStep pextract res
833 step (Right' s) a = do
834 res <- pstep s a
835 return $ mapStateStep Left' res
837 extract (Left' s) = pextract s
838 extract (Right' _) =
839 throwM $ ParseError "takeEndByEsc: trailing escape"
841-- | See 'Streamly.Internal.Data.Parser.takeEndBy_'.
842--
843-- /Pre-release/
844--
845{-# INLINE takeEndBy_ #-}
846takeEndBy_ :: MonadCatch m =>
847 (a -> Bool) -> Parser m a b -> Parser m a b
848takeEndBy_ cond (Parser pstep pinitial pextract) =
850 Parser step initial pextract
852 where
854 initial = pinitial
856 step s a =
857 if cond a
858 then do
859 res <- pextract s
860 return $ Done 0 res
861 else pstep s a
863-- | See 'Streamly.Internal.Data.Parser.takeStartBy'.
864--
865-- /Pre-release/
866--
868{-# INLINE takeStartBy #-}
869takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
870takeStartBy cond (Fold fstep finitial fextract) =
872 Parser step initial extract
874 where
876 initial = do
877 res <- finitial
878 return $
879 case res of
880 FL.Partial s -> IPartial (Left' s)
881 FL.Done _ -> IError "takeStartBy: fold done without input"
883 {-# INLINE process #-}
884 process s a = do
885 res <- fstep s a
886 return
887 $ case res of
888 FL.Partial s1 -> Partial 0 (Right' s1)
889 FL.Done b -> Done 0 b
891 step (Left' s) a =
892 if cond a
893 then process s a
894 else return $ Error "takeStartBy: missing frame start"
895 step (Right' s) a =
896 if not (cond a)
897 then process s a
898 else Done 1 <$> fextract s
900 extract (Left' s) = fextract s
901 extract (Right' s) = fextract s
903data FramedEscState s =
904 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
906{-# INLINE takeFramedByEsc_ #-}
907takeFramedByEsc_ :: MonadThrow m =>
908 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
909takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
911 Parser step initial extract
913 where
915 initial = do
916 res <- finitial
917 return $
918 case res of
919 FL.Partial s -> IPartial (FrameEscInit s)
920 FL.Done _ ->
921 error "takeFramedByEsc_: fold done without input"
923 {-# INLINE process #-}
924 process s a n = do
925 res <- fstep s a
926 return
927 $ case res of
928 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
929 FL.Done b -> Done 0 b
931 step (FrameEscInit s) a =
932 if isBegin a
933 then return $ Partial 0 (FrameEscGo s 0)
934 else return $ Error "takeFramedByEsc_: missing frame start"
935 step (FrameEscGo s n) a =
936 if isEsc a
937 then return $ Partial 0 $ FrameEscEsc s n
938 else do
939 if not (isEnd a)
940 then
941 let n1 = if isBegin a then n + 1 else n
942 in process s a n1
943 else
944 if n == 0
945 then Done 0 <$> fextract s
946 else process s a (n - 1)
947 step (FrameEscEsc s n) a = process s a n
949 err = throwM . ParseError
951 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
952 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
953 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
955data FramedState s = FrameInit !s | FrameGo !s Int
957{-# INLINE takeFramedBy_ #-}
958takeFramedBy_ :: MonadThrow m =>
959 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
960takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
962 Parser step initial extract
964 where
966 initial = do
967 res <- finitial
968 return $
969 case res of
970 FL.Partial s -> IPartial (FrameInit s)
971 FL.Done _ ->
972 error "takeFramedBy_: fold done without input"
974 {-# INLINE process #-}
975 process s a n = do
976 res <- fstep s a
977 return
978 $ case res of
979 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
980 FL.Done b -> Done 0 b
982 step (FrameInit s) a =
983 if isBegin a
984 then return $ Continue 0 (FrameGo s 0)
985 else return $ Error "takeFramedBy_: missing frame start"
986 step (FrameGo s n) a
987 | not (isEnd a) =
988 let n1 = if isBegin a then n + 1 else n
989 in process s a n1
990 | n == 0 = Done 0 <$> fextract s
991 | otherwise = process s a (n - 1)
993 err = throwM . ParseError
995 extract (FrameInit _) = err "takeFramedBy_: empty token"
996 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
998-------------------------------------------------------------------------------
999-- Grouping and words
1000-------------------------------------------------------------------------------
1002data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1004-- | See 'Streamly.Internal.Data.Parser.wordBy'.
1007{-# INLINE wordBy #-}
1008wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
1009wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1011 where
1013 {-# INLINE worder #-}
1014 worder s a = do
1015 res <- fstep s a
1016 return
1017 $ case res of
1018 FL.Partial s1 -> Partial 0 $ WBWord s1
1019 FL.Done b -> Done 0 b
1021 initial = do
1022 res <- finitial
1023 return
1024 $ case res of
1025 FL.Partial s -> IPartial $ WBLeft s
1026 FL.Done b -> IDone b
1028 step (WBLeft s) a =
1029 if not (predicate a)
1030 then worder s a
1031 else return $ Partial 0 $ WBLeft s
1032 step (WBWord s) a =
1033 if not (predicate a)
1034 then worder s a
1035 else do
1036 b <- fextract s
1037 return $ Partial 0 $ WBRight b
1038 step (WBRight b) a =
1039 return
1040 $ if not (predicate a)
1041 then Done 1 b
1042 else Partial 0 $ WBRight b
1044 extract (WBLeft s) = fextract s
1045 extract (WBWord s) = fextract s
1046 extract (WBRight b) = return b
1048data WordFramedState s b =
1049 WordFramedSkipPre !s
1050 | WordFramedWord !s !Int
1051 | WordFramedEsc !s !Int
1052 | WordFramedSkipPost !b
1054-- | See 'Streamly.Internal.Data.Parser.wordFramedBy'
1056{-# INLINE wordFramedBy #-}
1057wordFramedBy :: MonadCatch m =>
1058 (a -> Bool) -- ^ Escape
1059 -> (a -> Bool) -- ^ left quote
1060 -> (a -> Bool) -- ^ right quote
1061 -> (a -> Bool) -- ^ word seperator
1062 -> Fold m a b
1063 -> Parser m a b
1064wordFramedBy isEsc isBegin isEnd isSep
1065 (Fold fstep finitial fextract) =
1066 Parser step initial extract
1068 where
1070 initial = do
1071 res <- finitial
1072 return $
1073 case res of
1074 FL.Partial s -> IPartial (WordFramedSkipPre s)
1075 FL.Done _ ->
1076 error "wordFramedBy: fold done without input"
1078 {-# INLINE process #-}
1079 process s a n = do
1080 res <- fstep s a
1081 return
1082 $ case res of
1083 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1084 FL.Done b -> Done 0 b
1086 step (WordFramedSkipPre s) a
1087 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1088 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1089 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1090 | isEnd a =
1091 return $ Error "wordFramedBy: missing frame start"
1092 | otherwise = process s a 0
1093 step (WordFramedWord s n) a
1094 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1095 | n == 0 && isSep a = do
1096 b <- fextract s
1097 return $ Partial 0 $ WordFramedSkipPost b
1098 | otherwise = do
1099 -- We need to use different order for checking begin and end for
1100 -- the n == 0 and n == 1 case so that when the begin and end
1101 -- character is the same we treat the one after begin as end.
1102 if n == 0
1103 then
1104 -- Need to check isBegin first
1105 if isBegin a
1106 then return $ Continue 0 $ WordFramedWord s 1
1107 else if isEnd a
1108 then return $ Error "wordFramedBy: missing frame start"
1109 else process s a n
1110 else
1111 -- Need to check isEnd first
1112 if isEnd a
1113 then
1114 if n == 1
1115 then return $ Continue 0 $ WordFramedWord s 0
1116 else process s a (n - 1)
1117 else if isBegin a
1118 then process s a (n + 1)
1119 else process s a n
1120 step (WordFramedEsc s n) a = process s a n
1121 step (WordFramedSkipPost b) a =
1122 return
1123 $ if not (isSep a)
1124 then Done 1 b
1125 else Partial 0 $ WordFramedSkipPost b
1127 err = throwM . ParseError
1129 extract (WordFramedSkipPre s) = fextract s
1130 extract (WordFramedWord s n) =
1131 if n == 0
1132 then fextract s
1133 else err "wordFramedBy: missing frame end"
1134 extract (WordFramedEsc _ _) =
1135 err "wordFramedBy: trailing escape"
1136 extract (WordFramedSkipPost b) = return b
1138data WordQuotedState s b a =
1139 WordQuotedSkipPre !s
1140 | WordUnquotedWord !s
1141 | WordQuotedWord !s !Int a
1142 | WordUnquotedEsc !s
1143 | WordQuotedEsc !s !Int a
1144 | WordQuotedSkipPost !b
1146{-# INLINE wordQuotedBy #-}
1147wordQuotedBy :: (MonadCatch m, Eq a) =>
1148 (a -> Bool) -- ^ Escape
1149 -> (a -> Bool) -- ^ left quote
1150 -> (a -> Bool) -- ^ right quote
1151 -> (a -> a) -- ^ get right quote from the left quote
1152 -> (a -> Bool) -- ^ word seperator
1153 -> Fold m a b
1154 -> Parser m a b
1155wordQuotedBy isEsc isBegin isEnd toRight isSep
1156 (Fold fstep finitial fextract) =
1157 Parser step initial extract
1159 where
1161 initial = do
1162 res <- finitial
1163 return $
1164 case res of
1165 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1166 FL.Done _ ->
1167 error "wordQuotedBy: fold done without input"
1169 {-# INLINE process #-}
1170 process s a n q = do
1171 res <- fstep s a
1172 return
1173 $ case res of
1174 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n q)
1175 FL.Done b -> Done 0 b
1177 {-# INLINE processUnquoted #-}
1178 processUnquoted s a = do
1179 res <- fstep s a
1180 return
1181 $ case res of
1182 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1183 FL.Done b -> Done 0 b
1185 step (WordQuotedSkipPre s) a
1186 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1187 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1188 | isBegin a = return $ Continue 0 $ WordQuotedWord s 1 a
1189 | isEnd a =
1190 return $ Error "wordQuotedBy: missing frame start"
1191 | otherwise = processUnquoted s a
1192 step (WordUnquotedWord s) a
1193 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1194 | isSep a = do
1195 b <- fextract s
1196 return $ Partial 0 $ WordQuotedSkipPost b
1197 | otherwise = do
1198 if isBegin a
1199 then return $ Continue 0 $ WordQuotedWord s 1 a
1200 else if isEnd a
1201 then return $ Error "wordQuotedBy: missing frame start"
1202 else processUnquoted s a
1203 step (WordQuotedWord s n q) a
1204 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n q
1205 | n == 0 && isSep a = do
1206 b <- fextract s
1207 return $ Partial 0 $ WordQuotedSkipPost b
1208 | otherwise = do
1209 if a == toRight q
1210 then
1211 if n == 1
1212 then return $ Continue 0 $ WordUnquotedWord s
1213 else process s a (n - 1) q
1214 else if a == q
1215 then process s a (n + 1) q
1216 else process s a n q
1217 step (WordUnquotedEsc s) a = processUnquoted s a
1218 step (WordQuotedEsc s n q) a = process s a n q
1219 step (WordQuotedSkipPost b) a =
1220 return
1221 $ if not (isSep a)
1222 then Done 1 b
1223 else Partial 0 $ WordQuotedSkipPost b
1225 err = throwM . ParseError
1227 extract (WordQuotedSkipPre s) = fextract s
1228 extract (WordUnquotedWord s) = fextract s
1229 extract (WordQuotedWord s n _) =
1230 if n == 0
1231 then fextract s
1232 else err "wordQuotedBy: missing frame end"
1233 extract WordQuotedEsc {} =
1234 err "wordQuotedBy: trailing escape"
1235 extract (WordUnquotedEsc _) =
1236 err "wordQuotedBy: trailing escape"
1237 extract (WordQuotedSkipPost b) = return b
1239{-# ANN type GroupByState Fuse #-}
1240data GroupByState a s
1241 = GroupByInit !s
1242 | GroupByGrouping !a !s
1244-- | See 'Streamly.Internal.Data.Parser.groupBy'.
1246{-# INLINE groupBy #-}
1247groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1248groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1250 where
1252 {-# INLINE grouper #-}
1253 grouper s a0 a = do
1254 res <- fstep s a
1255 return
1256 $ case res of
1257 FL.Done b -> Done 0 b
1258 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1260 initial = do
1261 res <- finitial
1262 return
1263 $ case res of
1264 FL.Partial s -> IPartial $ GroupByInit s
1265 FL.Done b -> IDone b
1267 step (GroupByInit s) a = grouper s a a
1268 step (GroupByGrouping a0 s) a =
1269 if eq a0 a
1270 then grouper s a0 a
1271 else Done 1 <$> fextract s
1273 extract (GroupByInit s) = fextract s
1274 extract (GroupByGrouping _ s) = fextract s
1276-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
1278{-# INLINE groupByRolling #-}
1279groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1280groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1282 where
1284 {-# INLINE grouper #-}
1285 grouper s a = do
1286 res <- fstep s a
1287 return
1288 $ case res of
1289 FL.Done b -> Done 0 b
1290 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1292 initial = do
1293 res <- finitial
1294 return
1295 $ case res of
1296 FL.Partial s -> IPartial $ GroupByInit s
1297 FL.Done b -> IDone b
1299 step (GroupByInit s) a = grouper s a
1300 step (GroupByGrouping a0 s) a =
1301 if eq a0 a
1302 then grouper s a
1303 else Done 1 <$> fextract s
1305 extract (GroupByInit s) = fextract s
1306 extract (GroupByGrouping _ s) = fextract s
1308{-# ANN type GroupByStatePair Fuse #-}
1309data GroupByStatePair a s1 s2
1310 = GroupByInitPair !s1 !s2
1311 | GroupByGroupingPair !a !s1 !s2
1312 | GroupByGroupingPairL !a !s1 !s2
1313 | GroupByGroupingPairR !a !s1 !s2
1315{-# INLINE groupByRollingEither #-}
1316groupByRollingEither :: MonadCatch m =>
1317 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
1318groupByRollingEither
1319 eq
1320 (Fold fstep1 finitial1 fextract1)
1321 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
1323 where
1325 {-# INLINE grouper #-}
1326 grouper s1 s2 a = do
1327 return $ Continue 0 (GroupByGroupingPair a s1 s2)
1329 {-# INLINE grouperL2 #-}
1330 grouperL2 s1 s2 a = do
1331 res <- fstep1 s1 a
1332 return
1333 $ case res of
1334 FL.Done b -> Done 0 (Left b)
1335 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
1337 {-# INLINE grouperL #-}
1338 grouperL s1 s2 a0 a = do
1339 res <- fstep1 s1 a0
1340 case res of
1341 FL.Done b -> return $ Done 0 (Left b)
1342 FL.Partial s11 -> grouperL2 s11 s2 a
1344 {-# INLINE grouperR2 #-}
1345 grouperR2 s1 s2 a = do
1346 res <- fstep2 s2 a
1347 return
1348 $ case res of
1349 FL.Done b -> Done 0 (Right b)
1350 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
1352 {-# INLINE grouperR #-}
1353 grouperR s1 s2 a0 a = do
1354 res <- fstep2 s2 a0
1355 case res of
1356 FL.Done b -> return $ Done 0 (Right b)
1357 FL.Partial s21 -> grouperR2 s1 s21 a
1359 initial = do
1360 res1 <- finitial1
1361 res2 <- finitial2
1362 return
1363 $ case res1 of
1364 FL.Partial s1 ->
1365 case res2 of
1366 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
1367 FL.Done b -> IDone (Right b)
1368 FL.Done b -> IDone (Left b)
1370 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
1372 step (GroupByGroupingPair a0 s1 s2) a =
1373 if not (eq a0 a)
1374 then grouperL s1 s2 a0 a
1375 else grouperR s1 s2 a0 a
1377 step (GroupByGroupingPairL a0 s1 s2) a =
1378 if not (eq a0 a)
1379 then grouperL2 s1 s2 a
1380 else Done 1 . Left <$> fextract1 s1
1382 step (GroupByGroupingPairR a0 s1 s2) a =
1383 if eq a0 a
1384 then grouperR2 s1 s2 a
1385 else Done 1 . Right <$> fextract2 s2
1387 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
1388 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
1389 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
1390 extract (GroupByGroupingPair a s1 _) = do
1391 res <- fstep1 s1 a
1392 case res of
1393 FL.Done b -> return $ Left b
1394 FL.Partial s11 -> Left <$> fextract1 s11
1396-- XXX use an Unfold instead of a list?
1397-- XXX custom combinators for matching list, array and stream?
1398-- XXX rename to listBy?
1400-- | See 'Streamly.Internal.Data.Parser.eqBy'.
1402-- /Pre-release/
1404{-# INLINE eqBy #-}
1405eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
1406eqBy cmp str = Parser step initial extract
1408 where
1410 -- XXX Should return IDone in initial for [] case
1411 initial = return $ IPartial str
1413 step [] _ = return $ Done 0 ()
1414 step [x] a =
1415 return
1416 $ if x `cmp` a
1417 then Done 0 ()
1418 else Error "eqBy: failed, yet to match the last element"
1419 step (x:xs) a =
1420 return
1421 $ if x `cmp` a
1422 then Continue 0 xs
1423 else Error
1424 $ "eqBy: failed, yet to match "
1425 ++ show (length xs + 1) ++ " elements"
1427 extract xs =
1428 throwM
1429 $ ParseError
1430 $ "eqBy: end of input, yet to match "
1431 ++ show (length xs) ++ " elements"
1433-- XXX rename to streamBy?
1434-- | Like eqBy but uses a stream instead of a list
1435{-# INLINE matchBy #-}
1436matchBy :: MonadThrow m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
1437matchBy cmp (D.Stream sstep state) = Parser step initial extract
1439 where
1441 initial = do
1442 r <- sstep defState state
1443 case r of
1444 D.Yield x s -> return $ IPartial (Just' x, s)
1445 D.Stop -> return $ IDone ()
1446 -- Need Skip/Continue in initial to loop right here
1447 D.Skip s -> return $ IPartial (Nothing', s)
1449 step (Just' x, st) a =
1450 if x `cmp` a
1451 then do
1452 r <- sstep defState st
1453 return
1454 $ case r of
1455 D.Yield x1 s -> Continue 0 (Just' x1, s)
1456 D.Stop -> Done 0 ()
1457 D.Skip s -> Continue 1 (Nothing', s)
1458 else return $ Error "match: mismtach occurred"
1459 step (Nothing', st) a = do
1460 r <- sstep defState st
1461 return
1462 $ case r of
1463 D.Yield x s -> do
1464 if x `cmp` a
1465 then Continue 0 (Nothing', s)
1466 else Error "match: mismatch occurred"
1467 D.Stop -> Done 1 ()
1468 D.Skip s -> Continue 1 (Nothing', s)
1470 extract _ = throwM $ ParseError "match: end of input"
1472-------------------------------------------------------------------------------
1473-- Transformations on input
1474-------------------------------------------------------------------------------
1476-- Initial needs a "Continue" constructor to implement scans on parsers. As a
1477-- parser can always return a Continue in initial when we feed the fold's
1478-- initial result to it. We can work this around for postscan by introducing an
1479-- initial state and calling "initial" only on the first input.
1481-- | Stateful scan on the input of a parser using a Fold.
1483-- /Unimplemented/
1485{-# INLINE postscan #-}
1486postscan :: -- Monad m =>
1487 Fold m a b -> Parser m b c -> Parser m a c
1488postscan = undefined
1490{-# INLINE zipWithM #-}
1491zipWithM :: MonadThrow m =>
1492 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
1493zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
1494 Parser step initial extract
1496 where
1498 initial = do
1499 fres <- finitial
1500 case fres of
1501 FL.Partial fs -> do
1502 r <- sstep defState state
1503 case r of
1504 D.Yield x s -> return $ IPartial (Just' x, s, fs)
1505 D.Stop -> do
1506 x <- fextract fs
1507 return $ IDone x
1508 -- Need Skip/Continue in initial to loop right here
1509 D.Skip s -> return $ IPartial (Nothing', s, fs)
1510 FL.Done x -> return $ IDone x
1512 step (Just' a, st, fs) b = do
1513 c <- zf a b
1514 fres <- fstep fs c
1515 case fres of
1516 FL.Partial fs1 -> do
1517 r <- sstep defState st
1518 case r of
1519 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
1520 D.Stop -> do
1521 x <- fextract fs1
1522 return $ Done 0 x
1523 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
1524 FL.Done x -> return $ Done 0 x
1525 step (Nothing', st, fs) b = do
1526 r <- sstep defState st
1527 case r of
1528 D.Yield a s -> do
1529 c <- zf a b
1530 fres <- fstep fs c
1531 case fres of
1532 FL.Partial fs1 ->
1533 return $ Continue 0 (Nothing', s, fs1)
1534 FL.Done x -> return $ Done 0 x
1535 D.Stop -> do
1536 x <- fextract fs
1537 return $ Done 1 x
1538 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
1540 extract _ = throwM $ ParseError "zipWithM: end of input"
1542-- | Zip the input of a fold with a stream.
1544-- /Pre-release/
1546{-# INLINE zip #-}
1547zip :: MonadThrow m => D.Stream m a -> Fold m (a, b) x -> Parser m b x
1548zip = zipWithM (curry return)
1550-- | Pair each element of a fold input with its index, starting from index 0.
1552-- /Pre-release/
1553{-# INLINE indexed #-}
1554indexed :: forall m a b. MonadThrow m => Fold m (Int, a) b -> Parser m a b
1555indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
1557-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
1558-- function using a fold indexing function that attaches an index to each input
1559-- element and a filtering function that filters using @(index, element) ->
1560-- Bool) as predicate.
1562-- For example:
1564-- @
1565-- filterWithIndex = makeIndexFilter indexed filter
1566-- filterWithAbsTime = makeIndexFilter timestamped filter
1567-- filterWithRelTime = makeIndexFilter timeIndexed filter
1568-- @
1570-- /Pre-release/
1571{-# INLINE makeIndexFilter #-}
1572makeIndexFilter ::
1573 (Fold m (s, a) b -> Parser m a b)
1574 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
1575 -> (((s, a) -> Bool) -> Fold m a b -> Parser m a b)
1576makeIndexFilter f comb g = f . comb g . FL.lmap snd
1578-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
1579-- then every element at strides of @stride@.
1581-- /Pre-release/
1582{-# INLINE sampleFromthen #-}
1583sampleFromthen :: MonadThrow m => Int -> Int -> Fold m a b -> Parser m a b
1584sampleFromthen offset size =
1585 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
1587--------------------------------------------------------------------------------
1588--- Spanning
1589--------------------------------------------------------------------------------
1591-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1592-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1593-- input.
1595-- @
1596-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
1598-- > span_ (< 1) [1,2,3]
1599-- ([],[1,2,3])
1601-- > span_ (< 2) [1,2,3]
1602-- ([1],[2,3])
1604-- > span_ (< 4) [1,2,3]
1605-- ([1,2,3],[])
1607-- @
1609-- /Pre-release/
1610{-# INLINE span #-}
1611span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1612span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1614-- | Break the input stream into two groups, the first group takes the input as
1615-- long as the predicate applied to the first element of the stream and next
1616-- input element holds 'True', the second group takes the rest of the input.
1618-- /Pre-release/
1620{-# INLINE spanBy #-}
1621spanBy ::
1622 Monad m
1623 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1624spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1626-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1627-- predicate is applied to the previous and the next input elements.
1629-- /Pre-release/
1630{-# INLINE spanByRolling #-}
1631spanByRolling ::
1632 Monad m
1633 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1634spanByRolling eq f1 f2 =
1635 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1637-------------------------------------------------------------------------------
1638-- nested parsers
1639-------------------------------------------------------------------------------
1641-- | See 'Streamly.Internal.Data.Parser.takeP'.
1643-- /Internal/
1644{-# INLINE takeP #-}
1645takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1646takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1648 where
1650 initial = do
1651 res <- pinitial
1652 case res of
1653 IPartial s ->
1654 if lim > 0
1655 then return $ IPartial $ Tuple' 0 s
1656 else IDone <$> pextract s
1657 IDone b -> return $ IDone b
1658 IError e -> return $ IError e
1660 step (Tuple' cnt r) a = do
1661 assert (cnt < lim) (return ())
1662 res <- pstep r a
1663 let cnt1 = cnt + 1
1664 case res of
1665 Partial 0 s -> do
1666 assert (cnt1 >= 0) (return ())
1667 if cnt1 < lim
1668 then return $ Partial 0 $ Tuple' cnt1 s
1669 else Done 0 <$> pextract s
1670 Continue 0 s -> do
1671 assert (cnt1 >= 0) (return ())
1672 if cnt1 < lim
1673 then return $ Continue 0 $ Tuple' cnt1 s
1674 -- XXX This should error out?
1675 -- If designed properly, this will probably error out.
1676 -- "pextract" should error out
1677 --
1678 -- By Harendra,
1679 --
1680 -- This is a tricky case, we have the following options:
1681 -- 1. Done 0 with extract as you have written
1682 -- 2. Done n, will require buffering elements
1683 -- 3. Use a backtracking fold and not a parser, once we have
1684 -- backtracking in folds
1685 else Done 0 <$> pextract s
1686 Partial n s -> do
1687 let taken = cnt1 - n
1688 assert (taken >= 0) (return ())
1689 return $ Partial n $ Tuple' taken s
1690 Continue n s -> do
1691 let taken = cnt1 - n
1692 assert (taken >= 0) (return ())
1693 return $ Continue n $ Tuple' taken s
1694 Done n b -> return $ Done n b
1695 Error str -> return $ Error str
1697 extract (Tuple' _ r) = pextract r
1699-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1701-- /Pre-release/
1703{-# INLINE lookAhead #-}
1704lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1705lookAhead (Parser step1 initial1 _) = Parser step initial extract
1707 where
1709 initial = do
1710 res <- initial1
1711 return $ case res of
1712 IPartial s -> IPartial (Tuple' 0 s)
1713 IDone b -> IDone b
1714 IError e -> IError e
1716 step (Tuple' cnt st) a = do
1717 r <- step1 st a
1718 let cnt1 = cnt + 1
1719 return
1720 $ case r of
1721 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1722 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1723 Done _ b -> Done cnt1 b
1724 Error err -> Error err
1726 -- XXX returning an error let's us backtrack. To implement it in a way so
1727 -- that it terminates on eof without an error then we need a way to
1728 -- backtrack on eof, that will require extract to return 'Step' type.
1729 extract (Tuple' n _) =
1730 throwM
1731 $ ParseError
1732 $ "lookAhead: end of input after consuming "
1733 ++ show n ++ " elements"
1735-------------------------------------------------------------------------------
1736-- Interleaving
1737-------------------------------------------------------------------------------
1739data DeintercalateState fs sp ss =
1740 DeintercalateL !fs !sp
1741 | DeintercalateR !fs !ss !Bool
1743-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1745-- /Internal/
1747{-# INLINE deintercalate #-}
1748deintercalate :: Monad m =>
1749 Fold m (Either x y) z
1750 -> Parser m a x
1751 -> Parser m a y
1752 -> Parser m a z
1753deintercalate
1754 (Fold fstep finitial fextract)
1755 (Parser stepL initialL extractL)
1756 (Parser stepR initialR extractR) = Parser step initial extract
1758 where
1760 errMsg p status =
1761 error $ "deintercalate: " ++ p ++ " parser cannot "
1762 ++ status ++ " without input"
1764 initial = do
1765 res <- finitial
1766 case res of
1767 FL.Partial fs -> do
1768 resL <- initialL
1769 case resL of
1770 IPartial sL -> return $ IPartial $ DeintercalateL fs sL
1771 IDone _ -> errMsg "left" "succeed"
1772 IError _ -> errMsg "left" "fail"
1773 FL.Done c -> return $ IDone c
1775 step (DeintercalateL fs sL) a = do
1776 r <- stepL sL a
1777 case r of
1778 Partial n s -> return $ Partial n (DeintercalateL fs s)
1779 Continue n s -> return $ Continue n (DeintercalateL fs s)
1780 Done n b -> do
1781 fres <- fstep fs (Left b)
1782 case fres of
1783 FL.Partial fs1 -> do
1784 resR <- initialR
1785 case resR of
1786 IPartial sR ->
1787 return
1788 $ Partial n (DeintercalateR fs1 sR False)
1789 IDone _ -> errMsg "right" "succeed"
1790 IError _ -> errMsg "right" "fail"
1791 FL.Done c -> return $ Done n c
1792 Error err -> return $ Error err
1793 step (DeintercalateR fs sR consumed) a = do
1794 r <- stepR sR a
1795 case r of
1796 Partial n s -> return $ Partial n (DeintercalateR fs s True)
1797 Continue n s -> return $ Continue n (DeintercalateR fs s True)
1798 Done n b ->
1799 if consumed
1800 then do
1801 fres <- fstep fs (Right b)
1802 case fres of
1803 FL.Partial fs1 -> do
1804 resL <- initialL
1805 case resL of
1806 IPartial sL ->
1807 return $ Partial n $ DeintercalateL fs1 sL
1808 IDone _ -> errMsg "left" "succeed"
1809 IError _ -> errMsg "left" "fail"
1810 FL.Done c -> return $ Done n c
1811 else error "deintercalate: infinite loop"
1812 Error err -> return $ Error err
1814 extract (DeintercalateL fs sL) = do
1815 r <- extractL sL
1816 res <- fstep fs (Left r)
1817 case res of
1818 FL.Partial fs1 -> fextract fs1
1819 FL.Done c -> return c
1820 extract (DeintercalateR fs sR _) = do
1821 r <- extractR sR
1822 res <- fstep fs (Right r)
1823 case res of
1824 FL.Partial fs1 -> fextract fs1
1825 FL.Done c -> return c
1827data SepByState fs sp ss =
1828 SepByInit !fs !sp
1829 | SepBySeparator !fs !ss !Bool
1831-- This is a special case of deintercalate and can be easily implemented in
1832-- terms of deintercalate.
1833{-# INLINE sepBy #-}
1834sepBy :: MonadCatch m =>
1835 Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1836sepBy
1837 (Fold fstep finitial fextract)
1838 (Parser pstep pinitial pextract)
1839 (Parser sstep sinitial _) = Parser step initial extract
1841 where
1843 errMsg p status =
1844 error $ "sepBy: " ++ p ++ " parser cannot "
1845 ++ status ++ " without input"
1847 initial = do
1848 res <- finitial
1849 case res of
1850 FL.Partial fs -> do
1851 resP <- pinitial
1852 case resP of
1853 IPartial sp -> return $ IPartial $ SepByInit fs sp
1854 IDone _ -> errMsg "content" "succeed"
1855 IError _ -> errMsg "content" "fail"
1856 FL.Done b -> return $ IDone b
1858 step (SepByInit fs sp) a = do
1859 r <- pstep sp a
1860 case r of
1861 Partial n s -> return $ Partial n (SepByInit fs s)
1862 Continue n s -> return $ Continue n (SepByInit fs s)
1863 Done n b -> do
1864 fres <- fstep fs b
1865 case fres of
1866 FL.Partial fs1 -> do
1867 resS <- sinitial
1868 case resS of
1869 IPartial ss ->
1870 return $ Partial n (SepBySeparator fs1 ss False)
1871 IDone _ -> errMsg "separator" "succeed"
1872 IError _ -> errMsg "separator" "fail"
1873 FL.Done c -> return $ Done n c
1874 Error err -> return $ Error err
1875 step (SepBySeparator fs ss consumed) a = do
1876 r <- sstep ss a
1877 case r of
1878 Partial n s -> return $ Partial n (SepBySeparator fs s True)
1879 Continue n s -> return $ Continue n (SepBySeparator fs s True)
1880 Done n _ ->
1881 if consumed
1882 then do
1883 resP <- pinitial
1884 case resP of
1885 IPartial sp -> return $ Partial n $ SepByInit fs sp
1886 IDone _ -> errMsg "content" "succeed"
1887 IError _ -> errMsg "content" "fail"
1888 else error "sepBy: infinite loop"
1889 Error err -> return $ Error err
1891 extract (SepByInit fs sp) = do
1892 r <- pextract sp
1893 res <- fstep fs r
1894 case res of
1895 FL.Partial fs1 -> fextract fs1
1896 FL.Done c -> return c
1897 extract (SepBySeparator fs _ _) = fextract fs
1899-------------------------------------------------------------------------------
1900-- Sequential Collection
1901-------------------------------------------------------------------------------
1903-- | See 'Streamly.Internal.Data.Parser.sequence'.
1905-- /Unimplemented/
1907{-# INLINE sequence #-}
1908sequence ::
1909 -- Foldable t =>
1910 Fold m b c -> t (Parser m a b) -> Parser m a c
1911sequence _f _p = undefined
1913-------------------------------------------------------------------------------
1914-- Alternative Collection
1915-------------------------------------------------------------------------------
1917-- | See 'Streamly.Internal.Data.Parser.choice'.
1919-- /Broken/
1921{-# INLINE choice #-}
1922choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
1923choice = foldl1 shortest
1925-------------------------------------------------------------------------------
1926-- Sequential Repetition
1927-------------------------------------------------------------------------------
1929{-# INLINE manyP #-}
1930manyP :: -- MonadCatch m =>
1931 Parser m a b -> Parser m b c -> Parser m a c
1932manyP _p _f = undefined
1934-- | See 'Streamly.Internal.Data.Parser.many'.
1936-- /Pre-release/
1938{-# INLINE many #-}
1939many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1940many = splitMany
1941-- many = countBetween 0 maxBound
1943-- | See 'Streamly.Internal.Data.Parser.some'.
1945-- /Pre-release/
1947{-# INLINE some #-}
1948some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1949some = splitSome
1950-- some p f = manyP p (takeGE 1 f)
1951-- some = countBetween 1 maxBound
1953-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1955-- /Unimplemented/
1957{-# INLINE countBetween #-}
1958countBetween :: -- MonadCatch m =>
1959 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1960countBetween _m _n _p = undefined
1961-- countBetween m n p f = manyP p (takeBetween m n f)
1963-- | See 'Streamly.Internal.Data.Parser.count'.
1965-- /Unimplemented/
1967{-# INLINE count #-}
1968count :: -- MonadCatch m =>
1969 Int -> Parser m a b -> Fold m b c -> Parser m a c
1970count n = countBetween n n
1971-- count n p f = manyP p (takeEQ n f)
1973data ManyTillState fs sr sl
1974 = ManyTillR Int fs sr
1975 | ManyTillL Int fs sl
1977-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1979-- /Pre-release/
1981{-# INLINE manyTill #-}
1982manyTill :: MonadCatch m
1983 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1984manyTill (Fold fstep finitial fextract)
1985 (Parser stepL initialL extractL)
1986 (Parser stepR initialR _) =
1987 Parser step initial extract
1989 where
1991 -- Caution: Mutual recursion
1993 scrutL fs p c d e = do
1994 resL <- initialL
1995 case resL of
1996 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1997 IDone bl -> do
1998 fr <- fstep fs bl
1999 case fr of
2000 FL.Partial fs1 -> scrutR fs1 p c d e
2001 FL.Done fb -> return $ d fb
2002 IError err -> return $ e err
2004 scrutR fs p c d e = do
2005 resR <- initialR
2006 case resR of
2007 IPartial sr -> return $ p (ManyTillR 0 fs sr)
2008 IDone _ -> d <$> fextract fs
2009 IError _ -> scrutL fs p c d e
2011 initial = do
2012 res <- finitial
2013 case res of
2014 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
2015 FL.Done b -> return $ IDone b
2017 step (ManyTillR cnt fs st) a = do
2018 r <- stepR st a
2019 case r of
2020 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
2021 Continue n s -> do
2022 assert (cnt + 1 - n >= 0) (return ())
2023 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
2024 Done n _ -> do
2025 b <- fextract fs
2026 return $ Done n b
2027 Error _ -> do
2028 resL <- initialL
2029 case resL of
2030 IPartial sl ->
2031 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
2032 IDone bl -> do
2033 fr <- fstep fs bl
2034 let cnt1 = cnt + 1
2035 p = Partial cnt
2036 c = Continue cnt
2037 d = Done cnt
2038 case fr of
2039 FL.Partial fs1 -> scrutR fs1 p c d Error
2040 FL.Done fb -> return $ Done cnt1 fb
2041 IError err -> return $ Error err
2042 -- XXX the cnt is being used only by the assert
2043 step (ManyTillL cnt fs st) a = do
2044 r <- stepL st a
2045 case r of
2046 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
2047 Continue n s -> do
2048 assert (cnt + 1 - n >= 0) (return ())
2049 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
2050 Done n b -> do
2051 fs1 <- fstep fs b
2052 case fs1 of
2053 FL.Partial s ->
2054 scrutR s (Partial n) (Continue n) (Done n) Error
2055 FL.Done b1 -> return $ Done n b1
2056 Error err -> return $ Error err
2058 extract (ManyTillL _ fs sR) = do
2059 res <- extractL sR >>= fstep fs
2060 case res of
2061 FL.Partial s -> fextract s
2062 FL.Done b -> return b
2063 extract (ManyTillR _ fs _) = fextract fs