git.iko.soy/streamly
on ffca3ac help sign in
streamly/core/src/Streamly/Internal/Data/Parser/ParserD.hs
2174 lines 67 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 , fromFoldMaybe
32 , fromPure
33 , fromEffect
34 , die
35 , dieM
37 -- * Map on input
38 , lmap
39 , lmapM
40 , postscan
41 , filter
43 -- * Element parsers
44 , peek
45 , eof
46 , satisfy
47 , next
48 , maybe
49 , either
51 -- * Sequence parsers
52 --
53 -- Parsers chained in series, if one parser terminates the composition
54 -- terminates. Currently we are using folds to collect the output of the
55 -- parsers but we can use Parsers instead of folds to make the composition
56 -- more powerful. For example, we can do:
57 --
58 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
59 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
60 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
62 -- Grab a sequence of input elements without inspecting them
63 , takeBetween
64 -- , take -- take -- takeBetween 0 n
65 , takeEQ -- takeBetween n n
66 , takeGE -- takeBetween n maxBound
67 -- , takeGE1 -- take1 -- takeBetween 1 n
68 , takeP
70 -- Grab a sequence of input elements by inspecting them
71 , lookAhead
72 , takeWhile
73 , takeWhileP
74 , takeWhile1
76 -- Separators
77 , takeEndBy
78 , takeEndBy_
79 , takeEndByEsc
80 , takeStartBy
81 , takeFramedBy_
82 , takeFramedByEsc_
83 , takeFramedByGeneric
85 -- Words and grouping
86 , wordBy
87 , wordFramedBy
88 , wordQuotedBy
89 , groupBy
90 , groupByRolling
91 , groupByRollingEither
93 -- Matching strings
94 , eqBy
95 , matchBy
96 -- , prefixOf -- match any prefix of a given string
97 -- , suffixOf -- match any suffix of a given string
98 -- , infixOf -- match any substring of a given string
100 -- ** Spanning
101 , span
102 , spanBy
103 , spanByRolling
105 -- Second order parsers (parsers using parsers)
106 -- * Binary Combinators
108 -- ** Sequential Applicative
109 , serialWith
110 , split_
112 -- ** Parallel Applicatives
113 , teeWith
114 , teeWithFst
115 , teeWithMin
116 -- , teeTill -- like manyTill but parallel
118 -- ** Sequential Interleaving
119 -- Use two folds, run a primary parser, its rejected values go to the
120 -- secondary parser.
121 , deintercalate
122 , sepBy
124 -- ** Sequential Alternative
125 , alt
127 -- ** Parallel Alternatives
128 , shortest
129 , longest
130 -- , fastest
132 -- * N-ary Combinators
133 -- ** Sequential Collection
134 , sequence
135 , concatMap
137 -- ** Sequential Repetition
138 , count
139 , countBetween
140 -- , countBetweenTill
142 , many
143 , manyP
144 , some
145 , manyTill
147 -- -- ** Special cases
148 -- XXX traditional implmentations of these may be of limited use. For
149 -- example, consider parsing lines separated by "\r\n". The main parser
150 -- will have to detect and exclude the sequence "\r\n" anyway so that we
151 -- can apply the "sep" parser.
152 --
153 -- We can instead implement these as special cases of deintercalate.
154 --
155 -- , endBy
156 -- , sepBy
157 -- , sepEndBy
158 -- , beginBy
159 -- , sepBeginBy
160 -- , sepAroundBy
162 -- -- * Distribution
163 --
164 -- A simple and stupid impl would be to just convert the stream to an array
165 -- and give the array reference to all consumers. The array can be grown on
166 -- demand by any consumer and truncated when nonbody needs it.
167 --
168 -- -- ** Distribute to collection
169 -- -- ** Distribute to repetition
171 -- -- ** Interleaved collection
172 -- Round robin
173 -- Priority based
174 -- -- ** Interleaved repetition
175 -- repeat one parser and when it fails run an error recovery parser
176 -- e.g. to find a key frame in the stream after an error
178 -- ** Collection of Alternatives
179 -- , shortestN
180 -- , longestN
181 -- , fastestN -- first N successful in time
182 -- , choiceN -- first N successful in position
183 , choice -- first successful in position
185 -- -- ** Repeated Alternatives
186 -- , retryMax -- try N times
187 -- , retryUntil -- try until successful
188 -- , retryUntilN -- try until successful n times
190 -- ** Zipping Input
191 , zipWithM
192 , zip
193 , indexed
194 , makeIndexFilter
195 , sampleFromthen
196 )
197where
199import Control.Exception (assert, Exception)
200import Control.Monad (when)
201import Control.Monad.Catch (MonadCatch, MonadThrow(..))
202import Data.Bifunctor (first)
203import Fusion.Plugin.Types (Fuse(..))
204import Streamly.Internal.Data.Fold.Type (Fold(..))
205import Streamly.Internal.Data.SVar.Type (defState)
206import Streamly.Internal.Data.Either.Strict (Either'(..))
207import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
208import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
210import qualified Streamly.Internal.Data.Fold.Type as FL
211import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
212import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
214import Prelude hiding
215 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
216 , zip, filter)
217import Streamly.Internal.Data.Parser.ParserD.Tee
218import Streamly.Internal.Data.Parser.ParserD.Type
220--
221-- $setup
222-- >>> :m
223-- >>> :set -package streamly
224-- >>> import Prelude hiding ()
225-- >>> import qualified Data.Maybe as Maybe
226-- >>> import qualified Streamly.Prelude as Stream
227-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
228-- >>> import qualified Streamly.Data.Fold as Fold
229-- >>> import qualified Streamly.Internal.Data.Parser as Parser
231-------------------------------------------------------------------------------
232-- Downgrade a parser to a Fold
233-------------------------------------------------------------------------------
235data ParserToFoldError =
236 InitialError String
237 | PartialError Int
238 | ContinueError Int
239 | DoneError Int
240 | ErrorError String
241 deriving Show
243instance Exception ParserToFoldError
245-- | See 'Streamly.Internal.Data.Parser.toFold'.
246--
247-- /Internal/
248--
249{-# INLINE toFold #-}
250toFold :: MonadThrow m => Parser m a b -> Fold m a b
251toFold (Parser pstep pinitial pextract) = Fold step initial pextract
253 where
255 initial = do
256 r <- pinitial
257 case r of
258 IPartial s -> return $ FL.Partial s
259 IDone b -> return $ FL.Done b
260 IError err -> throwM $ InitialError err
262 step st a = do
263 r <- pstep st a
264 case r of
265 Partial 0 s -> return $ FL.Partial s
266 Continue 0 s -> return $ FL.Partial s
267 Done 0 b -> return $ FL.Done b
268 Partial n _ -> throwM $ PartialError n
269 Continue n _ -> throwM $ ContinueError n
270 Done n _ -> throwM $ DoneError n
271 Error err -> throwM $ ErrorError err
273-------------------------------------------------------------------------------
274-- Upgrade folds to parses
275-------------------------------------------------------------------------------
276--
277-- | See 'Streamly.Internal.Data.Parser.fromFold'.
278--
279-- /Pre-release/
280--
281{-# INLINE fromFold #-}
282fromFold :: Monad m => Fold m a b -> Parser m a b
283fromFold (Fold fstep finitial fextract) = Parser step initial fextract
285 where
287 initial = do
288 res <- finitial
289 return
290 $ case res of
291 FL.Partial s1 -> IPartial s1
292 FL.Done b -> IDone b
294 step s a = do
295 res <- fstep s a
296 return
297 $ case res of
298 FL.Partial s1 -> Partial 0 s1
299 FL.Done b -> Done 0 b
301-- | Convert Maybe returning folds to error returning parsers.
302--
303-- /Pre-release/
304--
305{-# INLINE fromFoldMaybe #-}
306fromFoldMaybe :: MonadThrow m => String -> Fold m a (Maybe b) -> Parser m a b
307fromFoldMaybe errMsg (Fold fstep finitial fextract) = Parser step initial extract
309 where
311 initial = do
312 res <- finitial
313 return
314 $ case res of
315 FL.Partial s1 -> IPartial s1
316 FL.Done b ->
317 case b of
318 Just x -> IDone x
319 Nothing -> IError errMsg
321 step s a = do
322 res <- fstep s a
323 return
324 $ case res of
325 FL.Partial s1 -> Partial 0 s1
326 FL.Done b ->
327 case b of
328 Just x -> Done 0 x
329 Nothing -> Error errMsg
331 extract s = do
332 res <- fextract s
333 case res of
334 Just x -> return x
335 Nothing -> throwM $ ParseError errMsg
337-------------------------------------------------------------------------------
338-- Failing Parsers
339-------------------------------------------------------------------------------
341-- | See 'Streamly.Internal.Data.Parser.peek'.
342--
343-- /Pre-release/
344--
345{-# INLINE peek #-}
346peek :: MonadThrow m => Parser m a a
347peek = Parser step initial extract
349 where
351 initial = return $ IPartial ()
353 step () a = return $ Done 1 a
355 extract () = throwM $ ParseError "peek: end of input"
357-- | See 'Streamly.Internal.Data.Parser.eof'.
358--
359-- /Pre-release/
360--
361{-# INLINE eof #-}
362eof :: Monad m => Parser m a ()
363eof = Parser step initial return
365 where
367 initial = return $ IPartial ()
369 step () _ = return $ Error "eof: not at end of input"
371-- | See 'Streamly.Internal.Data.Parser.next'.
372--
373-- /Pre-release/
374--
375{-# INLINE next #-}
376next :: Monad m => Parser m a (Maybe a)
377next = Parser step initial extract
378 where
379 initial = pure $ IPartial ()
380 step _ a = pure $ Done 0 (Just a)
381 extract _ = pure Nothing
383-- | See 'Streamly.Internal.Data.Parser.either'.
384--
385-- /Pre-release/
386--
387{-# INLINE either #-}
388either :: MonadThrow m => (a -> Either String b) -> Parser m a b
389either f = Parser step initial extract
391 where
393 initial = return $ IPartial ()
395 step () a = return $
396 case f a of
397 Right b -> Done 0 b
398 Left err -> Error err
400 extract _ = throwM $ ParseError "end of input"
402-- | See 'Streamly.Internal.Data.Parser.maybe'.
403--
404-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
405-- >>> maybe f = Parser.either (toEither . f)
406--
407-- /Pre-release/
408--
409{-# INLINE maybe #-}
410maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
411-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
412maybe parserF = Parser step initial extract
414 where
416 initial = return $ IPartial ()
418 step () a = return $
419 case parserF a of
420 Just b -> Done 0 b
421 Nothing -> Error "maybe: predicate failed"
423 extract _ = throwM $ ParseError "maybe: end of input"
425-- | See 'Streamly.Internal.Data.Parser.satisfy'.
426--
427-- >>> toMaybe f x = if f x then Just x else Nothing
428-- >>> satisfy f = Parser.maybe (toMaybe f)
429--
430-- /Pre-release/
431--
432{-# INLINE satisfy #-}
433satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
434-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
435satisfy predicate = Parser step initial extract
437 where
439 initial = return $ IPartial ()
441 step () a = return $
442 if predicate a
443 then Done 0 a
444 else Error "satisfy: predicate failed"
446 extract _ = throwM $ ParseError "satisfy: end of input"
448-------------------------------------------------------------------------------
449-- Taking elements
450-------------------------------------------------------------------------------
452-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
453{-# ANN type Tuple'Fused Fuse #-}
454data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
456-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
457--
458-- /Pre-release/
459--
460{-# INLINE takeBetween #-}
461takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
462takeBetween low high (Fold fstep finitial fextract) =
464 Parser step initial (extract streamErr)
466 where
468 streamErr i =
469 "takeBetween: Expecting alteast " ++ show low
470 ++ " elements, got " ++ show i
472 invalidRange =
473 "takeBetween: lower bound - " ++ show low
474 ++ " is greater than higher bound - " ++ show high
476 foldErr :: Int -> String
477 foldErr i =
478 "takeBetween: the collecting fold terminated after"
479 ++ " consuming" ++ show i ++ " elements"
480 ++ " minimum" ++ show low ++ " elements needed"
482 -- Exactly the same as snext except different constructors, we can possibly
483 -- deduplicate the two.
484 {-# INLINE inext #-}
485 inext i res =
486 let i1 = i + 1
487 in case res of
488 FL.Partial s -> do
489 let s1 = Tuple'Fused i1 s
490 if i1 < high
491 -- XXX ideally this should be a Continue instead
492 then return $ IPartial s1
493 else IDone <$> extract foldErr s1
494 FL.Done b ->
495 return
496 $ if i1 >= low
497 then IDone b
498 else IError (foldErr i1)
500 initial = do
501 when (low >= 0 && high >= 0 && low > high)
502 $ throwM $ ParseError invalidRange
504 finitial >>= inext (-1)
506 -- Keep the impl same as inext
507 {-# INLINE snext #-}
508 snext i res =
509 let i1 = i + 1
510 in case res of
511 FL.Partial s -> do
512 let s1 = Tuple'Fused i1 s
513 if i1 < high
514 then return $ Continue 0 s1
515 else Done 0 <$> extract foldErr s1
516 FL.Done b ->
517 return
518 $ if i1 >= low
519 then Done 0 b
520 else Error (foldErr i1)
522 step (Tuple'Fused i s) a = fstep s a >>= snext i
524 extract f (Tuple'Fused i s)
525 | i >= low && i <= high = fextract s
526 | otherwise = throwM $ ParseError (f i)
528-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
529--
530-- /Pre-release/
531--
532{-# INLINE takeEQ #-}
533takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
534takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
536 where
538 cnt = max n 0
540 initial = do
541 res <- finitial
542 return $ case res of
543 FL.Partial s -> IPartial $ Tuple' 0 s
544 FL.Done b ->
545 if cnt == 0
546 then IDone b
547 else IError
548 $ "takeEQ: Expecting exactly " ++ show cnt
549 ++ " elements, fold terminated without"
550 ++ " consuming any elements"
552 step (Tuple' i r) a
553 | i1 < cnt = do
554 res <- fstep r a
555 return
556 $ case res of
557 FL.Partial s -> Continue 0 $ Tuple' i1 s
558 FL.Done _ ->
559 Error
560 $ "takeEQ: Expecting exactly " ++ show cnt
561 ++ " elements, fold terminated on " ++ show i1
562 | i1 == cnt = do
563 res <- fstep r a
564 Done 0
565 <$> case res of
566 FL.Partial s -> fextract s
567 FL.Done b -> return b
568 -- XXX we should not reach here when initial returns Step type
569 -- reachable only when n == 0
570 | otherwise = Done 1 <$> fextract r
572 where
574 i1 = i + 1
576 extract (Tuple' i r)
577 | i == 0 && cnt == 0 = fextract r
578 | otherwise =
579 throwM
580 $ ParseError
581 $ "takeEQ: Expecting exactly " ++ show cnt
582 ++ " elements, input terminated on " ++ show i
584-- | See 'Streamly.Internal.Data.Parser.takeGE'.
585--
586-- /Pre-release/
587--
588{-# INLINE takeGE #-}
589takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
590takeGE n (Fold fstep finitial fextract) = Parser step initial extract
592 where
594 cnt = max n 0
595 initial = do
596 res <- finitial
597 return $ case res of
598 FL.Partial s -> IPartial $ Tuple' 0 s
599 FL.Done b ->
600 if cnt == 0
601 then IDone b
602 else IError
603 $ "takeGE: Expecting at least " ++ show cnt
604 ++ " elements, fold terminated without"
605 ++ " consuming any elements"
607 step (Tuple' i r) a
608 | i1 < cnt = do
609 res <- fstep r a
610 return
611 $ case res of
612 FL.Partial s -> Continue 0 $ Tuple' i1 s
613 FL.Done _ ->
614 Error
615 $ "takeGE: Expecting at least " ++ show cnt
616 ++ " elements, fold terminated on " ++ show i1
617 | otherwise = do
618 res <- fstep r a
619 return
620 $ case res of
621 FL.Partial s -> Partial 0 $ Tuple' i1 s
622 FL.Done b -> Done 0 b
624 where
626 i1 = i + 1
628 extract (Tuple' i r)
629 | i >= cnt = fextract r
630 | otherwise =
631 throwM
632 $ ParseError
633 $ "takeGE: Expecting at least " ++ show cnt
634 ++ " elements, input terminated on " ++ show i
636-------------------------------------------------------------------------------
637-- Conditional splitting
638-------------------------------------------------------------------------------
640-- | See 'Streamly.Internal.Data.Parser.takeWhileP'.
641--
642-- /Pre-release/
643--
644{-# INLINE takeWhileP #-}
645takeWhileP :: Monad m => (a -> Bool) -> Parser m a b -> Parser m a b
646takeWhileP predicate (Parser pstep pinitial pextract) =
647 Parser step pinitial pextract
649 where
651 step s a =
652 if predicate a
653 then pstep s a
654 else Done 1 <$> pextract s
656-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
657--
658-- /Pre-release/
659--
660{-# INLINE takeWhile #-}
661takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
662takeWhile predicate (Fold fstep finitial fextract) =
663 Parser step initial fextract
665 where
667 initial = do
668 res <- finitial
669 return $ case res of
670 FL.Partial s -> IPartial s
671 FL.Done b -> IDone b
673 step s a =
674 if predicate a
675 then do
676 fres <- fstep s a
677 return
678 $ case fres of
679 FL.Partial s1 -> Partial 0 s1
680 FL.Done b -> Done 0 b
681 else Done 1 <$> fextract s
683-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
684--
685-- /Pre-release/
686--
687{-# INLINE takeWhile1 #-}
688takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
689takeWhile1 predicate (Fold fstep finitial fextract) =
690 Parser step initial extract
692 where
694 initial = do
695 res <- finitial
696 return $ case res of
697 FL.Partial s -> IPartial (Left' s)
698 FL.Done _ ->
699 IError
700 $ "takeWhile1: fold terminated without consuming:"
701 ++ " any element"
703 {-# INLINE process #-}
704 process s a = do
705 res <- fstep s a
706 return
707 $ case res of
708 FL.Partial s1 -> Partial 0 (Right' s1)
709 FL.Done b -> Done 0 b
711 step (Left' s) a =
712 if predicate a
713 then process s a
714 else return $ Error "takeWhile1: predicate failed on first element"
715 step (Right' s) a =
716 if predicate a
717 then process s a
718 else do
719 b <- fextract s
720 return $ Done 1 b
722 extract (Left' _) = throwM $ ParseError "takeWhile1: end of input"
723 extract (Right' s) = fextract s
725-------------------------------------------------------------------------------
726-- Separators
727-------------------------------------------------------------------------------
729{-# INLINE takeFramedByGeneric #-}
730takeFramedByGeneric :: MonadThrow m =>
731 Maybe (a -> Bool)
732 -> Maybe (a -> Bool)
733 -> Maybe (a -> Bool)
734 -> Fold m a b
735 -> Parser m a b
736takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
738 Parser step initial extract
740 where
742 initial = do
743 res <- finitial
744 return $
745 case res of
746 FL.Partial s -> IPartial (FrameEscInit s)
747 FL.Done _ ->
748 error "takeFramedByGeneric: fold done without input"
750 {-# INLINE process #-}
751 process s a n = do
752 res <- fstep s a
753 return
754 $ case res of
755 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
756 FL.Done b -> Done 0 b
758 {-# INLINE processNoEsc #-}
759 processNoEsc s a n =
760 case end of
761 Just isEnd ->
762 case begin of
763 Just isBegin ->
764 -- takeFramedBy case
765 if isEnd a
766 then
767 if n == 0
768 then Done 0 <$> fextract s
769 else process s a (n - 1)
770 else
771 let n1 = if isBegin a then n + 1 else n
772 in process s a n1
773 Nothing -> -- takeEndBy case
774 if isEnd a
775 then Done 0 <$> fextract s
776 else process s a n
777 Nothing -> -- takeStartBy case
778 case begin of
779 Just isBegin ->
780 if isBegin a
781 then Done 0 <$> fextract s
782 else process s a n
783 Nothing ->
784 error $ "takeFramedByGeneric: "
785 ++ "Both begin and end frame predicate missing"
787 {-# INLINE processCheckEsc #-}
788 processCheckEsc s a n =
789 case esc of
790 Just isEsc ->
791 if isEsc a
792 then return $ Partial 0 $ FrameEscEsc s n
793 else processNoEsc s a n
794 Nothing -> processNoEsc s a n
796 step (FrameEscInit s) a =
797 case begin of
798 Just isBegin ->
799 if isBegin a
800 then return $ Partial 0 (FrameEscGo s 0)
801 else return $ Error "takeFramedByGeneric: missing frame start"
802 Nothing ->
803 case end of
804 Just isEnd ->
805 if isEnd a
806 then Done 0 <$> fextract s
807 else processCheckEsc s a 0
808 Nothing ->
809 error "Both begin and end frame predicate missing"
810 step (FrameEscGo s n) a = processCheckEsc s a n
811 step (FrameEscEsc s n) a = process s a n
813 err = throwM . ParseError
815 extract (FrameEscInit _) =
816 err "takeFramedByGeneric: empty token"
817 extract (FrameEscGo s _) =
818 case begin of
819 Just _ ->
820 case end of
821 Nothing -> fextract s
822 Just _ -> err "takeFramedByGeneric: missing frame end"
823 Nothing -> err "takeFramedByGeneric: missing closing frame"
824 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
826-- | See 'Streamly.Internal.Data.Parser.takeEndBy'.
827--
828-- /Pre-release/
829--
830{-# INLINE takeEndBy #-}
831takeEndBy :: MonadCatch m => (a -> Bool) -> Parser m a b -> Parser m a b
832takeEndBy cond (Parser pstep pinitial pextract) =
834 Parser step initial pextract
836 where
838 initial = pinitial
840 step s a = do
841 res <- pstep s a
842 if not (cond a)
843 then return res
844 else extractStep pextract res
846-- | See 'Streamly.Internal.Data.Parser.takeEndByEsc'.
847--
848-- /Pre-release/
849--
850{-# INLINE takeEndByEsc #-}
851takeEndByEsc :: MonadCatch m =>
852 (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b
853takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
855 Parser step initial extract
857 where
859 initial = first Left' <$> pinitial
861 step (Left' s) a = do
862 if isEsc a
863 then return $ Partial 0 $ Right' s
864 else do
865 res <- pstep s a
866 if not (isSep a)
867 then return $ mapStateStep Left' res
868 else extractStep pextract res
870 step (Right' s) a = do
871 res <- pstep s a
872 return $ mapStateStep Left' res
874 extract (Left' s) = pextract s
875 extract (Right' _) =
876 throwM $ ParseError "takeEndByEsc: trailing escape"
878-- | See 'Streamly.Internal.Data.Parser.takeEndBy_'.
879--
880-- /Pre-release/
881--
882{-# INLINE takeEndBy_ #-}
883takeEndBy_ :: MonadCatch m =>
884 (a -> Bool) -> Parser m a b -> Parser m a b
885takeEndBy_ cond (Parser pstep pinitial pextract) =
887 Parser step initial pextract
889 where
891 initial = pinitial
893 step s a =
894 if cond a
895 then do
896 res <- pextract s
897 return $ Done 0 res
898 else pstep s a
900-- | See 'Streamly.Internal.Data.Parser.takeStartBy'.
901--
902-- /Pre-release/
903--
905{-# INLINE takeStartBy #-}
906takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
907takeStartBy cond (Fold fstep finitial fextract) =
909 Parser step initial extract
911 where
913 initial = do
914 res <- finitial
915 return $
916 case res of
917 FL.Partial s -> IPartial (Left' s)
918 FL.Done _ -> IError "takeStartBy: fold done without input"
920 {-# INLINE process #-}
921 process s a = do
922 res <- fstep s a
923 return
924 $ case res of
925 FL.Partial s1 -> Partial 0 (Right' s1)
926 FL.Done b -> Done 0 b
928 step (Left' s) a =
929 if cond a
930 then process s a
931 else return $ Error "takeStartBy: missing frame start"
932 step (Right' s) a =
933 if not (cond a)
934 then process s a
935 else Done 1 <$> fextract s
937 extract (Left' s) = fextract s
938 extract (Right' s) = fextract s
940data FramedEscState s =
941 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
943{-# INLINE takeFramedByEsc_ #-}
944takeFramedByEsc_ :: MonadThrow m =>
945 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
946takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
948 Parser step initial extract
950 where
952 initial = do
953 res <- finitial
954 return $
955 case res of
956 FL.Partial s -> IPartial (FrameEscInit s)
957 FL.Done _ ->
958 error "takeFramedByEsc_: fold done without input"
960 {-# INLINE process #-}
961 process s a n = do
962 res <- fstep s a
963 return
964 $ case res of
965 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
966 FL.Done b -> Done 0 b
968 step (FrameEscInit s) a =
969 if isBegin a
970 then return $ Partial 0 (FrameEscGo s 0)
971 else return $ Error "takeFramedByEsc_: missing frame start"
972 step (FrameEscGo s n) a =
973 if isEsc a
974 then return $ Partial 0 $ FrameEscEsc s n
975 else do
976 if not (isEnd a)
977 then
978 let n1 = if isBegin a then n + 1 else n
979 in process s a n1
980 else
981 if n == 0
982 then Done 0 <$> fextract s
983 else process s a (n - 1)
984 step (FrameEscEsc s n) a = process s a n
986 err = throwM . ParseError
988 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
989 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
990 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
992data FramedState s = FrameInit !s | FrameGo !s Int
994{-# INLINE takeFramedBy_ #-}
995takeFramedBy_ :: MonadThrow m =>
996 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
997takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
999 Parser step initial extract
1001 where
1003 initial = do
1004 res <- finitial
1005 return $
1006 case res of
1007 FL.Partial s -> IPartial (FrameInit s)
1008 FL.Done _ ->
1009 error "takeFramedBy_: fold done without input"
1011 {-# INLINE process #-}
1012 process s a n = do
1013 res <- fstep s a
1014 return
1015 $ case res of
1016 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1017 FL.Done b -> Done 0 b
1019 step (FrameInit s) a =
1020 if isBegin a
1021 then return $ Continue 0 (FrameGo s 0)
1022 else return $ Error "takeFramedBy_: missing frame start"
1023 step (FrameGo s n) a
1024 | not (isEnd a) =
1025 let n1 = if isBegin a then n + 1 else n
1026 in process s a n1
1027 | n == 0 = Done 0 <$> fextract s
1028 | otherwise = process s a (n - 1)
1030 err = throwM . ParseError
1032 extract (FrameInit _) = err "takeFramedBy_: empty token"
1033 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1035-------------------------------------------------------------------------------
1036-- Grouping and words
1037-------------------------------------------------------------------------------
1039data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1041-- | See 'Streamly.Internal.Data.Parser.wordBy'.
1044{-# INLINE wordBy #-}
1045wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
1046wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1048 where
1050 {-# INLINE worder #-}
1051 worder s a = do
1052 res <- fstep s a
1053 return
1054 $ case res of
1055 FL.Partial s1 -> Partial 0 $ WBWord s1
1056 FL.Done b -> Done 0 b
1058 initial = do
1059 res <- finitial
1060 return
1061 $ case res of
1062 FL.Partial s -> IPartial $ WBLeft s
1063 FL.Done b -> IDone b
1065 step (WBLeft s) a =
1066 if not (predicate a)
1067 then worder s a
1068 else return $ Partial 0 $ WBLeft s
1069 step (WBWord s) a =
1070 if not (predicate a)
1071 then worder s a
1072 else do
1073 b <- fextract s
1074 return $ Partial 0 $ WBRight b
1075 step (WBRight b) a =
1076 return
1077 $ if not (predicate a)
1078 then Done 1 b
1079 else Partial 0 $ WBRight b
1081 extract (WBLeft s) = fextract s
1082 extract (WBWord s) = fextract s
1083 extract (WBRight b) = return b
1085data WordFramedState s b =
1086 WordFramedSkipPre !s
1087 | WordFramedWord !s !Int
1088 | WordFramedEsc !s !Int
1089 | WordFramedSkipPost !b
1091-- | See 'Streamly.Internal.Data.Parser.wordFramedBy'
1093{-# INLINE wordFramedBy #-}
1094wordFramedBy :: MonadCatch m =>
1095 (a -> Bool) -- ^ Escape
1096 -> (a -> Bool) -- ^ left quote
1097 -> (a -> Bool) -- ^ right quote
1098 -> (a -> Bool) -- ^ word seperator
1099 -> Fold m a b
1100 -> Parser m a b
1101wordFramedBy isEsc isBegin isEnd isSep
1102 (Fold fstep finitial fextract) =
1103 Parser step initial extract
1105 where
1107 initial = do
1108 res <- finitial
1109 return $
1110 case res of
1111 FL.Partial s -> IPartial (WordFramedSkipPre s)
1112 FL.Done _ ->
1113 error "wordFramedBy: fold done without input"
1115 {-# INLINE process #-}
1116 process s a n = do
1117 res <- fstep s a
1118 return
1119 $ case res of
1120 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1121 FL.Done b -> Done 0 b
1123 step (WordFramedSkipPre s) a
1124 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1125 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1126 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1127 | isEnd a =
1128 return $ Error "wordFramedBy: missing frame start"
1129 | otherwise = process s a 0
1130 step (WordFramedWord s n) a
1131 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1132 | n == 0 && isSep a = do
1133 b <- fextract s
1134 return $ Partial 0 $ WordFramedSkipPost b
1135 | otherwise = do
1136 -- We need to use different order for checking begin and end for
1137 -- the n == 0 and n == 1 case so that when the begin and end
1138 -- character is the same we treat the one after begin as end.
1139 if n == 0
1140 then
1141 -- Need to check isBegin first
1142 if isBegin a
1143 then return $ Continue 0 $ WordFramedWord s 1
1144 else if isEnd a
1145 then return $ Error "wordFramedBy: missing frame start"
1146 else process s a n
1147 else
1148 -- Need to check isEnd first
1149 if isEnd a
1150 then
1151 if n == 1
1152 then return $ Continue 0 $ WordFramedWord s 0
1153 else process s a (n - 1)
1154 else if isBegin a
1155 then process s a (n + 1)
1156 else process s a n
1157 step (WordFramedEsc s n) a = process s a n
1158 step (WordFramedSkipPost b) a =
1159 return
1160 $ if not (isSep a)
1161 then Done 1 b
1162 else Partial 0 $ WordFramedSkipPost b
1164 err = throwM . ParseError
1166 extract (WordFramedSkipPre s) = fextract s
1167 extract (WordFramedWord s n) =
1168 if n == 0
1169 then fextract s
1170 else err "wordFramedBy: missing frame end"
1171 extract (WordFramedEsc _ _) =
1172 err "wordFramedBy: trailing escape"
1173 extract (WordFramedSkipPost b) = return b
1175data WordQuotedState s b a =
1176 WordQuotedSkipPre !s
1177 | WordUnquotedWord !s
1178 | WordQuotedWord !s !Int a
1179 | WordUnquotedEsc !s
1180 | WordQuotedEsc !s !Int a
1181 | WordQuotedSkipPost !b
1183{-# INLINE wordQuotedBy #-}
1184wordQuotedBy :: (MonadCatch m, Eq a) =>
1185 Bool -- ^ keep the quotes in the output
1186 -> (a -> Bool) -- ^ Escape
1187 -> (a -> Bool) -- ^ left quote
1188 -> (a -> Bool) -- ^ right quote
1189 -> (a -> a) -- ^ get right quote from the left quote
1190 -> (a -> Bool) -- ^ word seperator
1191 -> Fold m a b
1192 -> Parser m a b
1193wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
1194 (Fold fstep finitial fextract) =
1195 Parser step initial extract
1197 where
1199 initial = do
1200 res <- finitial
1201 return $
1202 case res of
1203 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1204 FL.Done _ ->
1205 error "wordQuotedBy: fold done without input"
1207 {-# INLINE process #-}
1208 process s a n q = do
1209 res <- fstep s a
1210 return
1211 $ case res of
1212 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n q)
1213 FL.Done b -> Done 0 b
1215 {-# INLINE processUnquoted #-}
1216 processUnquoted s a = do
1217 res <- fstep s a
1218 return
1219 $ case res of
1220 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1221 FL.Done b -> Done 0 b
1223 step (WordQuotedSkipPre s) a
1224 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1225 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1226 | isBegin a =
1227 if keepQuotes
1228 then process s a 1 a
1229 else return $ Continue 0 $ WordQuotedWord s 1 a
1230 | isEnd a =
1231 return $ Error "wordQuotedBy: missing frame start"
1232 | otherwise = processUnquoted s a
1233 step (WordUnquotedWord s) a
1234 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1235 | isSep a = do
1236 b <- fextract s
1237 return $ Partial 0 $ WordQuotedSkipPost b
1238 | otherwise = do
1239 if isBegin a
1240 then if keepQuotes
1241 then process s a 1 a
1242 else return $ Continue 0 $ WordQuotedWord s 1 a
1243 else if isEnd a
1244 then return $ Error "wordQuotedBy: missing frame start"
1245 else processUnquoted s a
1246 step (WordQuotedWord s n q) a
1247 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n q
1248 -- XXX Will this ever occur? Will n ever be 0?
1249 | n == 0 && isSep a = do
1250 b <- fextract s
1251 return $ Partial 0 $ WordQuotedSkipPost b
1252 | otherwise = do
1253 if a == toRight q
1254 then
1255 if n == 1
1256 then if keepQuotes
1257 then processUnquoted s a
1258 else return $ Continue 0 $ WordUnquotedWord s
1259 else process s a (n - 1) q
1260 else if a == q
1261 then process s a (n + 1) q
1262 else process s a n q
1263 step (WordUnquotedEsc s) a = processUnquoted s a
1264 step (WordQuotedEsc s n q) a = process s a n q
1265 step (WordQuotedSkipPost b) a =
1266 return
1267 $ if not (isSep a)
1268 then Done 1 b
1269 else Partial 0 $ WordQuotedSkipPost b
1271 err = throwM . ParseError
1273 extract (WordQuotedSkipPre s) = fextract s
1274 extract (WordUnquotedWord s) = fextract s
1275 extract (WordQuotedWord s n _) =
1276 if n == 0
1277 then fextract s
1278 else err "wordQuotedBy: missing frame end"
1279 extract WordQuotedEsc {} =
1280 err "wordQuotedBy: trailing escape"
1281 extract (WordUnquotedEsc _) =
1282 err "wordQuotedBy: trailing escape"
1283 extract (WordQuotedSkipPost b) = return b
1285{-# ANN type GroupByState Fuse #-}
1286data GroupByState a s
1287 = GroupByInit !s
1288 | GroupByGrouping !a !s
1290-- | See 'Streamly.Internal.Data.Parser.groupBy'.
1292{-# INLINE groupBy #-}
1293groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1294groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1296 where
1298 {-# INLINE grouper #-}
1299 grouper s a0 a = do
1300 res <- fstep s a
1301 return
1302 $ case res of
1303 FL.Done b -> Done 0 b
1304 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1306 initial = do
1307 res <- finitial
1308 return
1309 $ case res of
1310 FL.Partial s -> IPartial $ GroupByInit s
1311 FL.Done b -> IDone b
1313 step (GroupByInit s) a = grouper s a a
1314 step (GroupByGrouping a0 s) a =
1315 if eq a0 a
1316 then grouper s a0 a
1317 else Done 1 <$> fextract s
1319 extract (GroupByInit s) = fextract s
1320 extract (GroupByGrouping _ s) = fextract s
1322-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
1324{-# INLINE groupByRolling #-}
1325groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
1326groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1328 where
1330 {-# INLINE grouper #-}
1331 grouper s a = do
1332 res <- fstep s a
1333 return
1334 $ case res of
1335 FL.Done b -> Done 0 b
1336 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1338 initial = do
1339 res <- finitial
1340 return
1341 $ case res of
1342 FL.Partial s -> IPartial $ GroupByInit s
1343 FL.Done b -> IDone b
1345 step (GroupByInit s) a = grouper s a
1346 step (GroupByGrouping a0 s) a =
1347 if eq a0 a
1348 then grouper s a
1349 else Done 1 <$> fextract s
1351 extract (GroupByInit s) = fextract s
1352 extract (GroupByGrouping _ s) = fextract s
1354{-# ANN type GroupByStatePair Fuse #-}
1355data GroupByStatePair a s1 s2
1356 = GroupByInitPair !s1 !s2
1357 | GroupByGroupingPair !a !s1 !s2
1358 | GroupByGroupingPairL !a !s1 !s2
1359 | GroupByGroupingPairR !a !s1 !s2
1361{-# INLINE groupByRollingEither #-}
1362groupByRollingEither :: MonadCatch m =>
1363 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
1364groupByRollingEither
1365 eq
1366 (Fold fstep1 finitial1 fextract1)
1367 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
1369 where
1371 {-# INLINE grouper #-}
1372 grouper s1 s2 a = do
1373 return $ Continue 0 (GroupByGroupingPair a s1 s2)
1375 {-# INLINE grouperL2 #-}
1376 grouperL2 s1 s2 a = do
1377 res <- fstep1 s1 a
1378 return
1379 $ case res of
1380 FL.Done b -> Done 0 (Left b)
1381 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
1383 {-# INLINE grouperL #-}
1384 grouperL s1 s2 a0 a = do
1385 res <- fstep1 s1 a0
1386 case res of
1387 FL.Done b -> return $ Done 0 (Left b)
1388 FL.Partial s11 -> grouperL2 s11 s2 a
1390 {-# INLINE grouperR2 #-}
1391 grouperR2 s1 s2 a = do
1392 res <- fstep2 s2 a
1393 return
1394 $ case res of
1395 FL.Done b -> Done 0 (Right b)
1396 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
1398 {-# INLINE grouperR #-}
1399 grouperR s1 s2 a0 a = do
1400 res <- fstep2 s2 a0
1401 case res of
1402 FL.Done b -> return $ Done 0 (Right b)
1403 FL.Partial s21 -> grouperR2 s1 s21 a
1405 initial = do
1406 res1 <- finitial1
1407 res2 <- finitial2
1408 return
1409 $ case res1 of
1410 FL.Partial s1 ->
1411 case res2 of
1412 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
1413 FL.Done b -> IDone (Right b)
1414 FL.Done b -> IDone (Left b)
1416 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
1418 step (GroupByGroupingPair a0 s1 s2) a =
1419 if not (eq a0 a)
1420 then grouperL s1 s2 a0 a
1421 else grouperR s1 s2 a0 a
1423 step (GroupByGroupingPairL a0 s1 s2) a =
1424 if not (eq a0 a)
1425 then grouperL2 s1 s2 a
1426 else Done 1 . Left <$> fextract1 s1
1428 step (GroupByGroupingPairR a0 s1 s2) a =
1429 if eq a0 a
1430 then grouperR2 s1 s2 a
1431 else Done 1 . Right <$> fextract2 s2
1433 extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
1434 extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
1435 extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
1436 extract (GroupByGroupingPair a s1 _) = do
1437 res <- fstep1 s1 a
1438 case res of
1439 FL.Done b -> return $ Left b
1440 FL.Partial s11 -> Left <$> fextract1 s11
1442-- XXX use an Unfold instead of a list?
1443-- XXX custom combinators for matching list, array and stream?
1444-- XXX rename to listBy?
1446-- | See 'Streamly.Internal.Data.Parser.eqBy'.
1448-- /Pre-release/
1450{-# INLINE eqBy #-}
1451eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
1452eqBy cmp str = Parser step initial extract
1454 where
1456 -- XXX Should return IDone in initial for [] case
1457 initial = return $ IPartial str
1459 step [] _ = return $ Done 0 ()
1460 step [x] a =
1461 return
1462 $ if x `cmp` a
1463 then Done 0 ()
1464 else Error "eqBy: failed, yet to match the last element"
1465 step (x:xs) a =
1466 return
1467 $ if x `cmp` a
1468 then Continue 0 xs
1469 else Error
1470 $ "eqBy: failed, yet to match "
1471 ++ show (length xs + 1) ++ " elements"
1473 extract xs =
1474 throwM
1475 $ ParseError
1476 $ "eqBy: end of input, yet to match "
1477 ++ show (length xs) ++ " elements"
1479-- XXX rename to streamBy?
1480-- | Like eqBy but uses a stream instead of a list
1481{-# INLINE matchBy #-}
1482matchBy :: MonadThrow m => (a -> a -> Bool) -> D.Stream m a -> Parser m a ()
1483matchBy cmp (D.Stream sstep state) = Parser step initial extract
1485 where
1487 initial = do
1488 r <- sstep defState state
1489 case r of
1490 D.Yield x s -> return $ IPartial (Just' x, s)
1491 D.Stop -> return $ IDone ()
1492 -- Need Skip/Continue in initial to loop right here
1493 D.Skip s -> return $ IPartial (Nothing', s)
1495 step (Just' x, st) a =
1496 if x `cmp` a
1497 then do
1498 r <- sstep defState st
1499 return
1500 $ case r of
1501 D.Yield x1 s -> Continue 0 (Just' x1, s)
1502 D.Stop -> Done 0 ()
1503 D.Skip s -> Continue 1 (Nothing', s)
1504 else return $ Error "match: mismtach occurred"
1505 step (Nothing', st) a = do
1506 r <- sstep defState st
1507 return
1508 $ case r of
1509 D.Yield x s -> do
1510 if x `cmp` a
1511 then Continue 0 (Nothing', s)
1512 else Error "match: mismatch occurred"
1513 D.Stop -> Done 1 ()
1514 D.Skip s -> Continue 1 (Nothing', s)
1516 extract _ = throwM $ ParseError "match: end of input"
1518-------------------------------------------------------------------------------
1519-- Transformations on input
1520-------------------------------------------------------------------------------
1522-- Initial needs a "Continue" constructor to implement scans on parsers. As a
1523-- parser can always return a Continue in initial when we feed the fold's
1524-- initial result to it. We can work this around for postscan by introducing an
1525-- initial state and calling "initial" only on the first input.
1527-- | Stateful scan on the input of a parser using a Fold.
1529-- /Unimplemented/
1531{-# INLINE postscan #-}
1532postscan :: -- Monad m =>
1533 Fold m a b -> Parser m b c -> Parser m a c
1534postscan = undefined
1536{-# INLINE zipWithM #-}
1537zipWithM :: MonadThrow m =>
1538 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
1539zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
1540 Parser step initial extract
1542 where
1544 initial = do
1545 fres <- finitial
1546 case fres of
1547 FL.Partial fs -> do
1548 r <- sstep defState state
1549 case r of
1550 D.Yield x s -> return $ IPartial (Just' x, s, fs)
1551 D.Stop -> do
1552 x <- fextract fs
1553 return $ IDone x
1554 -- Need Skip/Continue in initial to loop right here
1555 D.Skip s -> return $ IPartial (Nothing', s, fs)
1556 FL.Done x -> return $ IDone x
1558 step (Just' a, st, fs) b = do
1559 c <- zf a b
1560 fres <- fstep fs c
1561 case fres of
1562 FL.Partial fs1 -> do
1563 r <- sstep defState st
1564 case r of
1565 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
1566 D.Stop -> do
1567 x <- fextract fs1
1568 return $ Done 0 x
1569 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
1570 FL.Done x -> return $ Done 0 x
1571 step (Nothing', st, fs) b = do
1572 r <- sstep defState st
1573 case r of
1574 D.Yield a s -> do
1575 c <- zf a b
1576 fres <- fstep fs c
1577 case fres of
1578 FL.Partial fs1 ->
1579 return $ Continue 0 (Nothing', s, fs1)
1580 FL.Done x -> return $ Done 0 x
1581 D.Stop -> do
1582 x <- fextract fs
1583 return $ Done 1 x
1584 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
1586 extract _ = throwM $ ParseError "zipWithM: end of input"
1588-- | Zip the input of a fold with a stream.
1590-- /Pre-release/
1592{-# INLINE zip #-}
1593zip :: MonadThrow m => D.Stream m a -> Fold m (a, b) x -> Parser m b x
1594zip = zipWithM (curry return)
1596-- | Pair each element of a fold input with its index, starting from index 0.
1598-- /Pre-release/
1599{-# INLINE indexed #-}
1600indexed :: forall m a b. MonadThrow m => Fold m (Int, a) b -> Parser m a b
1601indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
1603-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
1604-- function using a fold indexing function that attaches an index to each input
1605-- element and a filtering function that filters using @(index, element) ->
1606-- Bool) as predicate.
1608-- For example:
1610-- @
1611-- filterWithIndex = makeIndexFilter indexed filter
1612-- filterWithAbsTime = makeIndexFilter timestamped filter
1613-- filterWithRelTime = makeIndexFilter timeIndexed filter
1614-- @
1616-- /Pre-release/
1617{-# INLINE makeIndexFilter #-}
1618makeIndexFilter ::
1619 (Fold m (s, a) b -> Parser m a b)
1620 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
1621 -> (((s, a) -> Bool) -> Fold m a b -> Parser m a b)
1622makeIndexFilter f comb g = f . comb g . FL.lmap snd
1624-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
1625-- then every element at strides of @stride@.
1627-- /Pre-release/
1628{-# INLINE sampleFromthen #-}
1629sampleFromthen :: MonadThrow m => Int -> Int -> Fold m a b -> Parser m a b
1630sampleFromthen offset size =
1631 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
1633--------------------------------------------------------------------------------
1634--- Spanning
1635--------------------------------------------------------------------------------
1637-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1638-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1639-- input.
1641-- @
1642-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
1644-- > span_ (< 1) [1,2,3]
1645-- ([],[1,2,3])
1647-- > span_ (< 2) [1,2,3]
1648-- ([1],[2,3])
1650-- > span_ (< 4) [1,2,3]
1651-- ([1,2,3],[])
1653-- @
1655-- /Pre-release/
1656{-# INLINE span #-}
1657span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1658span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
1660-- | Break the input stream into two groups, the first group takes the input as
1661-- long as the predicate applied to the first element of the stream and next
1662-- input element holds 'True', the second group takes the rest of the input.
1664-- /Pre-release/
1666{-# INLINE spanBy #-}
1667spanBy ::
1668 Monad m
1669 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1670spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
1672-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
1673-- predicate is applied to the previous and the next input elements.
1675-- /Pre-release/
1676{-# INLINE spanByRolling #-}
1677spanByRolling ::
1678 Monad m
1679 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
1680spanByRolling eq f1 f2 =
1681 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
1683-------------------------------------------------------------------------------
1684-- nested parsers
1685-------------------------------------------------------------------------------
1687-- | See 'Streamly.Internal.Data.Parser.takeP'.
1689-- /Internal/
1690{-# INLINE takeP #-}
1691takeP :: Monad m => Int -> Parser m a b -> Parser m a b
1692takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
1694 where
1696 initial = do
1697 res <- pinitial
1698 case res of
1699 IPartial s ->
1700 if lim > 0
1701 then return $ IPartial $ Tuple' 0 s
1702 else IDone <$> pextract s
1703 IDone b -> return $ IDone b
1704 IError e -> return $ IError e
1706 step (Tuple' cnt r) a = do
1707 assert (cnt < lim) (return ())
1708 res <- pstep r a
1709 let cnt1 = cnt + 1
1710 case res of
1711 Partial 0 s -> do
1712 assert (cnt1 >= 0) (return ())
1713 if cnt1 < lim
1714 then return $ Partial 0 $ Tuple' cnt1 s
1715 else Done 0 <$> pextract s
1716 Continue 0 s -> do
1717 assert (cnt1 >= 0) (return ())
1718 if cnt1 < lim
1719 then return $ Continue 0 $ Tuple' cnt1 s
1720 -- XXX This should error out?
1721 -- If designed properly, this will probably error out.
1722 -- "pextract" should error out
1723 --
1724 -- By Harendra,
1725 --
1726 -- This is a tricky case, we have the following options:
1727 -- 1. Done 0 with extract as you have written
1728 -- 2. Done n, will require buffering elements
1729 -- 3. Use a backtracking fold and not a parser, once we have
1730 -- backtracking in folds
1731 else Done 0 <$> pextract s
1732 Partial n s -> do
1733 let taken = cnt1 - n
1734 assert (taken >= 0) (return ())
1735 return $ Partial n $ Tuple' taken s
1736 Continue n s -> do
1737 let taken = cnt1 - n
1738 assert (taken >= 0) (return ())
1739 return $ Continue n $ Tuple' taken s
1740 Done n b -> return $ Done n b
1741 Error str -> return $ Error str
1743 extract (Tuple' _ r) = pextract r
1745-- | See 'Streamly.Internal.Data.Parser.lookahead'.
1747-- /Pre-release/
1749{-# INLINE lookAhead #-}
1750lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
1751lookAhead (Parser step1 initial1 _) = Parser step initial extract
1753 where
1755 initial = do
1756 res <- initial1
1757 return $ case res of
1758 IPartial s -> IPartial (Tuple' 0 s)
1759 IDone b -> IDone b
1760 IError e -> IError e
1762 step (Tuple' cnt st) a = do
1763 r <- step1 st a
1764 let cnt1 = cnt + 1
1765 return
1766 $ case r of
1767 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
1768 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
1769 Done _ b -> Done cnt1 b
1770 Error err -> Error err
1772 -- XXX returning an error let's us backtrack. To implement it in a way so
1773 -- that it terminates on eof without an error then we need a way to
1774 -- backtrack on eof, that will require extract to return 'Step' type.
1775 extract (Tuple' n _) =
1776 throwM
1777 $ ParseError
1778 $ "lookAhead: end of input after consuming "
1779 ++ show n ++ " elements"
1781-------------------------------------------------------------------------------
1782-- Interleaving
1783-------------------------------------------------------------------------------
1785data DeintercalateState fs sp ss =
1786 DeintercalateL !fs !sp
1787 | DeintercalateR !fs !ss !Bool
1789-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
1791-- /Internal/
1793{-# INLINE deintercalate #-}
1794deintercalate :: Monad m =>
1795 Fold m (Either x y) z
1796 -> Parser m a x
1797 -> Parser m a y
1798 -> Parser m a z
1799deintercalate
1800 (Fold fstep finitial fextract)
1801 (Parser stepL initialL extractL)
1802 (Parser stepR initialR extractR) = Parser step initial extract
1804 where
1806 errMsg p status =
1807 error $ "deintercalate: " ++ p ++ " parser cannot "
1808 ++ status ++ " without input"
1810 initial = do
1811 res <- finitial
1812 case res of
1813 FL.Partial fs -> do
1814 resL <- initialL
1815 case resL of
1816 IPartial sL -> return $ IPartial $ DeintercalateL fs sL
1817 IDone _ -> errMsg "left" "succeed"
1818 IError _ -> errMsg "left" "fail"
1819 FL.Done c -> return $ IDone c
1821 step (DeintercalateL fs sL) a = do
1822 r <- stepL sL a
1823 case r of
1824 Partial n s -> return $ Partial n (DeintercalateL fs s)
1825 Continue n s -> return $ Continue n (DeintercalateL fs s)
1826 Done n b -> do
1827 fres <- fstep fs (Left b)
1828 case fres of
1829 FL.Partial fs1 -> do
1830 resR <- initialR
1831 case resR of
1832 IPartial sR ->
1833 return
1834 $ Partial n (DeintercalateR fs1 sR False)
1835 IDone _ -> errMsg "right" "succeed"
1836 IError _ -> errMsg "right" "fail"
1837 FL.Done c -> return $ Done n c
1838 Error err -> return $ Error err
1839 step (DeintercalateR fs sR consumed) a = do
1840 r <- stepR sR a
1841 case r of
1842 Partial n s -> return $ Partial n (DeintercalateR fs s True)
1843 Continue n s -> return $ Continue n (DeintercalateR fs s True)
1844 Done n b ->
1845 if consumed
1846 then do
1847 fres <- fstep fs (Right b)
1848 case fres of
1849 FL.Partial fs1 -> do
1850 resL <- initialL
1851 case resL of
1852 IPartial sL ->
1853 return $ Partial n $ DeintercalateL fs1 sL
1854 IDone _ -> errMsg "left" "succeed"
1855 IError _ -> errMsg "left" "fail"
1856 FL.Done c -> return $ Done n c
1857 else error "deintercalate: infinite loop"
1858 Error err -> return $ Error err
1860 extract (DeintercalateL fs sL) = do
1861 r <- extractL sL
1862 res <- fstep fs (Left r)
1863 case res of
1864 FL.Partial fs1 -> fextract fs1
1865 FL.Done c -> return c
1866 extract (DeintercalateR fs sR _) = do
1867 r <- extractR sR
1868 res <- fstep fs (Right r)
1869 case res of
1870 FL.Partial fs1 -> fextract fs1
1871 FL.Done c -> return c
1873data SepByState fs sp ss =
1874 SepByInit !fs !sp
1875 | SepBySeparator !fs !ss !Bool
1877-- This is a special case of deintercalate and can be easily implemented in
1878-- terms of deintercalate.
1879{-# INLINE sepBy #-}
1880sepBy :: MonadCatch m =>
1881 Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1882sepBy
1883 (Fold fstep finitial fextract)
1884 (Parser pstep pinitial pextract)
1885 (Parser sstep sinitial _) = Parser step initial extract
1887 where
1889 errMsg p status =
1890 error $ "sepBy: " ++ p ++ " parser cannot "
1891 ++ status ++ " without input"
1893 initial = do
1894 res <- finitial
1895 case res of
1896 FL.Partial fs -> do
1897 resP <- pinitial
1898 case resP of
1899 IPartial sp -> return $ IPartial $ SepByInit fs sp
1900 IDone _ -> errMsg "content" "succeed"
1901 IError _ -> errMsg "content" "fail"
1902 FL.Done b -> return $ IDone b
1904 step (SepByInit fs sp) a = do
1905 r <- pstep sp a
1906 case r of
1907 Partial n s -> return $ Partial n (SepByInit fs s)
1908 Continue n s -> return $ Continue n (SepByInit fs s)
1909 Done n b -> do
1910 fres <- fstep fs b
1911 case fres of
1912 FL.Partial fs1 -> do
1913 resS <- sinitial
1914 case resS of
1915 IPartial ss ->
1916 return $ Partial n (SepBySeparator fs1 ss False)
1917 IDone _ -> errMsg "separator" "succeed"
1918 IError _ -> errMsg "separator" "fail"
1919 FL.Done c -> return $ Done n c
1920 Error err -> return $ Error err
1921 step (SepBySeparator fs ss consumed) a = do
1922 r <- sstep ss a
1923 case r of
1924 Partial n s -> return $ Partial n (SepBySeparator fs s True)
1925 Continue n s -> return $ Continue n (SepBySeparator fs s True)
1926 Done n _ ->
1927 if consumed
1928 then do
1929 resP <- pinitial
1930 case resP of
1931 IPartial sp -> return $ Partial n $ SepByInit fs sp
1932 IDone _ -> errMsg "content" "succeed"
1933 IError _ -> errMsg "content" "fail"
1934 else error "sepBy: infinite loop"
1935 Error err -> return $ Error err
1937 extract (SepByInit fs sp) = do
1938 r <- pextract sp
1939 res <- fstep fs r
1940 case res of
1941 FL.Partial fs1 -> fextract fs1
1942 FL.Done c -> return c
1943 extract (SepBySeparator fs _ _) = fextract fs
1945-------------------------------------------------------------------------------
1946-- Sequential Collection
1947-------------------------------------------------------------------------------
1949-- | See 'Streamly.Internal.Data.Parser.sequence'.
1950{-# INLINE sequence #-}
1951sequence :: MonadThrow m =>
1952 Fold m b c -> D.Stream m (Parser m a b) -> Parser m a c
1953sequence (Fold fstep finitial fextract) (D.Stream sstep sstate) =
1954 Parser step initial extract
1956 where
1958 initial = do
1959 fres <- finitial
1960 case fres of
1961 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
1962 FL.Done c -> return $ IDone c
1964 -- state does not contain any parser
1965 -- yield a new parser from the stream
1966 step (Nothing', ss, fs) _ = do
1967 sres <- sstep defState ss
1968 case sres of
1969 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
1970 D.Stop -> do
1971 c <- fextract fs
1972 return $ Done 1 c
1973 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
1975 -- state holds a parser that may or may not have been
1976 -- initialized. pinit holds the initial parser state
1977 -- or modified parser state respectively
1978 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
1979 ps <- pinit
1980 case ps of
1981 IPartial ps1 -> do
1982 pres <- pstep ps1 a
1983 case pres of
1984 Partial n ps2 ->
1985 let newP =
1986 Just' $ Parser pstep (return $ IPartial ps2) pextr
1987 in return $ Partial n (newP, ss, fs)
1988 Continue n ps2 ->
1989 let newP =
1990 Just' $ Parser pstep (return $ IPartial ps2) pextr
1991 in return $ Continue n (newP, ss, fs)
1992 Done n b -> do
1993 fres <- fstep fs b
1994 case fres of
1995 FL.Partial fs1 ->
1996 return $ Partial n (Nothing', ss, fs1)
1997 FL.Done c -> return $ Done n c
1998 Error msg -> return $ Error msg
1999 IDone b -> do
2000 fres <- fstep fs b
2001 case fres of
2002 FL.Partial fs1 ->
2003 return $ Partial 1 (Nothing', ss, fs1)
2004 FL.Done c -> return $ Done 1 c
2005 IError err -> return $ Error err
2007 extract (Nothing', _, fs) = fextract fs
2008 extract (Just' (Parser _ pinit pextr), _, fs) = do
2009 ps <- pinit
2010 case ps of
2011 IPartial ps1 -> do
2012 b <- pextr ps1
2013 fres <- fstep fs b
2014 case fres of
2015 FL.Partial fs1 -> fextract fs1
2016 FL.Done c -> return c
2017 IDone b -> do
2018 fres <- fstep fs b
2019 case fres of
2020 FL.Partial fs1 -> fextract fs1
2021 FL.Done c -> return c
2022 IError err -> throwM $ ParseError err
2024-------------------------------------------------------------------------------
2025-- Alternative Collection
2026-------------------------------------------------------------------------------
2028-- | See 'Streamly.Internal.Data.Parser.choice'.
2030-- /Broken/
2032{-# INLINE choice #-}
2033choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
2034choice = foldl1 shortest
2036-------------------------------------------------------------------------------
2037-- Sequential Repetition
2038-------------------------------------------------------------------------------
2040{-# INLINE manyP #-}
2041manyP :: -- MonadCatch m =>
2042 Parser m a b -> Parser m b c -> Parser m a c
2043manyP _p _f = undefined
2045-- | See 'Streamly.Internal.Data.Parser.many'.
2047-- /Pre-release/
2049{-# INLINE many #-}
2050many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
2051many = splitMany
2052-- many = countBetween 0 maxBound
2054-- | See 'Streamly.Internal.Data.Parser.some'.
2056-- /Pre-release/
2058{-# INLINE some #-}
2059some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
2060some = splitSome
2061-- some p f = manyP p (takeGE 1 f)
2062-- some = countBetween 1 maxBound
2064-- | See 'Streamly.Internal.Data.Parser.countBetween'.
2066-- /Unimplemented/
2068{-# INLINE countBetween #-}
2069countBetween :: -- MonadCatch m =>
2070 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
2071countBetween _m _n _p = undefined
2072-- countBetween m n p f = manyP p (takeBetween m n f)
2074-- | See 'Streamly.Internal.Data.Parser.count'.
2076-- /Unimplemented/
2078{-# INLINE count #-}
2079count :: -- MonadCatch m =>
2080 Int -> Parser m a b -> Fold m b c -> Parser m a c
2081count n = countBetween n n
2082-- count n p f = manyP p (takeEQ n f)
2084data ManyTillState fs sr sl
2085 = ManyTillR Int fs sr
2086 | ManyTillL Int fs sl
2088-- | See 'Streamly.Internal.Data.Parser.manyTill'.
2090-- /Pre-release/
2092{-# INLINE manyTill #-}
2093manyTill :: MonadCatch m
2094 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
2095manyTill (Fold fstep finitial fextract)
2096 (Parser stepL initialL extractL)
2097 (Parser stepR initialR _) =
2098 Parser step initial extract
2100 where
2102 -- Caution: Mutual recursion
2104 scrutL fs p c d e = do
2105 resL <- initialL
2106 case resL of
2107 IPartial sl -> return $ c (ManyTillL 0 fs sl)
2108 IDone bl -> do
2109 fr <- fstep fs bl
2110 case fr of
2111 FL.Partial fs1 -> scrutR fs1 p c d e
2112 FL.Done fb -> return $ d fb
2113 IError err -> return $ e err
2115 scrutR fs p c d e = do
2116 resR <- initialR
2117 case resR of
2118 IPartial sr -> return $ p (ManyTillR 0 fs sr)
2119 IDone _ -> d <$> fextract fs
2120 IError _ -> scrutL fs p c d e
2122 initial = do
2123 res <- finitial
2124 case res of
2125 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
2126 FL.Done b -> return $ IDone b
2128 step (ManyTillR cnt fs st) a = do
2129 r <- stepR st a
2130 case r of
2131 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
2132 Continue n s -> do
2133 assert (cnt + 1 - n >= 0) (return ())
2134 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
2135 Done n _ -> do
2136 b <- fextract fs
2137 return $ Done n b
2138 Error _ -> do
2139 resL <- initialL
2140 case resL of
2141 IPartial sl ->
2142 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
2143 IDone bl -> do
2144 fr <- fstep fs bl
2145 let cnt1 = cnt + 1
2146 p = Partial cnt
2147 c = Continue cnt
2148 d = Done cnt
2149 case fr of
2150 FL.Partial fs1 -> scrutR fs1 p c d Error
2151 FL.Done fb -> return $ Done cnt1 fb
2152 IError err -> return $ Error err
2153 -- XXX the cnt is being used only by the assert
2154 step (ManyTillL cnt fs st) a = do
2155 r <- stepL st a
2156 case r of
2157 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
2158 Continue n s -> do
2159 assert (cnt + 1 - n >= 0) (return ())
2160 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
2161 Done n b -> do
2162 fs1 <- fstep fs b
2163 case fs1 of
2164 FL.Partial s ->
2165 scrutR s (Partial n) (Continue n) (Done n) Error
2166 FL.Done b1 -> return $ Done n b1
2167 Error err -> return $ Error err
2169 extract (ManyTillL _ fs sR) = do
2170 res <- extractL sR >>= fstep fs
2171 case res of
2172 FL.Partial s -> fextract s
2173 FL.Done b -> return b
2174 extract (ManyTillR _ fs _) = fextract fs