git.iko.soy/streamly
on 810ba5b help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
1136 lines 33 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 -- * Downgrade to Fold
22 , toFold
24 -- First order parsers
25 -- * Accumulators
26 , fromFold
27 , fromPure
28 , fromEffect
29 , die
30 , dieM
32 -- * Element parsers
33 , peek
34 , eof
35 , satisfy
36 , maybe
37 , either
39 -- * Sequence parsers
40 --
41 -- Parsers chained in series, if one parser terminates the composition
42 -- terminates. Currently we are using folds to collect the output of the
43 -- parsers but we can use Parsers instead of folds to make the composition
44 -- more powerful. For example, we can do:
45 --
46 -- sliceSepByMax cond n p = sliceBy cond (take n p)
47 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
48 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
49 --
50 -- Grab a sequence of input elements without inspecting them
51 , takeBetween
52 -- , take -- take -- takeBetween 0 n
53 -- , takeLE1 -- take1 -- takeBetween 1 n
54 , takeEQ -- takeBetween n n
55 , takeGE -- takeBetween n maxBound
57 -- Grab a sequence of input elements by inspecting them
58 , takeP
59 , lookAhead
60 , takeWhile
61 , takeWhile1
62 , sliceSepByP
63 -- , sliceSepByBetween
64 , sliceBeginWith
65 -- , sliceSepWith
66 --
67 -- , frameSepBy -- parse frames escaped by an escape char/sequence
68 -- , frameEndWith
69 --
70 , wordBy
71 , groupBy
72 , groupByRolling
73 , eqBy
74 -- , prefixOf -- match any prefix of a given string
75 -- , suffixOf -- match any suffix of a given string
76 -- , infixOf -- match any substring of a given string
78 -- ** Spanning
79 , span
80 , spanBy
81 , spanByRolling
83 -- Second order parsers (parsers using parsers)
84 -- * Binary Combinators
86 -- ** Sequential Applicative
87 , serialWith
88 , split_
90 -- ** Parallel Applicatives
91 , teeWith
92 , teeWithFst
93 , teeWithMin
94 -- , teeTill -- like manyTill but parallel
96 -- ** Sequential Interleaving
97 -- Use two folds, run a primary parser, its rejected values go to the
98 -- secondary parser.
99 , deintercalate
101 -- ** Sequential Alternative
102 , alt
104 -- ** Parallel Alternatives
105 , shortest
106 , longest
107 -- , fastest
109 -- * N-ary Combinators
110 -- ** Sequential Collection
111 , sequence
112 , concatMap
114 -- ** Sequential Repetition
115 , count
116 , countBetween
117 -- , countBetweenTill
119 , many
120 , some
121 , manyTill
123 -- -- ** Special cases
124 -- XXX traditional implmentations of these may be of limited use. For
125 -- example, consider parsing lines separated by "\r\n". The main parser
126 -- will have to detect and exclude the sequence "\r\n" anyway so that we
127 -- can apply the "sep" parser.
128 --
129 -- We can instead implement these as special cases of deintercalate.
130 --
131 -- , endBy
132 -- , sepBy
133 -- , sepEndBy
134 -- , beginBy
135 -- , sepBeginBy
136 -- , sepAroundBy
138 -- -- * Distribution
139 --
140 -- A simple and stupid impl would be to just convert the stream to an array
141 -- and give the array reference to all consumers. The array can be grown on
142 -- demand by any consumer and truncated when nonbody needs it.
143 --
144 -- -- ** Distribute to collection
145 -- -- ** Distribute to repetition
147 -- -- ** Interleaved collection
148 -- Round robin
149 -- Priority based
150 -- -- ** Interleaved repetition
151 -- repeat one parser and when it fails run an error recovery parser
152 -- e.g. to find a key frame in the stream after an error
154 -- ** Collection of Alternatives
155 -- , shortestN
156 -- , longestN
157 -- , fastestN -- first N successful in time
158 -- , choiceN -- first N successful in position
159 , choice -- first successful in position
161 -- -- ** Repeated Alternatives
162 -- , retryMax -- try N times
163 -- , retryUntil -- try until successful
164 -- , retryUntilN -- try until successful n times
165 )
166where
168import Control.Exception (assert, Exception)
169import Control.Monad.Catch (MonadCatch, MonadThrow(..))
170import Fusion.Plugin.Types (Fuse(..))
171import Streamly.Internal.Data.Fold.Type (Fold(..))
172import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
174import qualified Streamly.Internal.Data.Fold.Type as FL
176import Prelude hiding
177 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
178import Streamly.Internal.Data.Parser.ParserD.Tee
179import Streamly.Internal.Data.Parser.ParserD.Type
181--
182-- $setup
183-- >>> :m
184-- >>> import Prelude hiding ()
185-- >>> import qualified Streamly.Prelude as Stream
186-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
187-- >>> import qualified Streamly.Data.Fold as Fold
188-- >>> import qualified Streamly.Internal.Data.Parser as Parser
190-------------------------------------------------------------------------------
191-- Downgrade a parser to a Fold
192-------------------------------------------------------------------------------
194data ParserToFoldError =
195 InitialError String
196 | PartialError Int
197 | ContinueError Int
198 | DoneError Int
199 | ErrorError String
200 deriving Show
202instance Exception ParserToFoldError
204-- | See 'Streamly.Internal.Data.Parser.toFold'.
205--
206-- /Internal/
207--
208{-# INLINE toFold #-}
209toFold :: MonadThrow m => Parser m a b -> Fold m a b
210toFold (Parser pstep pinitial pextract) = Fold step initial pextract
212 where
214 initial = do
215 r <- pinitial
216 case r of
217 IPartial s -> return $ FL.Partial s
218 IDone b -> return $ FL.Done b
219 IError err -> throwM $ InitialError err
221 step st a = do
222 r <- pstep st a
223 case r of
224 Partial 0 s -> return $ FL.Partial s
225 Continue 0 s -> return $ FL.Partial s
226 Done 0 b -> return $ FL.Done b
227 Partial n _ -> throwM $ PartialError n
228 Continue n _ -> throwM $ ContinueError n
229 Done n _ -> throwM $ DoneError n
230 Error err -> throwM $ ErrorError err
232-------------------------------------------------------------------------------
233-- Upgrade folds to parses
234-------------------------------------------------------------------------------
235--
236-- | See 'Streamly.Internal.Data.Parser.fromFold'.
237--
238-- /Pre-release/
239--
240{-# INLINE fromFold #-}
241fromFold :: Monad m => Fold m a b -> Parser m a b
242fromFold (Fold fstep finitial fextract) = Parser step initial fextract
244 where
246 initial = do
247 res <- finitial
248 return
249 $ case res of
250 FL.Partial s1 -> IPartial s1
251 FL.Done b -> IDone b
253 step s a = do
254 res <- fstep s a
255 return
256 $ case res of
257 FL.Partial s1 -> Partial 0 s1
258 FL.Done b -> Done 0 b
260-------------------------------------------------------------------------------
261-- Failing Parsers
262-------------------------------------------------------------------------------
264-- | See 'Streamly.Internal.Data.Parser.peek'.
265--
266-- /Pre-release/
267--
268{-# INLINABLE peek #-}
269peek :: MonadThrow m => Parser m a a
270peek = Parser step initial extract
272 where
274 initial = return $ IPartial ()
276 step () a = return $ Done 1 a
278 extract () = throwM $ ParseError "peek: end of input"
280-- | See 'Streamly.Internal.Data.Parser.eof'.
281--
282-- /Pre-release/
283--
284{-# INLINABLE eof #-}
285eof :: Monad m => Parser m a ()
286eof = Parser step initial return
288 where
290 initial = return $ IPartial ()
292 step () _ = return $ Error "eof: not at end of input"
294-- | See 'Streamly.Internal.Data.Parser.satisfy'.
295--
296-- /Pre-release/
297--
298{-# INLINE satisfy #-}
299satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
300satisfy predicate = Parser step initial extract
302 where
304 initial = return $ IPartial ()
306 step () a = return $
307 if predicate a
308 then Done 0 a
309 else Error "satisfy: predicate failed"
311 extract _ = throwM $ ParseError "satisfy: end of input"
313-- | See 'Streamly.Internal.Data.Parser.maybe'.
314--
315-- /Pre-release/
316--
317{-# INLINE maybe #-}
318maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
319maybe parser = Parser step initial extract
321 where
323 initial = return $ IPartial ()
325 step () a = return $
326 case parser a of
327 Just b -> Done 0 b
328 Nothing -> Error "maybe: predicate failed"
330 extract _ = throwM $ ParseError "maybe: end of input"
332-- | See 'Streamly.Internal.Data.Parser.either'.
333--
334-- /Pre-release/
335--
336{-# INLINE either #-}
337either :: MonadThrow m => (a -> Either String b) -> Parser m a b
338either parser = Parser step initial extract
340 where
342 initial = return $ IPartial ()
344 step () a = return $
345 case parser a of
346 Right b -> Done 0 b
347 Left err -> Error $ "either: " ++ err
349 extract _ = throwM $ ParseError "either: end of input"
351-------------------------------------------------------------------------------
352-- Taking elements
353-------------------------------------------------------------------------------
355-- | See 'Streamly.Internal.Data.Parser.takeBetween'.
356--
357-- /Pre-release/
358--
359{-# INLINE takeBetween #-}
360takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
361takeBetween low high (Fold fstep finitial fextract) =
363 Parser step initial extract
365 where
367 initial = do
368 res <- finitial
369 return $ case res of
370 FL.Partial s -> IPartial $ Tuple' 0 s
371 FL.Done b ->
372 if low <= 0
373 then IDone b
374 else IError
375 $ "takeBetween: the collecting fold terminated without"
376 ++ " consuming any elements"
377 ++ " minimum" ++ show low ++ " elements needed"
379 step (Tuple' i s) a
380 | low > high =
381 throwM
382 $ ParseError
383 $ "takeBetween: lower bound - " ++ show low
384 ++ " is greater than higher bound - " ++ show high
385 | high <= 0 = Done 1 <$> fextract s
386 | i1 < low = do
387 res <- fstep s a
388 return
389 $ case res of
390 FL.Partial s1 -> Continue 0 $ Tuple' i1 s1
391 FL.Done _ ->
392 Error
393 $ "takeBetween: the collecting fold terminated after"
394 ++ " consuming" ++ show i1 ++ " elements"
395 ++ " minimum" ++ show low ++ " elements needed"
396 | otherwise = do
397 res <- fstep s a
398 case res of
399 FL.Partial s1 ->
400 if i1 >= high
401 then Done 0 <$> fextract s1
402 else return $ Partial 0 $ Tuple' i1 s1
403 FL.Done b -> return $ Done 0 b
405 where
407 i1 = i + 1
409 extract (Tuple' i s)
410 | i >= low && i <= high = fextract s
411 | otherwise = throwM $ ParseError err
413 where
415 err =
416 "takeBetween: Expecting alteast " ++ show low
417 ++ " elements, got " ++ show i
419-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
420--
421-- /Pre-release/
422--
423{-# INLINE takeEQ #-}
424takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
425takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
427 where
429 cnt = max n 0
431 initial = do
432 res <- finitial
433 return $ case res of
434 FL.Partial s -> IPartial $ Tuple' 0 s
435 FL.Done b ->
436 if cnt == 0
437 then IDone b
438 else IError
439 $ "takeEQ: Expecting exactly " ++ show cnt
440 ++ " elements, fold terminated without"
441 ++ " consuming any elements"
443 step (Tuple' i r) a
444 | i1 < cnt = do
445 res <- fstep r a
446 return
447 $ case res of
448 FL.Partial s -> Continue 0 $ Tuple' i1 s
449 FL.Done _ ->
450 Error
451 $ "takeEQ: Expecting exactly " ++ show cnt
452 ++ " elements, fold terminated on " ++ show i1
453 | i1 == cnt = do
454 res <- fstep r a
455 Done 0
456 <$> case res of
457 FL.Partial s -> fextract s
458 FL.Done b -> return b
459 -- XXX we should not reach here when initial returns Step type
460 -- reachable only when n == 0
461 | otherwise = Done 1 <$> fextract r
463 where
465 i1 = i + 1
467 extract (Tuple' i r)
468 | i == 0 && cnt == 0 = fextract r
469 | otherwise =
470 throwM
471 $ ParseError
472 $ "takeEQ: Expecting exactly " ++ show cnt
473 ++ " elements, input terminated on " ++ show i
475-- | See 'Streamly.Internal.Data.Parser.takeGE'.
476--
477-- /Pre-release/
478--
479{-# INLINE takeGE #-}
480takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
481takeGE n (Fold fstep finitial fextract) = Parser step initial extract
483 where
485 cnt = max n 0
486 initial = do
487 res <- finitial
488 return $ case res of
489 FL.Partial s -> IPartial $ Tuple' 0 s
490 FL.Done b ->
491 if cnt == 0
492 then IDone b
493 else IError
494 $ "takeGE: Expecting at least " ++ show cnt
495 ++ " elements, fold terminated without"
496 ++ " consuming any elements"
498 step (Tuple' i r) a
499 | i1 < cnt = do
500 res <- fstep r a
501 return
502 $ case res of
503 FL.Partial s -> Continue 0 $ Tuple' i1 s
504 FL.Done _ ->
505 Error
506 $ "takeGE: Expecting at least " ++ show cnt
507 ++ " elements, fold terminated on " ++ show i1
508 | otherwise = do
509 res <- fstep r a
510 return
511 $ case res of
512 FL.Partial s -> Partial 0 $ Tuple' i1 s
513 FL.Done b -> Done 0 b
515 where
517 i1 = i + 1
519 extract (Tuple' i r)
520 | i >= cnt = fextract r
521 | otherwise =
522 throwM
523 $ ParseError
524 $ "takeGE: Expecting at least " ++ show cnt
525 ++ " elements, input terminated on " ++ show i
527-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
528--
529-- /Pre-release/
530--
531{-# INLINE takeWhile #-}
532takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
533takeWhile predicate (Fold fstep finitial fextract) =
534 Parser step initial fextract
536 where
538 initial = do
539 res <- finitial
540 return $ case res of
541 FL.Partial s -> IPartial s
542 FL.Done b -> IDone b
544 step s a =
545 if predicate a
546 then do
547 fres <- fstep s a
548 return
549 $ case fres of
550 FL.Partial s1 -> Partial 0 s1
551 FL.Done b -> Done 0 b
552 else Done 1 <$> fextract s
554-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
555--
556-- /Pre-release/
557--
558{-# INLINE takeWhile1 #-}
559takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
560takeWhile1 predicate (Fold fstep finitial fextract) =
561 Parser step initial extract
563 where
565 initial = do
566 res <- finitial
567 return $ case res of
568 FL.Partial s -> IPartial (Left s)
569 FL.Done _ ->
570 IError
571 $ "takeWhile1: fold terminated without consuming:"
572 ++ " any element"
574 {-# INLINE process #-}
575 process s a = do
576 res <- fstep s a
577 return
578 $ case res of
579 FL.Partial s1 -> Partial 0 (Right s1)
580 FL.Done b -> Done 0 b
582 step (Left s) a =
583 if predicate a
584 then process s a
585 else return $ Error "takeWhile1: predicate failed on first element"
586 step (Right s) a =
587 if predicate a
588 then process s a
589 else do
590 b <- fextract s
591 return $ Done 1 b
593 extract (Left _) = throwM $ ParseError "takeWhile1: end of input"
594 extract (Right s) = fextract s
596-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.
597--
598-- /Pre-release/
599--
600sliceSepByP :: MonadCatch m =>
601 (a -> Bool) -> Parser m a b -> Parser m a b
602sliceSepByP cond (Parser pstep pinitial pextract) =
604 Parser step initial pextract
606 where
608 initial = pinitial
610 step s a =
611 if cond a
612 then do
613 res <- pextract s
614 return $ Done 0 res
615 else pstep s a
617-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
618--
619-- /Pre-release/
620--
621data SliceBeginWithState s = Left' s | Right' s
623{-# INLINE sliceBeginWith #-}
624sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
625sliceBeginWith cond (Fold fstep finitial fextract) =
627 Parser step initial extract
629 where
631 initial = do
632 res <- finitial
633 return $
634 case res of
635 FL.Partial s -> IPartial (Left' s)
636 FL.Done _ -> IError "sliceBeginWith : bad finitial"
638 {-# INLINE process #-}
639 process s a = do
640 res <- fstep s a
641 return
642 $ case res of
643 FL.Partial s1 -> Partial 0 (Right' s1)
644 FL.Done b -> Done 0 b
646 step (Left' s) a =
647 if cond a
648 then process s a
649 else error $ "sliceBeginWith : slice begins with an element which "
650 ++ "fails the predicate"
651 step (Right' s) a =
652 if not (cond a)
653 then process s a
654 else Done 1 <$> fextract s
656 extract (Left' s) = fextract s
657 extract (Right' s) = fextract s
659data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
661-- | See 'Streamly.Internal.Data.Parser.wordBy'.
662--
663--
664{-# INLINE wordBy #-}
665wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
666wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
668 where
670 {-# INLINE worder #-}
671 worder s a = do
672 res <- fstep s a
673 return
674 $ case res of
675 FL.Partial s1 -> Partial 0 $ WBWord s1
676 FL.Done b -> Done 0 b
678 initial = do
679 res <- finitial
680 return
681 $ case res of
682 FL.Partial s -> IPartial $ WBLeft s
683 FL.Done b -> IDone b
685 step (WBLeft s) a =
686 if not (predicate a)
687 then worder s a
688 else return $ Partial 0 $ WBLeft s
689 step (WBWord s) a =
690 if not (predicate a)
691 then worder s a
692 else do
693 b <- fextract s
694 return $ Partial 0 $ WBRight b
695 step (WBRight b) a =
696 return
697 $ if not (predicate a)
698 then Done 1 b
699 else Partial 0 $ WBRight b
701 extract (WBLeft s) = fextract s
702 extract (WBWord s) = fextract s
703 extract (WBRight b) = return b
705{-# ANN type GroupByState Fuse #-}
706data GroupByState a s
707 = GroupByInit !s
708 | GroupByGrouping !a !s
710-- | See 'Streamly.Internal.Data.Parser.groupBy'.
711--
712{-# INLINE groupBy #-}
713groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
714groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
716 where
718 {-# INLINE grouper #-}
719 grouper s a0 a = do
720 res <- fstep s a
721 return
722 $ case res of
723 FL.Done b -> Done 0 b
724 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
726 initial = do
727 res <- finitial
728 return
729 $ case res of
730 FL.Partial s -> IPartial $ GroupByInit s
731 FL.Done b -> IDone b
733 step (GroupByInit s) a = grouper s a a
734 step (GroupByGrouping a0 s) a =
735 if eq a0 a
736 then grouper s a0 a
737 else Done 1 <$> fextract s
739 extract (GroupByInit s) = fextract s
740 extract (GroupByGrouping _ s) = fextract s
742-- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
743--
744{-# INLINE groupByRolling #-}
745groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
746groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
748 where
750 {-# INLINE grouper #-}
751 grouper s a = do
752 res <- fstep s a
753 return
754 $ case res of
755 FL.Done b -> Done 0 b
756 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
758 initial = do
759 res <- finitial
760 return
761 $ case res of
762 FL.Partial s -> IPartial $ GroupByInit s
763 FL.Done b -> IDone b
765 step (GroupByInit s) a = grouper s a
766 step (GroupByGrouping a0 s) a =
767 if eq a0 a
768 then grouper s a
769 else Done 1 <$> fextract s
771 extract (GroupByInit s) = fextract s
772 extract (GroupByGrouping _ s) = fextract s
774-- XXX use an Unfold instead of a list?
775-- XXX custom combinators for matching list, array and stream?
776--
777-- | See 'Streamly.Internal.Data.Parser.eqBy'.
778--
779-- /Pre-release/
780--
781{-# INLINE eqBy #-}
782eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
783eqBy cmp str = Parser step initial extract
785 where
787 initial = return $ IPartial str
789 step [] _ = return $ Done 0 ()
790 step [x] a =
791 return
792 $ if x `cmp` a
793 then Done 0 ()
794 else Error "eqBy: failed, yet to match the last element"
795 step (x:xs) a =
796 return
797 $ if x `cmp` a
798 then Continue 0 xs
799 else Error
800 $ "eqBy: failed, yet to match "
801 ++ show (length xs + 1) ++ " elements"
803 extract xs =
804 throwM
805 $ ParseError
806 $ "eqBy: end of input, yet to match "
807 ++ show (length xs) ++ " elements"
809--------------------------------------------------------------------------------
810--- Spanning
811--------------------------------------------------------------------------------
813-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
814-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
815-- input.
816--
817-- @
818-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
819--
820-- > span_ (< 1) [1,2,3]
821-- ([],[1,2,3])
822--
823-- > span_ (< 2) [1,2,3]
824-- ([1],[2,3])
825--
826-- > span_ (< 4) [1,2,3]
827-- ([1,2,3],[])
828--
829-- @
830--
831-- /Pre-release/
832{-# INLINE span #-}
833span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
834span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
836-- | Break the input stream into two groups, the first group takes the input as
837-- long as the predicate applied to the first element of the stream and next
838-- input element holds 'True', the second group takes the rest of the input.
839--
840-- /Pre-release/
841--
842{-# INLINE spanBy #-}
843spanBy ::
844 Monad m
845 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
846spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
848-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
849-- predicate is applied to the previous and the next input elements.
850--
851-- /Pre-release/
852{-# INLINE spanByRolling #-}
853spanByRolling ::
854 Monad m
855 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
856spanByRolling eq f1 f2 =
857 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
859-------------------------------------------------------------------------------
860-- nested parsers
861-------------------------------------------------------------------------------
863-- | See 'Streamly.Internal.Data.Parser.takeP'.
864--
865-- /Internal/
866{-# INLINE takeP #-}
867takeP :: Monad m => Int -> Parser m a b -> Parser m a b
868takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
870 where
872 initial = do
873 res <- pinitial
874 case res of
875 IPartial s ->
876 if lim > 0
877 then return $ IPartial $ Tuple' 0 s
878 else IDone <$> pextract s
879 IDone b -> return $ IDone b
880 IError e -> return $ IError e
882 step (Tuple' cnt r) a = do
883 assert (cnt < lim) (return ())
884 res <- pstep r a
885 let cnt1 = cnt + 1
886 case res of
887 Partial 0 s -> do
888 assert (cnt1 >= 0) (return ())
889 if cnt1 < lim
890 then return $ Partial 0 $ Tuple' cnt1 s
891 else Done 0 <$> pextract s
892 Continue 0 s -> do
893 assert (cnt1 >= 0) (return ())
894 if cnt1 < lim
895 then return $ Continue 0 $ Tuple' cnt1 s
896 -- XXX This should error out?
897 -- If designed properly, this will probably error out.
898 -- "pextract" should error out
899 --
900 -- By Harendra,
901 --
902 -- This is a tricky case, we have the following options:
903 -- 1. Done 0 with extract as you have written
904 -- 2. Done n, will require buffering elements
905 -- 3. Use a backtracking fold and not a parser, once we have
906 -- backtracking in folds
907 else Done 0 <$> pextract s
908 Partial n s -> do
909 let taken = cnt1 - n
910 assert (taken >= 0) (return ())
911 return $ Partial n $ Tuple' taken s
912 Continue n s -> do
913 let taken = cnt1 - n
914 assert (taken >= 0) (return ())
915 return $ Continue n $ Tuple' taken s
916 Done n b -> return $ Done n b
917 Error str -> return $ Error str
919 extract (Tuple' _ r) = pextract r
921-- | See 'Streamly.Internal.Data.Parser.lookahead'.
922--
923-- /Pre-release/
924--
925{-# INLINE lookAhead #-}
926lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
927lookAhead (Parser step1 initial1 _) = Parser step initial extract
929 where
931 initial = do
932 res <- initial1
933 return $ case res of
934 IPartial s -> IPartial (Tuple' 0 s)
935 IDone b -> IDone b
936 IError e -> IError e
938 step (Tuple' cnt st) a = do
939 r <- step1 st a
940 let cnt1 = cnt + 1
941 return
942 $ case r of
943 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
944 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
945 Done _ b -> Done cnt1 b
946 Error err -> Error err
948 -- XXX returning an error let's us backtrack. To implement it in a way so
949 -- that it terminates on eof without an error then we need a way to
950 -- backtrack on eof, that will require extract to return 'Step' type.
951 extract (Tuple' n _) =
952 throwM
953 $ ParseError
954 $ "lookAhead: end of input after consuming "
955 ++ show n ++ " elements"
957-------------------------------------------------------------------------------
958-- Interleaving
959-------------------------------------------------------------------------------
960--
961-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
962--
963-- /Unimplemented/
964--
965{-# INLINE deintercalate #-}
966deintercalate ::
967 -- Monad m =>
968 Fold m a y -> Parser m x a
969 -> Fold m b z -> Parser m x b
970 -> Parser m x (y, z)
971deintercalate = undefined
973-------------------------------------------------------------------------------
974-- Sequential Collection
975-------------------------------------------------------------------------------
976--
977-- | See 'Streamly.Internal.Data.Parser.sequence'.
978--
979-- /Unimplemented/
980--
981{-# INLINE sequence #-}
982sequence ::
983 -- Foldable t =>
984 Fold m b c -> t (Parser m a b) -> Parser m a c
985sequence _f _p = undefined
987-------------------------------------------------------------------------------
988-- Alternative Collection
989-------------------------------------------------------------------------------
991-- | See 'Streamly.Internal.Data.Parser.choice'.
992--
993-- /Broken/
994--
995{-# INLINE choice #-}
996choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b
997choice = foldl1 shortest
999-------------------------------------------------------------------------------
1000-- Sequential Repetition
1001-------------------------------------------------------------------------------
1003-- | See 'Streamly.Internal.Data.Parser.many'.
1005-- /Pre-release/
1007{-# INLINE many #-}
1008many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1009many = splitMany
1010-- many = countBetween 0 maxBound
1012-- | See 'Streamly.Internal.Data.Parser.some'.
1014-- /Pre-release/
1016{-# INLINE some #-}
1017some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
1018some = splitSome
1019-- some f p = many (takeGE 1 f) p
1020-- many = countBetween 1 maxBound
1022-- | See 'Streamly.Internal.Data.Parser.countBetween'.
1024-- /Unimplemented/
1026{-# INLINE countBetween #-}
1027countBetween ::
1028 -- MonadCatch m =>
1029 Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
1030countBetween _m _n _p = undefined
1031-- countBetween m n p f = many (takeBetween m n f) p
1033-- | See 'Streamly.Internal.Data.Parser.count'.
1035-- /Unimplemented/
1037{-# INLINE count #-}
1038count ::
1039 -- MonadCatch m =>
1040 Int -> Parser m a b -> Fold m b c -> Parser m a c
1041count n = countBetween n n
1042-- count n f p = many (takeEQ n f) p
1044data ManyTillState fs sr sl
1045 = ManyTillR Int fs sr
1046 | ManyTillL Int fs sl
1048-- | See 'Streamly.Internal.Data.Parser.manyTill'.
1050-- /Pre-release/
1052{-# INLINE manyTill #-}
1053manyTill :: MonadCatch m
1054 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1055manyTill (Fold fstep finitial fextract)
1056 (Parser stepL initialL extractL)
1057 (Parser stepR initialR _) =
1058 Parser step initial extract
1060 where
1062 -- Caution: Mutual recursion
1064 -- Don't inline this
1065 scrutL fs p c d e = do
1066 resL <- initialL
1067 case resL of
1068 IPartial sl -> return $ c (ManyTillL 0 fs sl)
1069 IDone bl -> do
1070 fr <- fstep fs bl
1071 case fr of
1072 FL.Partial fs1 -> scrutR fs1 p c d e
1073 FL.Done fb -> return $ d fb
1074 IError err -> return $ e err
1076 {-# INLINE scrutR #-}
1077 scrutR fs p c d e = do
1078 resR <- initialR
1079 case resR of
1080 IPartial sr -> return $ p (ManyTillR 0 fs sr)
1081 IDone _ -> d <$> fextract fs
1082 IError _ -> scrutL fs p c d e
1084 initial = do
1085 res <- finitial
1086 case res of
1087 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
1088 FL.Done b -> return $ IDone b
1090 step (ManyTillR cnt fs st) a = do
1091 r <- stepR st a
1092 case r of
1093 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
1094 Continue n s -> do
1095 assert (cnt + 1 - n >= 0) (return ())
1096 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
1097 Done n _ -> do
1098 b <- fextract fs
1099 return $ Done n b
1100 Error _ -> do
1101 resL <- initialL
1102 case resL of
1103 IPartial sl ->
1104 return $ Continue (cnt + 1) (ManyTillL 0 fs sl)
1105 IDone bl -> do
1106 fr <- fstep fs bl
1107 let cnt1 = cnt + 1
1108 p = Partial cnt
1109 c = Continue cnt
1110 d = Done cnt
1111 case fr of
1112 FL.Partial fs1 -> scrutR fs1 p c d Error
1113 FL.Done fb -> return $ Done cnt1 fb
1114 IError err -> return $ Error err
1115 -- XXX the cnt is being used only by the assert
1116 step (ManyTillL cnt fs st) a = do
1117 r <- stepL st a
1118 case r of
1119 Partial n s -> return $ Partial n (ManyTillL 0 fs s)
1120 Continue n s -> do
1121 assert (cnt + 1 - n >= 0) (return ())
1122 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
1123 Done n b -> do
1124 fs1 <- fstep fs b
1125 case fs1 of
1126 FL.Partial s ->
1127 scrutR s (Partial n) (Continue n) (Done n) Error
1128 FL.Done b1 -> return $ Done n b1
1129 Error err -> return $ Error err
1131 extract (ManyTillL _ fs sR) = do
1132 res <- extractL sR >>= fstep fs
1133 case res of
1134 FL.Partial s -> fextract s
1135 FL.Done b -> return b
1136 extract (ManyTillR _ fs _) = fextract fs