3-- Module : Streamly.Internal.Data.Parser
4-- Copyright : (c) 2020 Composewell Technologies
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
10module Streamly.Internal.Data.Parser
15 module Streamly.Internal.Data.Parser.Type
16 --, module Streamly.Internal.Data.Parser.Tee
24 -- * Downgrade to Fold
27 -- First order parsers
38 -- All of these can be expressed in terms of either
49 -- * Sequence parsers (tokenizers)
51 -- | Parsers chained in series, if one parser terminates the composition
52 -- terminates. Currently we are using folds to collect the output of the
53 -- parsers but we can use Parsers instead of folds to make the composition
54 -- more powerful. For example, we can do:
56 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
57 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
58 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
62 -- | Grab a sequence of input elements without inspecting them
64 -- , take -- takeBetween 0 n
65 , takeEQ -- takeBetween n n
66 , takeGE -- takeBetween n maxBound
67 -- , takeGE1 -- take1 -- takeBetween 1 n
70 -- Grab a sequence of input elements by inspecting them
83 -- ** Separated by elements
84 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
85 -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
86 -- separator parsing, also see 'intersperseQuotedBy' fold.
88 -- These can be implemented modularly with refolds, using takeWhile and
99 -- ** Grouped by element comparison
102 , groupByRollingEither
104 -- ** Framed by elements
105 -- | Also see 'intersperseQuotedBy' fold.
106 -- Framed by a one or more ocurrences of a separator around a word like
107 -- spaces or quotes. No nesting.
108 , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
113 -- Framed by separate start and end characters, potentially nested.
114 -- blockWithQuotes allows quotes inside a block. However,
115 -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and
116 -- block with escaping.
120 , takeFramedByGeneric
124 -- , prefixOf -- match any prefix of a given string
125 -- , suffixOf -- match any suffix of a given string
126 -- , infixOf -- match any substring of a given string
133 -- Second order parsers (parsers using parsers)
134 -- * Binary Combinators
136 -- ** Parallel Applicatives
140 -- , teeTill -- like manyTill but parallel
144 -- ** Parallel Alternatives
150 -- * N-ary Combinators
151 -- ** Sequential Collection
154 -- ** Sequential Repetition
157 -- , countBetweenTill
162 -- ** Interleaved Repetition
163 -- Use two folds, run a primary parser, its rejected values go to the
168 -- , deintercalatePrefix
169 -- , deintercalateSuffix
172 -- | TODO: traditional implmentations of these may be of limited use. For
173 -- example, consider parsing lines separated by @\\r\\n@. The main parser
174 -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
175 -- can apply the "sep" parser.
177 -- We can instead implement these as special cases of deintercalate.
196 -- A simple and stupid impl would be to just convert the stream to an array
197 -- and give the array reference to all consumers. The array can be grown on
198 -- demand by any consumer and truncated when nonbody needs it.
200 -- -- ** Distribute to collection
201 -- -- ** Distribute to repetition
203 -- ** Interleaved collection
210 -- -- ** Interleaved repetition
211 -- repeat one parser and when it fails run an error recovery parser
212 -- e.g. to find a key frame in the stream after an error
214 -- ** Collection of Alternatives
220 -- , fastestN -- first N successful in time
221 -- , choiceN -- first N successful in position
223 -- , choice -- first successful in position
225 -- ** Repeated Alternatives
245import Control.Monad (when)
246import Data.Bifunctor (first)
247import Fusion.Plugin.Types (Fuse(..))
248import Streamly.Internal.Data.Fold.Type (Fold(..))
249import Streamly.Internal.Data.SVar.Type (defState)
250import Streamly.Internal.Data.Either.Strict (Either'(..))
251import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
252import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
253import Streamly.Internal.Data.Stream.Type (Stream)
255import qualified Data.Foldable as Foldable
256import qualified Streamly.Internal.Data.Fold.Type as FL
257import qualified Streamly.Internal.Data.Stream.Type as D
258import qualified Streamly.Internal.Data.Stream.Generate as D
260import Streamly.Internal.Data.Parser.Type
261--import Streamly.Internal.Data.Parser.Tee -- It's empty
264 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
265 , zip, filter, dropWhile)
267#include "DocTestDataParser.hs"
269-------------------------------------------------------------------------------
270-- Downgrade a parser to a Fold
271-------------------------------------------------------------------------------
273-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the
274-- parser fails or tries to backtrack.
276-- This can be useful in combinators that accept a Fold and we know that a
277-- Parser cannot fail or failure exception is acceptable as there is no way to
283toFold :: Monad m => Parser a m b -> Fold m a b
284toFold (Parser pstep pinitial pextract) = Fold step initial extract
291 IPartial s -> return $ FL.Partial s
292 IDone b -> return $ FL.Done b
294 error $ "toFold: parser throws error in initial" ++ err
296 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
297 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
298 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
299 eerror err = error $ "toFold: parser throws error: " ++ err
304 Partial 0 s -> return $ FL.Partial s
305 Continue 0 s -> return $ FL.Partial s
306 Done 0 b -> return $ FL.Done b
307 Partial n _ -> perror n
308 Continue n _ -> cerror n
310 Error err -> eerror err
316 Partial n _ -> perror n
317 Continue n _ -> cerror n
319 Error err -> eerror err
321-------------------------------------------------------------------------------
322-- Upgrade folds to parses
323-------------------------------------------------------------------------------
325-- | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the
328{-# INLINE fromFold #-}
329fromFold :: Monad m => Fold m a b -> Parser a m b
330fromFold (Fold fstep finitial fextract) = Parser step initial extract
338 FL.Partial s1 -> IPartial s1
345 FL.Partial s1 -> Partial 0 s1
346 FL.Done b -> Done 0 b
348 extract = fmap (Done 0) . fextract
350-- | Convert a Maybe returning fold to an error returning parser. The first
351-- argument is the error message that the parser would return when the fold
356{-# INLINE fromFoldMaybe #-}
357fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b
358fromFoldMaybe errMsg (Fold fstep finitial fextract) =
359 Parser step initial extract
367 FL.Partial s1 -> IPartial s1
371 Nothing -> IError errMsg
377 FL.Partial s1 -> Partial 0 s1
381 Nothing -> Error errMsg
386 Just x -> return $ Done 0 x
387 Nothing -> return $ Error errMsg
389-------------------------------------------------------------------------------
391-------------------------------------------------------------------------------
393-- | Peek the head element of a stream, without consuming it. Fails if it
394-- encounters end of input.
396-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]
400-- peek = lookAhead (satisfy True)
404peek :: Monad m => Parser a m a
405peek = Parser step initial extract
409 initial = return $ IPartial ()
411 step () a = return $ Done 1 a
413 extract () = return $ Error "peek: end of input"
415-- | Succeeds if we are at the end of input, fails otherwise.
417-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]
421eof :: Monad m => Parser a m ()
422eof = Parser step initial extract
426 initial = return $ IPartial ()
428 step () _ = return $ Error "eof: not at end of input"
430 extract () = return $ Done 0 ()
432-- | Return the next element of the input. Returns 'Nothing'
433-- on end of input. Also known as 'head'.
437{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}
439next :: Monad m => Parser a m (Maybe a)
440next = Parser step initial extract
444 initial = pure $ IPartial ()
446 step () a = pure $ Done 0 (Just a)
448 extract () = pure $ Done 0 Nothing
450-- | Map an 'Either' returning function on the next element in the stream. If
451-- the function returns 'Left err', the parser fails with the error message
452-- @err@ otherwise returns the 'Right' value.
457either :: Monad m => (a -> Either String b) -> Parser a m b
458either f = Parser step initial extract
462 initial = return $ IPartial ()
467 Left err -> Error err
469 extract () = return $ Error "end of input"
471-- | Map a 'Maybe' returning function on the next element in the stream. The
472-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
475-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
476-- >>> maybe f = Parser.either (toEither . f)
478-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)
483maybe :: Monad m => (a -> Maybe b) -> Parser a m b
484-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
485maybe parserF = Parser step initial extract
489 initial = return $ IPartial ()
494 Nothing -> Error "maybe: predicate failed"
496 extract () = return $ Error "maybe: end of input"
498-- | Returns the next element if it passes the predicate, fails otherwise.
500-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]
503-- >>> toMaybe f x = if f x then Just x else Nothing
504-- >>> satisfy f = Parser.maybe (toMaybe f)
506{-# INLINE satisfy #-}
507satisfy :: Monad m => (a -> Bool) -> Parser a m a
508-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
509satisfy predicate = Parser step initial extract
513 initial = return $ IPartial ()
518 else Error "satisfy: predicate failed"
520 extract () = return $ Error "satisfy: end of input"
522-- | Consume one element from the head of the stream. Fails if it encounters
525-- >>> one = Parser.satisfy $ const True
528one :: Monad m => Parser a m a
529one = satisfy $ const True
531-- Alternate names: "only", "onlyThis".
533-- | Match a specific element.
535-- >>> oneEq x = Parser.satisfy (== x)
538oneEq :: (Monad m, Eq a) => a -> Parser a m a
539oneEq x = satisfy (== x)
541-- Alternate names: "exclude", "notThis".
543-- | Match anything other than the supplied element.
545-- >>> oneNotEq x = Parser.satisfy (/= x)
547{-# INLINE oneNotEq #-}
548oneNotEq :: (Monad m, Eq a) => a -> Parser a m a
549oneNotEq x = satisfy (/= x)
551-- | Match any one of the elements in the supplied list.
553-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)
555-- When performance matters a pattern matching predicate could be more
556-- efficient than a 'Foldable' datatype:
567-- GHC may use a binary search instead of linear search in the list.
568-- Alternatively, you can also use an array instead of list for storage and
572oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
573oneOf xs = satisfy (`Foldable.elem` xs)
575-- | See performance notes in 'oneOf'.
577-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)
580noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
581noneOf xs = satisfy (`Foldable.notElem` xs)
583-------------------------------------------------------------------------------
585-------------------------------------------------------------------------------
587-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
588{-# ANN type Tuple'Fused Fuse #-}
589data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
591-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input
592-- elements and folds them using the supplied fold.
594-- Stops after @n@ elements.
595-- Fails if the stream ends before @m@ elements could be taken.
601-- takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)
602-- where prsr = Parser.takeBetween low high Fold.toList
607-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]
610-- >>> takeBetween' 2 4 [1, 2]
613-- >>> takeBetween' 2 4 [1]
614-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")
616-- >>> takeBetween' 0 0 [1, 2]
619-- >>> takeBetween' 0 1 []
622-- @takeBetween@ is the most general take operation, other take operations can
623-- be defined in terms of takeBetween. For example:
625-- >>> take n = Parser.takeBetween 0 n
626-- >>> takeEQ n = Parser.takeBetween n n
627-- >>> takeGE n = Parser.takeBetween n maxBound
631{-# INLINE takeBetween #-}
632takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
633takeBetween low high (Fold fstep finitial fextract) =
635 Parser step initial (extract streamErr)
640 "takeBetween: Expecting alteast " ++ show low
641 ++ " elements, got " ++ show i
644 "takeBetween: lower bound - " ++ show low
645 ++ " is greater than higher bound - " ++ show high
647 foldErr :: Int -> String
649 "takeBetween: the collecting fold terminated after"
650 ++ " consuming" ++ show i ++ " elements"
651 ++ " minimum" ++ show low ++ " elements needed"
653 -- Exactly the same as snext except different constructors, we can possibly
654 -- deduplicate the two.
660 let s1 = Tuple'Fused i1 s
662 -- XXX ideally this should be a Continue instead
663 then return $ IPartial s1
664 else iextract foldErr s1
669 else IError (foldErr i1)
672 when (low >= 0 && high >= 0 && low > high)
675 finitial >>= inext (-1)
677 -- Keep the impl same as inext
683 let s1 = Tuple'Fused i1 s
685 then return $ Continue 0 s1
686 else extract foldErr s1
691 else Error (foldErr i1)
693 step (Tuple'Fused i s) a = fstep s a >>= snext i
695 extract f (Tuple'Fused i s)
696 | i >= low && i <= high = fmap (Done 0) (fextract s)
697 | otherwise = return $ Error (f i)
699 -- XXX Need to make Initial return type Step to deduplicate this
700 iextract f (Tuple'Fused i s)
701 | i >= low && i <= high = fmap IDone (fextract s)
702 | otherwise = return $ IError (f i)
704-- | Stops after taking exactly @n@ input elements.
706-- * Stops - after consuming @n@ elements.
707-- * Fails - if the stream or the collecting fold ends before it can collect
708-- exactly @n@ elements.
710-- >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]
713-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
714-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")
717takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
718takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
727 then return $ IPartial $ Tuple'Fused 1 s
728 else fmap IDone (fextract s)
729 FL.Done b -> return $
732 $ "takeEQ: Expecting exactly " ++ show n
733 ++ " elements, fold terminated without"
734 ++ " consuming any elements"
737 step (Tuple'Fused i1 r) a = do
743 FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s
746 $ "takeEQ: Expecting exactly " ++ show n
747 ++ " elements, fold terminated on " ++ show i1
752 FL.Partial s -> fextract s
753 FL.Done b -> return b
755 extract (Tuple'Fused i _) =
756 -- Using the count "i" in the message below causes large performance
757 -- regression unless we use Fuse annotation on Tuple.
760 $ "takeEQ: Expecting exactly " ++ show n
761 ++ " elements, input terminated on " ++ show (i - 1)
763{-# ANN type TakeGEState Fuse #-}
768-- | Take at least @n@ input elements, but can collect more.
770-- * Stops - when the collecting fold stops.
771-- * Fails - if the stream or the collecting fold ends before producing @n@
774-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
775-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")
777-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
783takeGE :: Monad m => Int -> Fold m a b -> Parser a m b
784takeGE n (Fold fstep finitial fextract) = Parser step initial extract
793 then return $ IPartial $ TakeGELT 1 s
794 else return $ IPartial $ TakeGEGE s
795 FL.Done b -> return $
798 $ "takeGE: Expecting at least " ++ show n
799 ++ " elements, fold terminated without"
800 ++ " consuming any elements"
803 step (TakeGELT i1 r) a = do
809 FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s
812 $ "takeGE: Expecting at least " ++ show n
813 ++ " elements, fold terminated on " ++ show i1
818 FL.Partial s -> Partial 0 $ TakeGEGE s
819 FL.Done b -> Done 0 b
820 step (TakeGEGE r) a = do
824 FL.Partial s -> Partial 0 $ TakeGEGE s
825 FL.Done b -> Done 0 b
827 extract (TakeGELT i _) =
830 $ "takeGE: Expecting at least " ++ show n
831 ++ " elements, input terminated on " ++ show (i - 1)
832 extract (TakeGEGE r) = fmap (Done 0) $ fextract r
834-------------------------------------------------------------------------------
835-- Conditional splitting
836-------------------------------------------------------------------------------
838-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.
840-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the
841-- input. The combinator stops when the condition fails or if the collecting
844-- Other interesting parsers can be implemented in terms of this parser:
846-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
847-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)
849-- Stops: when the condition fails or the collecting parser stops.
850-- Fails: when the collecting parser fails.
854{-# INLINE takeWhileP #-}
855takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
856takeWhileP predicate (Parser pstep pinitial pextract) =
857 Parser step pinitial pextract
866 -- XXX need a map on count
868 Error err -> return $ Error err
869 Done n s1 -> return $ Done (n + 1) s1
870 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
871 Continue n s1 -> return $ Continue (n + 1) s1
873-- | Collect stream elements until an element fails the predicate. The element
874-- on which the predicate fails is returned back to the input stream.
876-- * Stops - when the predicate fails or the collecting fold stops.
879-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]
882-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)
884-- We can implement a @breakOn@ using 'takeWhile':
887-- breakOn p = takeWhile (not p)
890{-# INLINE takeWhile #-}
891takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
892-- takeWhile cond f = takeWhileP cond (fromFold f)
893takeWhile predicate (Fold fstep finitial fextract) =
894 Parser step initial extract
901 FL.Partial s -> IPartial s
910 FL.Partial s1 -> Partial 0 s1
911 FL.Done b -> Done 0 b
912 else Done 1 <$> fextract s
914 extract s = fmap (Done 0) (fextract s)
917-- XXX This may not be composable because of the b argument. We can instead
918-- return a "Reparse b a m b" so that those can be composed.
919{-# INLINE takeWhile1X #-}
920takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b
921-- We can implement this using satisfy and takeWhile. We can use "satisfy
922-- p", fold the result with the refold and then use the "takeWhile p" and
923-- fold that using the refold.
924takeWhile1 acc cond f = undefined
927-- | Like 'takeWhile' but takes at least one element otherwise fails.
929-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
931{-# INLINE takeWhile1 #-}
932takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
933-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)
934takeWhile1 predicate (Fold fstep finitial fextract) =
935 Parser step initial extract
942 FL.Partial s -> IPartial (Left' s)
945 $ "takeWhile1: fold terminated without consuming:"
948 {-# INLINE process #-}
953 FL.Partial s1 -> Partial 0 (Right' s1)
954 FL.Done b -> Done 0 b
959 else return $ Error "takeWhile1: predicate failed on first element"
967 extract (Left' _) = return $ Error "takeWhile1: end of input"
968 extract (Right' s) = fmap (Done 0) (fextract s)
970-- | Drain the input as long as the predicate succeeds, running the effects and
971-- discarding the results.
973-- This is also called @skipWhile@ in some parsing libraries.
975-- >>> dropWhile p = Parser.takeWhile p Fold.drain
977{-# INLINE dropWhile #-}
978dropWhile :: Monad m => (a -> Bool) -> Parser a m ()
979dropWhile p = takeWhile p FL.drain
981-------------------------------------------------------------------------------
983-------------------------------------------------------------------------------
985{-# ANN type FramedEscState Fuse #-}
986data FramedEscState s =
987 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
989-- XXX We can remove Maybe from esc
990{-# INLINE takeFramedByGeneric #-}
991takeFramedByGeneric :: Monad m =>
992 Maybe (a -> Bool) -- is escape char?
993 -> Maybe (a -> Bool) -- is frame begin?
994 -> Maybe (a -> Bool) -- is frame end?
997takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
999 Parser step initial extract
1007 FL.Partial s -> IPartial (FrameEscInit s)
1009 error "takeFramedByGeneric: fold done without input"
1011 {-# INLINE process #-}
1016 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1017 FL.Done b -> Done 0 b
1019 {-# INLINE processNoEsc #-}
1020 processNoEsc s a n =
1025 -- takeFramedBy case
1029 then Done 0 <$> fextract s
1030 else process s a (n - 1)
1032 let n1 = if isBegin a then n + 1 else n
1034 Nothing -> -- takeEndBy case
1036 then Done 0 <$> fextract s
1038 Nothing -> -- takeStartBy case
1042 then Done 0 <$> fextract s
1045 error $ "takeFramedByGeneric: "
1046 ++ "Both begin and end frame predicate missing"
1048 {-# INLINE processCheckEsc #-}
1049 processCheckEsc s a n =
1053 then return $ Partial 0 $ FrameEscEsc s n
1054 else processNoEsc s a n
1055 Nothing -> processNoEsc s a n
1057 step (FrameEscInit s) a =
1061 then return $ Partial 0 (FrameEscGo s 0)
1062 else return $ Error "takeFramedByGeneric: missing frame start"
1067 then Done 0 <$> fextract s
1068 else processCheckEsc s a 0
1070 error "Both begin and end frame predicate missing"
1071 step (FrameEscGo s n) a = processCheckEsc s a n
1072 step (FrameEscEsc s n) a = process s a n
1074 err = return . Error
1076 extract (FrameEscInit _) =
1077 err "takeFramedByGeneric: empty token"
1078 extract (FrameEscGo s _) =
1082 Nothing -> fmap (Done 0) $ fextract s
1083 Just _ -> err "takeFramedByGeneric: missing frame end"
1084 Nothing -> err "takeFramedByGeneric: missing closing frame"
1085 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1087data BlockParseState s =
1089 | BlockUnquoted !Int !s
1090 | BlockQuoted !Int !s
1091 | BlockQuotedEsc !Int !s
1093-- Blocks can be of different types e.g. {} or (). We only parse from the
1094-- perspective of the outermost block type. The nesting of that block are
1095-- checked. Any other block types nested inside it are opaque to us and can be
1096-- parsed when the contents of the block are parsed.
1098-- XXX Put a limit on nest level to keep the API safe.
1100-- | Parse a block enclosed within open, close brackets. Block contents may be
1101-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1102-- within quotes if escaped. A block can have a nested block inside it.
1104-- Quote begin and end chars are the same. Block brackets and quote chars must
1105-- not overlap. Block start and end brackets must be different for nesting
1106-- blocks within blocks.
1108-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1109-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1110-- Right "msg: \"hello world\""
1112{-# INLINE blockWithQuotes #-}
1113blockWithQuotes :: (Monad m, Eq a) =>
1114 (a -> Bool) -- ^ escape char
1115 -> (a -> Bool) -- ^ quote char, to quote inside brackets
1116 -> a -- ^ Block opening bracket
1117 -> a -- ^ Block closing bracket
1120blockWithQuotes isEsc isQuote bopen bclose
1121 (Fold fstep finitial fextract) =
1122 Parser step initial extract
1130 FL.Partial s -> IPartial (BlockInit s)
1132 error "blockWithQuotes: fold finished without input"
1134 {-# INLINE process #-}
1135 process s a nextState = do
1139 FL.Partial s1 -> Continue 0 (nextState s1)
1140 FL.Done b -> Done 0 b
1142 step (BlockInit s) a =
1145 then Continue 0 $ BlockUnquoted 1 s
1146 else Error "blockWithQuotes: missing block start"
1147 step (BlockUnquoted level s) a
1148 | a == bopen = process s a (BlockUnquoted (level + 1))
1151 then fmap (Done 0) (fextract s)
1152 else process s a (BlockUnquoted (level - 1))
1153 | isQuote a = process s a (BlockQuoted level)
1154 | otherwise = process s a (BlockUnquoted level)
1155 step (BlockQuoted level s) a
1156 | isEsc a = process s a (BlockQuotedEsc level)
1159 then process s a (BlockUnquoted level)
1160 else process s a (BlockQuoted level)
1161 step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1163 err = return . Error
1165 extract (BlockInit s) = fmap (Done 0) $ fextract s
1166 extract (BlockUnquoted level _) =
1167 err $ "blockWithQuotes: finished at block nest level " ++ show level
1168 extract (BlockQuoted level _) =
1169 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1170 ++ "at block nest level " ++ show level
1171 extract (BlockQuotedEsc level _) =
1172 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1173 ++ "after an escape char, at block nest level " ++ show level
1175-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1176-- the supplied predicate. The separator is also taken with the token.
1178-- This can be combined with other parsers to implement other interesting
1179-- parsers as follows:
1181-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)
1182-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)
1184-- >>> takeEndBy = Parser.takeEndByEsc (const False)
1186-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting
1187-- parser in the takeEndBy parser can decide whether to fail or not if the
1188-- stream does not end with separator.
1192{-# INLINE takeEndBy #-}
1193takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
1194-- takeEndBy = takeEndByEsc (const False)
1195takeEndBy cond (Parser pstep pinitial pextract) =
1197 Parser step initial pextract
1207 else extractStep pextract res
1209-- | Like 'takeEndBy' but the separator elements can be escaped using an
1210-- escape char determined by the first predicate. The escape characters are
1214{-# INLINE takeEndByEsc #-}
1215takeEndByEsc :: Monad m =>
1216 (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
1217takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
1219 Parser step initial extract
1223 initial = first Left' <$> pinitial
1225 step (Left' s) a = do
1227 then return $ Partial 0 $ Right' s
1231 then return $ first Left' res
1232 else fmap (first Left') $ extractStep pextract res
1234 step (Right' s) a = do
1236 return $ first Left' res
1238 extract (Left' s) = fmap (first Left') $ pextract s
1239 extract (Right' _) =
1240 return $ Error "takeEndByEsc: trailing escape"
1242-- | Like 'takeEndBy' but the separator is dropped.
1244-- See also "Streamly.Data.Fold.takeEndBy_".
1248{-# INLINE takeEndBy_ #-}
1249takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b
1252 takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)
1254takeEndBy_ cond (Parser pstep pinitial pextract) =
1256 Parser step pinitial pextract
1265-- | Take either the separator or the token. Separator is a Left value and
1266-- token is Right value.
1269{-# INLINE takeEitherSepBy #-}
1270takeEitherSepBy :: -- Monad m =>
1271 (a -> Bool) -> Fold m (Either a b) c -> Parser a m c
1272takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond
1274-- | Parse a token that starts with an element chosen by the predicate. The
1275-- parser fails if the input does not start with the selected element.
1277-- * Stops - when the predicate succeeds in non-leading position.
1278-- * Fails - when the predicate fails in the leading position.
1280-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)
1284-- >>> p = Parser.takeStartBy (== ',') Fold.toList
1285-- >>> leadingComma = Stream.parse p . Stream.fromList
1286-- >>> leadingComma "a,b"
1287-- Left (ParseError "takeStartBy: missing frame start")
1289-- >>> leadingComma ",,"
1291-- >>> leadingComma ",a,b"
1293-- >>> leadingComma ""
1298{-# INLINE takeStartBy #-}
1299takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1300takeStartBy cond (Fold fstep finitial fextract) =
1302 Parser step initial extract
1310 FL.Partial s -> IPartial (Left' s)
1311 FL.Done _ -> IError "takeStartBy: fold done without input"
1313 {-# INLINE process #-}
1318 FL.Partial s1 -> Partial 0 (Right' s1)
1319 FL.Done b -> Done 0 b
1324 else return $ Error "takeStartBy: missing frame start"
1328 else Done 1 <$> fextract s
1330 extract (Left' s) = fmap (Done 0) $ fextract s
1331 extract (Right' s) = fmap (Done 0) $ fextract s
1333-- | Like 'takeStartBy' but drops the separator.
1335-- >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing
1337{-# INLINE takeStartBy_ #-}
1338takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1339takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing
1341-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a
1342-- begin and end predicate, and an escape character. The frame begin and end
1343-- characters lose their special meaning if preceded by the escape character.
1345-- Nested frames are allowed if begin and end markers are different, nested
1346-- frames must be balanced unless escaped, nested frame markers are emitted as
1351-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList
1352-- >>> Stream.parse p $ Stream.fromList "{hello}"
1354-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"
1355-- Right "hello {world}"
1356-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
1357-- Right "hello {world"
1358-- >>> Stream.parse p $ Stream.fromList "{hello {world}"
1359-- Left (ParseError "takeFramedByEsc_: missing frame end")
1362{-# INLINE takeFramedByEsc_ #-}
1363takeFramedByEsc_ :: Monad m =>
1364 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1365-- takeFramedByEsc_ isEsc isEnd p =
1366-- takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)
1367takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
1369 Parser step initial extract
1377 FL.Partial s -> IPartial (FrameEscInit s)
1379 error "takeFramedByEsc_: fold done without input"
1381 {-# INLINE process #-}
1386 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1387 FL.Done b -> Done 0 b
1389 step (FrameEscInit s) a =
1391 then return $ Partial 0 (FrameEscGo s 0)
1392 else return $ Error "takeFramedByEsc_: missing frame start"
1393 step (FrameEscGo s n) a =
1395 then return $ Partial 0 $ FrameEscEsc s n
1399 let n1 = if isBegin a then n + 1 else n
1403 then Done 0 <$> fextract s
1404 else process s a (n - 1)
1405 step (FrameEscEsc s n) a = process s a n
1407 err = return . Error
1409 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1410 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1411 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1413data FramedState s = FrameInit !s | FrameGo !s Int
1415-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an
1418-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)
1420{-# INLINE takeFramedBy_ #-}
1421takeFramedBy_ :: Monad m =>
1422 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1423-- takeFramedBy_ isBegin isEnd =
1424-- takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)
1425takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
1427 Parser step initial extract
1435 FL.Partial s -> IPartial (FrameInit s)
1437 error "takeFramedBy_: fold done without input"
1439 {-# INLINE process #-}
1444 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1445 FL.Done b -> Done 0 b
1447 step (FrameInit s) a =
1449 then return $ Continue 0 (FrameGo s 0)
1450 else return $ Error "takeFramedBy_: missing frame start"
1451 step (FrameGo s n) a
1453 let n1 = if isBegin a then n + 1 else n
1455 | n == 0 = Done 0 <$> fextract s
1456 | otherwise = process s a (n - 1)
1458 err = return . Error
1460 extract (FrameInit _) = err "takeFramedBy_: empty token"
1461 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1463-------------------------------------------------------------------------------
1464-- Grouping and words
1465-------------------------------------------------------------------------------
1467data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1469-- Note we can also get words using something like:
1470-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)
1472-- But that won't be as efficient and ergonomic.
1474-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
1475-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
1476-- @["a","b"]@. In other words, its like parsing words from whitespace
1479-- * Stops - when it finds a word separator after a non-word element
1482-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)
1485-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)
1488{-# INLINE wordBy #-}
1489wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1490wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1494 {-# INLINE worder #-}
1499 FL.Partial s1 -> Partial 0 $ WBWord s1
1500 FL.Done b -> Done 0 b
1506 FL.Partial s -> IPartial $ WBLeft s
1507 FL.Done b -> IDone b
1510 if not (predicate a)
1512 else return $ Partial 0 $ WBLeft s
1514 if not (predicate a)
1518 return $ Partial 0 $ WBRight b
1519 step (WBRight b) a =
1521 $ if not (predicate a)
1523 else Partial 0 $ WBRight b
1525 extract (WBLeft s) = fmap (Done 0) $ fextract s
1526 extract (WBWord s) = fmap (Done 0) $ fextract s
1527 extract (WBRight b) = return (Done 0 b)
1529data WordFramedState s b =
1530 WordFramedSkipPre !s
1531 | WordFramedWord !s !Int
1532 | WordFramedEsc !s !Int
1533 | WordFramedSkipPost !b
1535-- | Like 'wordBy' but treats anything inside a pair of quotes as a single
1536-- word, the quotes can be escaped by an escape character. Recursive quotes
1537-- are possible if quote begin and end characters are different, quotes must be
1538-- balanced. Outermost quotes are stripped.
1540-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList
1541-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"
1543-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"
1545-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"
1547-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"
1550-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList
1551-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""
1554{-# INLINE wordFramedBy #-}
1555wordFramedBy :: Monad m =>
1556 (a -> Bool) -- ^ Matches escape elem?
1557 -> (a -> Bool) -- ^ Matches left quote?
1558 -> (a -> Bool) -- ^ matches right quote?
1559 -> (a -> Bool) -- ^ matches word separator?
1562wordFramedBy isEsc isBegin isEnd isSep
1563 (Fold fstep finitial fextract) =
1564 Parser step initial extract
1572 FL.Partial s -> IPartial (WordFramedSkipPre s)
1574 error "wordFramedBy: fold done without input"
1576 {-# INLINE process #-}
1581 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1582 FL.Done b -> Done 0 b
1584 step (WordFramedSkipPre s) a
1585 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1586 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1587 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1589 return $ Error "wordFramedBy: missing frame start"
1590 | otherwise = process s a 0
1591 step (WordFramedWord s n) a
1592 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1593 | n == 0 && isSep a = do
1595 return $ Partial 0 $ WordFramedSkipPost b
1597 -- We need to use different order for checking begin and end for
1598 -- the n == 0 and n == 1 case so that when the begin and end
1599 -- character is the same we treat the one after begin as end.
1602 -- Need to check isBegin first
1604 then return $ Continue 0 $ WordFramedWord s 1
1606 then return $ Error "wordFramedBy: missing frame start"
1609 -- Need to check isEnd first
1613 then return $ Continue 0 $ WordFramedWord s 0
1614 else process s a (n - 1)
1616 then process s a (n + 1)
1618 step (WordFramedEsc s n) a = process s a n
1619 step (WordFramedSkipPost b) a =
1623 else Partial 0 $ WordFramedSkipPost b
1625 err = return . Error
1627 extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s
1628 extract (WordFramedWord s n) =
1630 then fmap (Done 0) $ fextract s
1631 else err "wordFramedBy: missing frame end"
1632 extract (WordFramedEsc _ _) =
1633 err "wordFramedBy: trailing escape"
1634 extract (WordFramedSkipPost b) = return (Done 0 b)
1636data WordQuotedState s b a =
1637 WordQuotedSkipPre !s
1638 | WordUnquotedWord !s
1639 | WordQuotedWord !s !Int !a !a
1640 | WordUnquotedEsc !s
1641 | WordQuotedEsc !s !Int !a !a
1642 | WordQuotedSkipPost !b
1644-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
1645-- word separators within specified quotes or brackets are ignored. Quotes and
1646-- escape characters can be processed. If the end quote is different from the
1647-- start quote it is called a bracket. The following quoting rules apply:
1649-- * In an unquoted string a character may be preceded by an escape character.
1650-- The escape character is removed and the character following it is treated
1651-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
1653-- * Any part of the word can be placed within quotes. Inside quotes all
1654-- characters are treated literally with no special meaning. Quoting character
1655-- itself cannot be used within quotes unless escape processing within quotes
1656-- is applied to allow it.
1657-- * Optionally escape processing for quoted part can be specified. Escape
1658-- character has no special meaning inside quotes unless it is followed by a
1659-- character that has a escape translation specified, in that case the escape
1660-- character is removed, and the specified translation is applied to the
1661-- character following it. This can be used to escape the quoting character
1662-- itself within quotes.
1663-- * There can be multiple quoting characters, when a quote starts, all other
1664-- quoting characters within that quote lose any special meaning until the
1666-- * A starting quote char without an ending char generates a parse error. An
1667-- ending bracket char without a corresponding bracket begin is ignored.
1668-- * Brackets can be nested.
1670-- We should note that unquoted and quoted escape processing are different. In
1671-- unquoted part escape character is always removed. In quoted part it is
1672-- removed only if followed by a special meaning character. This is consistent
1673-- with how shell performs escape processing.
1675-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
1676-- ((nested) brackets).
1684-- >>> '\'' -> Just x
1688-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
1689-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1690-- Right "a\"b'c\";'d\"e'f"
1692-- Note that outer quotes and backslashes from the input string are consumed by
1693-- Haskell, therefore, the actual input string passed to the parser is:
1696-- Similarly, when printing, double quotes are escaped by Haskell.
1700-- Shell like quote processing can be performed by using quote char specific
1701-- escape processing, single quotes with no escapes, and double quotes with
1704-- JSON string processing can also be achieved except the "\uXXXX" style
1705-- escaping for Unicode characters.
1707{-# INLINE wordWithQuotes #-}
1708wordWithQuotes :: (Monad m, Eq a) =>
1709 Bool -- ^ Retain the quotes and escape chars in the output
1710 -> (a -> a -> Maybe a) -- ^ quote char -> escaped char -> translated char
1711 -> a -- ^ Matches an escape elem?
1712 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1713 -> (a -> Bool) -- ^ Matches a word separator?
1716wordWithQuotes keepQuotes tr escChar toRight isSep
1717 (Fold fstep finitial fextract) =
1718 Parser step initial extract
1722 -- Can be used to generate parse error for a bracket end without a bracket
1724 isInvalid = const False
1726 isEsc = (== escChar)
1732 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1734 error "wordKeepQuotes: fold done without input"
1736 {-# INLINE processQuoted #-}
1737 processQuoted s a n ql qr = do
1741 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)
1742 FL.Done b -> Done 0 b
1744 {-# INLINE processUnquoted #-}
1745 processUnquoted s a = do
1749 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1750 FL.Done b -> Done 0 b
1752 step (WordQuotedSkipPre s) a
1753 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1754 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1759 then processQuoted s a 1 a qr
1760 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1763 return $ Error "wordKeepQuotes: invalid unquoted char"
1764 | otherwise -> processUnquoted s a
1765 step (WordUnquotedWord s) a
1766 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1769 return $ Partial 0 $ WordQuotedSkipPost b
1774 then processQuoted s a 1 a qr
1775 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1778 then return $ Error "wordKeepQuotes: invalid unquoted char"
1779 else processUnquoted s a
1780 step (WordQuotedWord s n ql qr) a
1781 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr
1783 -- XXX Will this ever occur? Will n ever be 0?
1784 | n == 0 && isSep a = do
1786 return $ Partial 0 $ WordQuotedSkipPost b
1793 then processUnquoted s a
1794 else return $ Continue 0 $ WordUnquotedWord s
1795 else processQuoted s a (n - 1) ql qr
1797 then processQuoted s a (n + 1) ql qr
1798 else processQuoted s a n ql qr
1799 step (WordUnquotedEsc s) a = processUnquoted s a
1800 step (WordQuotedEsc s n ql qr) a =
1803 res <- fstep s escChar
1805 FL.Partial s1 -> processQuoted s1 a n ql qr
1806 FL.Done b -> return $ Done 0 b
1807 Just x -> processQuoted s x n ql qr
1808 step (WordQuotedSkipPost b) a =
1812 else Partial 0 $ WordQuotedSkipPost b
1814 err = return . Error
1816 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1817 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1818 extract (WordQuotedWord s n _ _) =
1820 then fmap (Done 0) $ fextract s
1821 else err "wordWithQuotes: missing frame end"
1822 extract WordQuotedEsc {} =
1823 err "wordWithQuotes: trailing escape"
1824 extract (WordUnquotedEsc _) =
1825 err "wordWithQuotes: trailing escape"
1826 extract (WordQuotedSkipPost b) = return (Done 0 b)
1828-- | 'wordWithQuotes' without processing the quotes and escape function
1829-- supplied to escape the quote char within a quote. Can be used to parse words
1830-- keeping the quotes and escapes intact.
1832-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
1834{-# INLINE wordKeepQuotes #-}
1835wordKeepQuotes :: (Monad m, Eq a) =>
1837 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1838 -> (a -> Bool) -- ^ Matches a word separator?
1842 -- Escape the quote char itself
1843 wordWithQuotes True (\q x -> if q == x then Just x else Nothing)
1845-- See the "Quoting Rules" section in the "bash" manual page for a primer on
1846-- how quotes are used by shells.
1848-- | 'wordWithQuotes' with quote processing applied and escape function
1849-- supplied to escape the quote char within a quote. Can be ysed to parse words
1850-- and processing the quoting and escaping at the same time.
1852-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
1854{-# INLINE wordProcessQuotes #-}
1855wordProcessQuotes :: (Monad m, Eq a) =>
1857 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1858 -> (a -> Bool) -- ^ Matches a word separator?
1862 -- Escape the quote char itself
1863 wordWithQuotes False (\q x -> if q == x then Just x else Nothing)
1865{-# ANN type GroupByState Fuse #-}
1866data GroupByState a s
1868 | GroupByGrouping !a !s
1870-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
1871-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1872-- 'True' @b@ is also assigned to the same group. If @a \`cmp` c@ is 'True'
1873-- then @c@ is also assigned to the same group and so on. When the comparison
1874-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1875-- the result of the fold is the result of the parser.
1877-- * Stops - when the comparison fails.
1882-- Stream.fold Fold.toList
1883-- . Stream.parseMany (Parser.groupBy eq Fold.toList)
1887-- >>> runGroupsBy (<) []
1890-- >>> runGroupsBy (<) [1]
1893-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]
1894-- [Right [3,5,4],Right [1,2],Right [0]]
1896{-# INLINE groupBy #-}
1897groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1898groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1902 {-# INLINE grouper #-}
1907 FL.Done b -> Done 0 b
1908 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1914 FL.Partial s -> IPartial $ GroupByInit s
1915 FL.Done b -> IDone b
1917 step (GroupByInit s) a = grouper s a a
1918 step (GroupByGrouping a0 s) a =
1921 else Done 1 <$> fextract s
1923 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1924 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1926-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
1927-- successive elements in the input stream. Assuming the input stream
1928-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser
1929-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1930-- 'True' @b@ is also assigned to the same group. If @b \`cmp` c@ is 'True'
1931-- then @c@ is also assigned to the same group and so on. When the comparison
1932-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1933-- the result of the fold is the result of the parser.
1935-- * Stops - when the comparison fails.
1939-- runGroupsByRolling eq =
1940-- Stream.fold Fold.toList
1941-- . Stream.parseMany (Parser.groupByRolling eq Fold.toList)
1945-- >>> runGroupsByRolling (<) []
1948-- >>> runGroupsByRolling (<) [1]
1951-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]
1952-- [Right [3,5],Right [4],Right [1,2],Right [0]]
1956{-# INLINE groupByRolling #-}
1957groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1958groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1962 {-# INLINE grouper #-}
1967 FL.Done b -> Done 0 b
1968 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1974 FL.Partial s -> IPartial $ GroupByInit s
1975 FL.Done b -> IDone b
1977 step (GroupByInit s) a = grouper s a
1978 step (GroupByGrouping a0 s) a =
1981 else Done 1 <$> fextract s
1983 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1984 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1986{-# ANN type GroupByStatePair Fuse #-}
1987data GroupByStatePair a s1 s2
1988 = GroupByInitPair !s1 !s2
1989 | GroupByGroupingPair !a !s1 !s2
1990 | GroupByGroupingPairL !a !s1 !s2
1991 | GroupByGroupingPairR !a !s1 !s2
1993-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
1994-- the first fold as long as the predicate holds 'True', if the predicate is
1995-- 'False' collects using the second fold as long as it remains 'False'.
1996-- Returns 'Left' for the first case and 'Right' for the second case.
1998-- For example, if we want to detect sorted sequences in a stream, both
1999-- ascending and descending cases we can use 'groupByRollingEither (<=)
2000-- Fold.toList Fold.toList'.
2003{-# INLINE groupByRollingEither #-}
2004groupByRollingEither :: Monad m =>
2005 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)
2008 (Fold fstep1 finitial1 fextract1)
2009 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
2013 {-# INLINE grouper #-}
2014 grouper s1 s2 a = do
2015 return $ Continue 0 (GroupByGroupingPair a s1 s2)
2017 {-# INLINE grouperL2 #-}
2018 grouperL2 s1 s2 a = do
2022 FL.Done b -> Done 0 (Left b)
2023 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
2025 {-# INLINE grouperL #-}
2026 grouperL s1 s2 a0 a = do
2029 FL.Done b -> return $ Done 0 (Left b)
2030 FL.Partial s11 -> grouperL2 s11 s2 a
2032 {-# INLINE grouperR2 #-}
2033 grouperR2 s1 s2 a = do
2037 FL.Done b -> Done 0 (Right b)
2038 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
2040 {-# INLINE grouperR #-}
2041 grouperR s1 s2 a0 a = do
2044 FL.Done b -> return $ Done 0 (Right b)
2045 FL.Partial s21 -> grouperR2 s1 s21 a
2054 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
2055 FL.Done b -> IDone (Right b)
2056 FL.Done b -> IDone (Left b)
2058 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
2060 step (GroupByGroupingPair a0 s1 s2) a =
2062 then grouperL s1 s2 a0 a
2063 else grouperR s1 s2 a0 a
2065 step (GroupByGroupingPairL a0 s1 s2) a =
2067 then grouperL2 s1 s2 a
2068 else Done 1 . Left <$> fextract1 s1
2070 step (GroupByGroupingPairR a0 s1 s2) a =
2072 then grouperR2 s1 s2 a
2073 else Done 1 . Right <$> fextract2 s2
2075 extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1
2076 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1
2077 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2
2078 extract (GroupByGroupingPair a s1 _) = do
2081 FL.Done b -> return $ Done 0 (Left b)
2082 FL.Partial s11 -> Done 0 . Left <$> fextract1 s11
2084-- XXX use an Unfold instead of a list?
2085-- XXX custom combinators for matching list, array and stream?
2086-- XXX rename to listBy?
2088-- | Match the given sequence of elements using the given comparison function.
2089-- Returns the original sequence if successful.
2093-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs
2097-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"
2100-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
2101-- Left (ParseError "streamEqBy: mismtach occurred")
2103{-# INLINE listEqBy #-}
2104listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
2105listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs
2107listEqBy cmp str = Parser step initial extract
2111 -- XXX Should return IDone in initial for [] case
2112 initial = return $ IPartial str
2114 step [] _ = return $ Done 0 str
2119 else Error "listEqBy: failed, yet to match the last element"
2125 $ "listEqBy: failed, yet to match "
2126 ++ show (length xs + 1) ++ " elements"
2131 $ "listEqBy: end of input, yet to match "
2132 ++ show (length xs) ++ " elements"
2135{-# INLINE streamEqByInternal #-}
2136streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2137streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract
2142 r <- sstep defState state
2144 D.Yield x s -> return $ IPartial (Just' x, s)
2145 D.Stop -> return $ IDone ()
2146 -- Need Skip/Continue in initial to loop right here
2147 D.Skip s -> return $ IPartial (Nothing', s)
2149 step (Just' x, st) a =
2152 r <- sstep defState st
2155 D.Yield x1 s -> Continue 0 (Just' x1, s)
2157 D.Skip s -> Continue 1 (Nothing', s)
2158 else return $ Error "streamEqBy: mismtach occurred"
2159 step (Nothing', st) a = do
2160 r <- sstep defState st
2165 then Continue 0 (Nothing', s)
2166 else Error "streamEqBy: mismatch occurred"
2168 D.Skip s -> Continue 1 (Nothing', s)
2170 extract _ = return $ Error "streamEqBy: end of input"
2172-- | Like 'listEqBy' but uses a stream instead of a list and does not return
2175{-# INLINE streamEqBy #-}
2176streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2177-- XXX Somehow composing this with "*>" is much faster on the microbenchmark.
2178-- Need to investigate why.
2179streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()
2182-- | Match the input sequence with the supplied list and return it if
2185-- >>> listEq = Parser.listEqBy (==)
2187{-# INLINE listEq #-}
2188listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]
2189listEq = listEqBy (==)
2191-- | Match if the input stream is a subsequence of the argument stream i.e. all
2192-- the elements of the input stream occur, in order, in the argument stream.
2193-- The elements do not have to occur consecutively. A sequence is considered a
2194-- subsequence of itself.
2195{-# INLINE subsequenceBy #-}
2196subsequenceBy :: -- Monad m =>
2197 (a -> a -> Bool) -> Stream m a -> Parser a m ()
2198subsequenceBy = undefined
2201-- Should go in Data.Parser.Regex in streamly package so that it can depend on
2203{-# INLINE regexPosix #-}
2204regexPosix :: -- Monad m =>
2205 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2206regexPosix = undefined
2208{-# INLINE regexPCRE #-}
2209regexPCRE :: -- Monad m =>
2210 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2211regexPCRE = undefined
2214-------------------------------------------------------------------------------
2215-- Transformations on input
2216-------------------------------------------------------------------------------
2218-- Initial needs a "Continue" constructor to implement scans on parsers. As a
2219-- parser can always return a Continue in initial when we feed the fold's
2220-- initial result to it. We can work this around for postscan by introducing an
2221-- initial state and calling "initial" only on the first input.
2223-- | Stateful scan on the input of a parser using a Fold.
2227{-# INLINE postscan #-}
2228postscan :: -- Monad m =>
2229 Fold m a b -> Parser b m c -> Parser a m c
2232{-# INLINE zipWithM #-}
2233zipWithM :: Monad m =>
2234 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x
2235zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
2236 Parser step initial extract
2244 r <- sstep defState state
2246 D.Yield x s -> return $ IPartial (Just' x, s, fs)
2250 -- Need Skip/Continue in initial to loop right here
2251 D.Skip s -> return $ IPartial (Nothing', s, fs)
2252 FL.Done x -> return $ IDone x
2254 step (Just' a, st, fs) b = do
2258 FL.Partial fs1 -> do
2259 r <- sstep defState st
2261 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
2265 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
2266 FL.Done x -> return $ Done 0 x
2267 step (Nothing', st, fs) b = do
2268 r <- sstep defState st
2275 return $ Continue 0 (Nothing', s, fs1)
2276 FL.Done x -> return $ Done 0 x
2280 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
2282 extract _ = return $ Error "zipWithM: end of input"
2284-- | Zip the input of a fold with a stream.
2289zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x
2290zip = zipWithM (curry return)
2292-- | Pair each element of a fold input with its index, starting from index 0.
2295{-# INLINE indexed #-}
2296indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b
2297indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
2299-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
2300-- function using a fold indexing function that attaches an index to each input
2301-- element and a filtering function that filters using @(index, element) ->
2302-- Bool) as predicate.
2307-- filterWithIndex = makeIndexFilter indexed filter
2308-- filterWithAbsTime = makeIndexFilter timestamped filter
2309-- filterWithRelTime = makeIndexFilter timeIndexed filter
2313{-# INLINE makeIndexFilter #-}
2315 (Fold m (s, a) b -> Parser a m b)
2316 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
2317 -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)
2318makeIndexFilter f comb g = f . comb g . FL.lmap snd
2320-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
2321-- then every element at strides of @stride@.
2324{-# INLINE sampleFromthen #-}
2325sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
2326sampleFromthen offset size =
2327 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
2329--------------------------------------------------------------------------------
2331--------------------------------------------------------------------------------
2333-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
2334-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
2338-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
2340-- > span_ (< 1) [1,2,3]
2343-- > span_ (< 2) [1,2,3]
2346-- > span_ (< 4) [1,2,3]
2353span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2354span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
2356-- | Break the input stream into two groups, the first group takes the input as
2357-- long as the predicate applied to the first element of the stream and next
2358-- input element holds 'True', the second group takes the rest of the input.
2362{-# INLINE spanBy #-}
2365 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2366spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
2368-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
2369-- predicate is applied to the previous and the next input elements.
2372{-# INLINE spanByRolling #-}
2375 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2376spanByRolling eq f1 f2 =
2377 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
2379-------------------------------------------------------------------------------
2381-------------------------------------------------------------------------------
2383-- | Takes at-most @n@ input elements.
2385-- * Stops - when the collecting parser stops.
2386-- * Fails - when the collecting parser fails.
2388-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2391-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2392-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")
2396takeP :: Monad m => Int -> Parser a m b -> Parser a m b
2397takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
2406 then return $ IPartial $ Tuple' 0 s
2408 IDone b -> return $ IDone b
2409 IError e -> return $ IError e
2411 step (Tuple' cnt r) a = do
2419 then return $ Partial 0 $ Tuple' cnt1 s
2423 Done n b -> Done n b
2424 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2425 Error err -> Error err
2426 Partial _ _ -> error "takeP: Partial in extract"
2431 then return $ Continue 0 $ Tuple' cnt1 s
2435 Done n b -> Done n b
2436 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2437 Error err -> Error err
2438 Partial _ _ -> error "takeP: Partial in extract"
2440 let taken = cnt1 - n
2442 return $ Partial n $ Tuple' taken s
2444 let taken = cnt1 - n
2446 return $ Continue n $ Tuple' taken s
2447 Done n b -> return $ Done n b
2448 Error str -> return $ Error str
2450 extract (Tuple' cnt r) = do
2453 Done n b -> Done n b
2454 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
2455 Error err -> Error err
2456 Partial _ _ -> error "takeP: Partial in extract"
2458 -- XXX Need to make the Initial type Step to remove this
2463 Error err -> IError err
2464 _ -> error "Bug: takeP invalid state in initial"
2466-- | Run a parser without consuming the input.
2468{-# INLINE lookAhead #-}
2469lookAhead :: Monad m => Parser a m b -> Parser a m b
2470lookAhead (Parser step1 initial1 _) = Parser step initial extract
2476 return $ case res of
2477 IPartial s -> IPartial (Tuple'Fused 0 s)
2479 IError e -> IError e
2481 step (Tuple'Fused cnt st) a = do
2486 Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2487 Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2488 Done _ b -> Done cnt1 b
2489 Error err -> Error err
2491 -- XXX returning an error let's us backtrack. To implement it in a way so
2492 -- that it terminates on eof without an error then we need a way to
2493 -- backtrack on eof, that will require extract to return 'Step' type.
2494 extract (Tuple'Fused n _) =
2497 $ "lookAhead: end of input after consuming "
2498 ++ show n ++ " elements"
2500-------------------------------------------------------------------------------
2502-------------------------------------------------------------------------------
2504-- To deinterleave we can chain two parsers one behind the other. The input is
2505-- given to the first parser and the input definitively rejected by the first
2506-- parser is given to the second parser.
2508-- We can either have the parsers themselves buffer the input or use the shared
2509-- global buffer to hold it until none of the parsers need it. When the first
2510-- parser returns Skip (i.e. rewind) we let the second parser consume the
2511-- rejected input and when it is done we move the cursor forward to the first
2512-- parser again. This will require a "move forward" command as well.
2514-- To implement grep we can use three parsers, one to find the pattern, one
2515-- to store the context behind the pattern and one to store the context in
2516-- front of the pattern. When a match occurs we need to emit the accumulator of
2517-- all the three parsers. One parser can count the line numbers to provide the
2520{-# ANN type DeintercalateAllState Fuse #-}
2521data DeintercalateAllState fs sp ss =
2522 DeintercalateAllInitL !fs
2523 | DeintercalateAllL !fs !sp
2524 | DeintercalateAllInitR !fs
2525 | DeintercalateAllR !fs !ss
2527-- XXX rename this to intercalate
2529-- Having deintercalateAll for accepting or rejecting entire input could be
2530-- useful. For example, in case of JSON parsing we get an entire block of
2531-- key-value pairs which we need to verify. This version may be simpler, more
2532-- efficient. We could implement this as a stream operation like parseMany.
2534-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
2535-- example, in case of csv parsing as we are feeding a line to a fold we can
2538-- | Like 'deintercalate' but the entire input must satisfy the pattern
2539-- otherwise the parser fails. This is many times faster than deintercalate.
2541-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2542-- >>> p2 = Parser.satisfy (== '+')
2543-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
2544-- >>> Stream.parse p $ Stream.fromList ""
2546-- >>> Stream.parse p $ Stream.fromList "1"
2548-- >>> Stream.parse p $ Stream.fromList "1+"
2549-- Left (ParseError "takeWhile1: end of input")
2550-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2551-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2553{-# INLINE deintercalateAll #-}
2554deintercalateAll :: Monad m =>
2557 -> Fold m (Either x y) z
2560 (Parser stepL initialL extractL)
2561 (Parser stepR initialR _)
2562 (Fold fstep finitial fextract) = Parser step initial extract
2567 error $ "deintercalate: " ++ p ++ " parser cannot "
2568 ++ status ++ " without input"
2573 FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2574 FL.Done c -> return $ IDone c
2576 {-# INLINE processL #-}
2577 processL foldAction n nextState = do
2580 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2581 FL.Done c -> return $ Done n c
2583 {-# INLINE runStepL #-}
2584 runStepL fs sL a = do
2587 Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2588 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2590 processL (fstep fs (Left b)) n DeintercalateAllInitR
2591 Error err -> return $ Error err
2593 {-# INLINE processR #-}
2594 processR foldAction n = do
2597 FL.Partial fs1 -> do
2600 IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
2601 IDone _ -> errMsg "left" "succeed"
2602 IError _ -> errMsg "left" "fail"
2603 FL.Done c -> return $ Done n c
2605 {-# INLINE runStepR #-}
2606 runStepR fs sR a = do
2609 Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2610 Continue n s -> return $ Continue n (DeintercalateAllR fs s)
2611 Done n b -> processR (fstep fs (Right b)) n
2612 Error err -> return $ Error err
2614 step (DeintercalateAllInitL fs) a = do
2617 IPartial s -> runStepL fs s a
2618 IDone _ -> errMsg "left" "succeed"
2619 IError _ -> errMsg "left" "fail"
2620 step (DeintercalateAllL fs sL) a = runStepL fs sL a
2621 step (DeintercalateAllInitR fs) a = do
2624 IPartial s -> runStepR fs s a
2625 IDone _ -> errMsg "right" "succeed"
2626 IError _ -> errMsg "right" "fail"
2627 step (DeintercalateAllR fs sR) a = runStepR fs sR a
2629 {-# INLINE extractResult #-}
2630 extractResult n fs r = do
2633 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2634 FL.Done c -> return (Done n c)
2635 extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs
2636 extract (DeintercalateAllL fs sL) = do
2639 Done n b -> extractResult n fs (Left b)
2640 Error err -> return $ Error err
2641 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2642 Partial _ _ -> error "Partial in extract"
2643 extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs
2644 extract (DeintercalateAllR _ _) =
2645 return $ Error "deintercalateAll: input ended at 'Right' value"
2647{-# ANN type DeintercalateState Fuse #-}
2648data DeintercalateState b fs sp ss =
2649 DeintercalateInitL !fs
2650 | DeintercalateL !Int !fs !sp
2651 | DeintercalateInitR !fs
2652 | DeintercalateR !Int !fs !ss
2653 | DeintercalateRL !Int !b !fs !sp
2655-- XXX Add tests that the next character that we take after running a parser is
2656-- correct. Especially for the parsers that maintain a count. In the stream
2657-- finished case (extract) as well as not finished case.
2659-- | Apply two parsers alternately to an input stream. The input stream is
2660-- considered an interleaving of two patterns. The two parsers represent the
2661-- two patterns. Parsing starts at the first parser and stops at the first
2662-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2663-- input or single parse of the first parser is accepted.
2665-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2666-- >>> p2 = Parser.satisfy (== '+')
2667-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2668-- >>> Stream.parse p $ Stream.fromList ""
2670-- >>> Stream.parse p $ Stream.fromList "1"
2672-- >>> Stream.parse p $ Stream.fromList "1+"
2674-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2675-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2677{-# INLINE deintercalate #-}
2678deintercalate :: Monad m =>
2681 -> Fold m (Either x y) z
2684 (Parser stepL initialL extractL)
2685 (Parser stepR initialR _)
2686 (Fold fstep finitial fextract) = Parser step initial extract
2691 error $ "deintercalate: " ++ p ++ " parser cannot "
2692 ++ status ++ " without input"
2697 FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2698 FL.Done c -> return $ IDone c
2700 {-# INLINE processL #-}
2701 processL foldAction n nextState = do
2704 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2705 FL.Done c -> return $ Done n c
2707 {-# INLINE runStepL #-}
2708 runStepL cnt fs sL a = do
2712 Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2713 Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2715 processL (fstep fs (Left b)) n DeintercalateInitR
2718 return $ Done cnt1 xs
2720 {-# INLINE processR #-}
2721 processR cnt b fs n = do
2724 IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2725 IDone _ -> errMsg "left" "succeed"
2726 IError _ -> errMsg "left" "fail"
2728 {-# INLINE runStepR #-}
2729 runStepR cnt fs sR a = do
2733 Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2734 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2735 Done n b -> processR (cnt1 - n) b fs n
2738 return $ Done cnt1 xs
2740 step (DeintercalateInitL fs) a = do
2743 IPartial s -> runStepL 0 fs s a
2744 IDone _ -> errMsg "left" "succeed"
2745 IError _ -> errMsg "left" "fail"
2746 step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2747 step (DeintercalateInitR fs) a = do
2750 IPartial s -> runStepR 0 fs s a
2751 IDone _ -> errMsg "right" "succeed"
2752 IError _ -> errMsg "right" "fail"
2753 step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2754 step (DeintercalateRL cnt bR fs sL) a = do
2758 Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2759 Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2761 res <- fstep fs (Right bR)
2763 FL.Partial fs1 -> do
2764 fres <- fstep fs1 (Left bL)
2767 return $ Partial n (DeintercalateInitR fs2)
2768 FL.Done c -> return $ Done n c
2769 -- XXX We could have the fold accept pairs of (bR, bL)
2770 FL.Done _ -> error "Fold terminated consuming partial input"
2773 return $ Done cnt1 xs
2775 {-# INLINE extractResult #-}
2776 extractResult n fs r = do
2779 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2780 FL.Done c -> return (Done n c)
2782 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs
2783 extract (DeintercalateL cnt fs sL) = do
2786 Done n b -> extractResult n fs (Left b)
2787 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2788 Partial _ _ -> error "Partial in extract"
2791 return $ Done cnt xs
2792 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs
2793 extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs
2794 extract (DeintercalateRL cnt bR fs sL) = do
2798 res <- fstep fs (Right bR)
2800 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2801 FL.Done _ -> error "Fold terminated consuming partial input"
2802 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2803 Partial _ _ -> error "Partial in extract"
2806 return $ Done cnt xs
2808{-# ANN type Deintercalate1State Fuse #-}
2809data Deintercalate1State b fs sp ss =
2810 Deintercalate1InitL !Int !fs !sp
2811 | Deintercalate1InitR !fs
2812 | Deintercalate1R !Int !fs !ss
2813 | Deintercalate1RL !Int !b !fs !sp
2815-- | Apply two parsers alternately to an input stream. The input stream is
2816-- considered an interleaving of two patterns. The two parsers represent the
2817-- two patterns. Parsing starts at the first parser and stops at the first
2818-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2819-- input or single parse of the first parser is accepted.
2821-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2822-- >>> p2 = Parser.satisfy (== '+')
2823-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2824-- >>> Stream.parse p $ Stream.fromList ""
2825-- Left (ParseError "takeWhile1: end of input")
2826-- >>> Stream.parse p $ Stream.fromList "1"
2828-- >>> Stream.parse p $ Stream.fromList "1+"
2830-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2831-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2833{-# INLINE deintercalate1 #-}
2834deintercalate1 :: Monad m =>
2837 -> Fold m (Either x y) z
2840 (Parser stepL initialL extractL)
2841 (Parser stepR initialR _)
2842 (Fold fstep finitial fextract) = Parser step initial extract
2847 error $ "deintercalate: " ++ p ++ " parser cannot "
2848 ++ status ++ " without input"
2856 IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2857 IDone _ -> errMsg "left" "succeed"
2858 IError _ -> errMsg "left" "fail"
2859 FL.Done c -> return $ IDone c
2861 {-# INLINE processL #-}
2862 processL foldAction n nextState = do
2865 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2866 FL.Done c -> return $ Done n c
2868 {-# INLINE runStepInitL #-}
2869 runStepInitL cnt fs sL a = do
2873 Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2874 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2876 processL (fstep fs (Left b)) n Deintercalate1InitR
2877 Error err -> return $ Error err
2879 {-# INLINE processR #-}
2880 processR cnt b fs n = do
2883 IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2884 IDone _ -> errMsg "left" "succeed"
2885 IError _ -> errMsg "left" "fail"
2887 {-# INLINE runStepR #-}
2888 runStepR cnt fs sR a = do
2892 Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2893 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2894 Done n b -> processR (cnt1 - n) b fs n
2897 return $ Done cnt1 xs
2899 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2900 step (Deintercalate1InitR fs) a = do
2903 IPartial s -> runStepR 0 fs s a
2904 IDone _ -> errMsg "right" "succeed"
2905 IError _ -> errMsg "right" "fail"
2906 step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2907 step (Deintercalate1RL cnt bR fs sL) a = do
2911 Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2912 Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2914 res <- fstep fs (Right bR)
2916 FL.Partial fs1 -> do
2917 fres <- fstep fs1 (Left bL)
2920 return $ Partial n (Deintercalate1InitR fs2)
2921 FL.Done c -> return $ Done n c
2922 -- XXX We could have the fold accept pairs of (bR, bL)
2923 FL.Done _ -> error "Fold terminated consuming partial input"
2926 return $ Done cnt1 xs
2928 {-# INLINE extractResult #-}
2929 extractResult n fs r = do
2932 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2933 FL.Done c -> return (Done n c)
2935 extract (Deintercalate1InitL cnt fs sL) = do
2938 Done n b -> extractResult n fs (Left b)
2939 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2940 Partial _ _ -> error "Partial in extract"
2941 Error err -> return $ Error err
2942 extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2943 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2944 extract (Deintercalate1RL cnt bR fs sL) = do
2948 res <- fstep fs (Right bR)
2950 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2951 FL.Done _ -> error "Fold terminated consuming partial input"
2952 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2953 Partial _ _ -> error "Partial in extract"
2956 return $ Done cnt xs
2958{-# ANN type SepByState Fuse #-}
2959data SepByState fs sp ss =
2961 | SepByL !Int !fs !sp
2963 | SepByR !Int !fs !ss
2965-- | Apply two parsers alternately to an input stream. Parsing starts at the
2966-- first parser and stops at the first parser. The output of the first parser
2967-- is emiited and the output of the second parser is discarded. It can be used
2968-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
2969-- of the first parser is accepted.
2973-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
2974-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)
2978-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2979-- >>> p2 = Parser.satisfy (== '+')
2980-- >>> p = Parser.sepBy p1 p2 Fold.toList
2981-- >>> Stream.parse p $ Stream.fromList ""
2983-- >>> Stream.parse p $ Stream.fromList "1"
2985-- >>> Stream.parse p $ Stream.fromList "1+"
2987-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2988-- Right ["1","2","3"]
2992 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
2993-- This has similar performance as the custom impl below.
2994-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
2996 (Parser stepL initialL extractL)
2997 (Parser stepR initialR _)
2998 (Fold fstep finitial fextract) = Parser step initial extract
3003 error $ "sepBy: " ++ p ++ " parser cannot "
3004 ++ status ++ " without input"
3009 FL.Partial fs -> return $ IPartial $ SepByInitL fs
3010 FL.Done c -> return $ IDone c
3012 {-# INLINE processL #-}
3013 processL foldAction n nextState = do
3016 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3017 FL.Done c -> return $ Done n c
3019 {-# INLINE runStepL #-}
3020 runStepL cnt fs sL a = do
3024 Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3025 Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3027 processL (fstep fs b) n SepByInitR
3030 return $ Done cnt1 xs
3032 {-# INLINE processR #-}
3033 processR cnt fs n = do
3036 IPartial ps -> return $ Continue n (SepByL cnt fs ps)
3037 IDone _ -> errMsg "left" "succeed"
3038 IError _ -> errMsg "left" "fail"
3040 {-# INLINE runStepR #-}
3041 runStepR cnt fs sR a = do
3045 Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3046 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3047 Done n _ -> processR (cnt1 - n) fs n
3050 return $ Done cnt1 xs
3052 step (SepByInitL fs) a = do
3055 IPartial s -> runStepL 0 fs s a
3056 IDone _ -> errMsg "left" "succeed"
3057 IError _ -> errMsg "left" "fail"
3058 step (SepByL cnt fs sL) a = runStepL cnt fs sL a
3059 step (SepByInitR fs) a = do
3062 IPartial s -> runStepR 0 fs s a
3063 IDone _ -> errMsg "right" "succeed"
3064 IError _ -> errMsg "right" "fail"
3065 step (SepByR cnt fs sR) a = runStepR cnt fs sR a
3067 {-# INLINE extractResult #-}
3068 extractResult n fs r = do
3071 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3072 FL.Done c -> return (Done n c)
3074 extract (SepByInitL fs) = fmap (Done 0) $ fextract fs
3075 extract (SepByL cnt fs sL) = do
3078 Done n b -> extractResult n fs b
3079 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
3080 Partial _ _ -> error "Partial in extract"
3083 return $ Done cnt xs
3084 extract (SepByInitR fs) = fmap (Done 0) $ fextract fs
3085 extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs
3087-- | Non-backtracking version of sepBy. Several times faster.
3088{-# INLINE sepByAll #-}
3089sepByAll :: Monad m =>
3090 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3091sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)
3093-- XXX This can be implemented using refold, parse one and then continue
3094-- collecting the rest in that.
3096{-# ANN type SepBy1State Fuse #-}
3097data SepBy1State fs sp ss =
3098 SepBy1InitL !Int !fs sp
3099 | SepBy1L !Int !fs !sp
3101 | SepBy1R !Int !fs !ss
3104{-# INLINE sepBy1 #-}
3106 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3107sepBy1 p sep sink = do
3109 f <- fromEffect $ FL.reduce sink
3110 f1 <- fromEffect $ FL.snoc f x
3114-- | Like 'sepBy' but requires at least one successful parse.
3118-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
3122-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3123-- >>> p2 = Parser.satisfy (== '+')
3124-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
3125-- >>> Stream.parse p $ Stream.fromList ""
3126-- Left (ParseError "takeWhile1: end of input")
3127-- >>> Stream.parse p $ Stream.fromList "1"
3129-- >>> Stream.parse p $ Stream.fromList "1+"
3131-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3132-- Right ["1","2","3"]
3134{-# INLINE sepBy1 #-}
3136 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3138 (Parser stepL initialL extractL)
3139 (Parser stepR initialR _)
3140 (Fold fstep finitial fextract) = Parser step initial extract
3145 error $ "sepBy: " ++ p ++ " parser cannot "
3146 ++ status ++ " without input"
3154 IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
3155 IDone _ -> errMsg "left" "succeed"
3156 IError _ -> errMsg "left" "fail"
3157 FL.Done c -> return $ IDone c
3159 {-# INLINE processL #-}
3160 processL foldAction n nextState = do
3163 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3164 FL.Done c -> return $ Done n c
3166 {-# INLINE runStepInitL #-}
3167 runStepInitL cnt fs sL a = do
3171 Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3172 Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3174 processL (fstep fs b) n SepBy1InitR
3175 Error err -> return $ Error err
3177 {-# INLINE runStepL #-}
3178 runStepL cnt fs sL a = do
3182 Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3183 Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3185 processL (fstep fs b) n SepBy1InitR
3188 return $ Done cnt1 xs
3190 {-# INLINE processR #-}
3191 processR cnt fs n = do
3194 IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3195 IDone _ -> errMsg "left" "succeed"
3196 IError _ -> errMsg "left" "fail"
3198 {-# INLINE runStepR #-}
3199 runStepR cnt fs sR a = do
3203 Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3204 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3205 Done n _ -> processR (cnt1 - n) fs n
3208 return $ Done cnt1 xs
3210 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3211 step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3212 step (SepBy1InitR fs) a = do
3215 IPartial s -> runStepR 0 fs s a
3216 IDone _ -> errMsg "right" "succeed"
3217 IError _ -> errMsg "right" "fail"
3218 step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3220 {-# INLINE extractResult #-}
3221 extractResult n fs r = do
3224 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3225 FL.Done c -> return (Done n c)
3227 extract (SepBy1InitL cnt fs sL) = do
3230 Done n b -> extractResult n fs b
3231 Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3232 Partial _ _ -> error "Partial in extract"
3233 Error err -> return $ Error err
3234 extract (SepBy1L cnt fs sL) = do
3237 Done n b -> extractResult n fs b
3238 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3239 Partial _ _ -> error "Partial in extract"
3242 return $ Done cnt xs
3243 extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs
3244 extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs
3246-------------------------------------------------------------------------------
3247-- Interleaving a collection of parsers
3248-------------------------------------------------------------------------------
3250-- | Apply a collection of parsers to an input stream in a round robin fashion.
3251-- Each parser is applied until it stops and then we repeat starting with the
3252-- the first parser again.
3256{-# INLINE roundRobin #-}
3257roundRobin :: -- (Foldable t, Monad m) =>
3258 t (Parser a m b) -> Fold m b c -> Parser a m c
3259roundRobin _ps _f = undefined
3261-------------------------------------------------------------------------------
3262-- Sequential Collection
3263-------------------------------------------------------------------------------
3265-- | @sequence f p@ collects sequential parses of parsers in a
3266-- serial stream @p@ using the fold @f@. Fails if the input ends or any
3267-- of the parsers fail.
3271{-# INLINE sequence #-}
3272sequence :: Monad m =>
3273 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c
3274sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
3275 Parser step initial extract
3282 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
3283 FL.Done c -> return $ IDone c
3285 -- state does not contain any parser
3286 -- yield a new parser from the stream
3287 step (Nothing', ss, fs) _ = do
3288 sres <- sstep defState ss
3290 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
3294 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
3296 -- state holds a parser that may or may not have been
3297 -- initialized. pinit holds the initial parser state
3298 -- or modified parser state respectively
3299 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
3307 Just' $ Parser pstep (return $ IPartial ps2) pextr
3308 in return $ Partial n (newP, ss, fs)
3311 Just' $ Parser pstep (return $ IPartial ps2) pextr
3312 in return $ Continue n (newP, ss, fs)
3317 return $ Partial n (Nothing', ss, fs1)
3318 FL.Done c -> return $ Done n c
3319 Error msg -> return $ Error msg
3324 return $ Partial 1 (Nothing', ss, fs1)
3325 FL.Done c -> return $ Done 1 c
3326 IError err -> return $ Error err
3328 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
3329 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
3338 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3339 FL.Done c -> return (Done n c)
3340 Error err -> return $ Error err
3341 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
3342 Partial _ _ -> error "Partial in extract"
3346 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
3347 FL.Done c -> return (Done 0 c)
3348 IError err -> return $ Error err
3350-------------------------------------------------------------------------------
3351-- Alternative Collection
3352-------------------------------------------------------------------------------
3355-- | @choice parsers@ applies the @parsers@ in order and returns the first
3358-- This is same as 'asum' but more efficient.
3362{-# INLINE choice #-}
3363choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b
3364choice = foldl1 shortest
3367-------------------------------------------------------------------------------
3368-- Sequential Repetition
3369-------------------------------------------------------------------------------
3371-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the
3372-- results. Parsing stops or fails if the collecting parser stops or fails.
3377manyP :: -- MonadCatch m =>
3378 Parser a m b -> Parser b m c -> Parser a m c
3379manyP _p _f = undefined
3381-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
3382-- input stream and push the parse results to a downstream fold.
3384-- Stops: when the downstream fold stops or the parser fails.
3385-- Fails: never, produces zero or more results.
3387-- >>> many = Parser.countBetween 0 maxBound
3389-- Compare with 'Control.Applicative.many'.
3392many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3394-- many = countBetween 0 maxBound
3396-- Note: many1 would perhaps be a better name for this and consistent with
3397-- other names like takeWhile1. But we retain the name "some" for
3400-- | Collect one or more parses. Apply the supplied parser repeatedly on the
3401-- input stream and push the parse results to a downstream fold.
3403-- Stops: when the downstream fold stops or the parser fails.
3404-- Fails: if it stops without producing a single result.
3406-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)
3407-- >>> some = Parser.countBetween 1 maxBound
3409-- Compare with 'Control.Applicative.some'.
3412some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3414-- some p f = manyP p (takeGE 1 f)
3415-- some = countBetween 1 maxBound
3417-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
3418-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
3419-- the input ends or the parser fails before @m@ results are collected.
3421-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)
3425{-# INLINE countBetween #-}
3426countBetween :: -- MonadCatch m =>
3427 Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
3428countBetween _m _n _p = undefined
3429-- countBetween m n p f = manyP p (takeBetween m n f)
3431-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
3432-- the fold @f@. Fails if the input ends or the parser fails before @n@
3433-- results are collected.
3435-- >>> count n = Parser.countBetween n n
3436-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)
3441count :: -- MonadCatch m =>
3442 Int -> Parser a m b -> Fold m b c -> Parser a m c
3443count n = countBetween n n
3444-- count n p f = manyP p (takeEQ n f)
3446-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a
3447-- 'Fold'. Parsing stops or fails if the collecting parser stops or fails.
3449-- We can implemnent parsers like the following using 'manyTillP':
3452-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p
3457{-# INLINE manyTillP #-}
3458manyTillP :: -- Monad m =>
3459 Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
3460manyTillP _p1 _p2 _f = undefined
3461 -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f
3463{-# ANN type ManyTillState Fuse #-}
3464data ManyTillState fs sr sl
3465 = ManyTillR !Int !fs !sr
3468-- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@
3469-- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is
3470-- tried again and so on. The parser stops when @test@ succeeds. The output of
3471-- @test@ is discarded and the output of @chunking@ is accumulated by the
3472-- supplied fold. The parser fails if @chunking@ fails.
3474-- Stops when the fold @f@ stops.
3476{-# INLINE manyTill #-}
3478 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3479manyTill (Parser stepL initialL extractL)
3480 (Parser stepR initialR _)
3481 (Fold fstep finitial fextract) =
3482 Parser step initial extract
3486 -- Caution: Mutual recursion
3488 scrutL fs p c d e = do
3491 IPartial sl -> return $ c (ManyTillL fs sl)
3495 FL.Partial fs1 -> scrutR fs1 p c d e
3496 FL.Done fb -> return $ d fb
3497 IError err -> return $ e err
3499 scrutR fs p c d e = do
3502 IPartial sr -> return $ p (ManyTillR 0 fs sr)
3503 IDone _ -> d <$> fextract fs
3504 IError _ -> scrutL fs p c d e
3509 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
3510 FL.Done b -> return $ IDone b
3512 step (ManyTillR cnt fs st) a = do
3515 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
3517 assertM(cnt + 1 - n >= 0)
3518 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
3526 return $ Continue (cnt + 1) (ManyTillL fs sl)
3538 FL.Done fb -> return $ Done cnt1 fb
3539 IError err -> return $ Error err
3540 step (ManyTillL fs st) a = do
3543 Partial n s -> return $ Partial n (ManyTillL fs s)
3544 Continue n s -> return $ Continue n (ManyTillL fs s)
3549 scrutR s (Partial n) (Continue n) (Done n) Error
3550 FL.Done b1 -> return $ Done n b1
3551 Error err -> return $ Error err
3553 extract (ManyTillL fs sR) = do
3559 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3560 FL.Done c -> return (Done n c)
3561 Error err -> return $ Error err
3562 Continue n s -> return $ Continue n (ManyTillL fs s)
3563 Partial _ _ -> error "Partial in extract"
3564 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs
3566-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
3567-- collects the output in the supplied fold. If the the parser @collect@ fails,
3568-- parser @recover@ is run until it stops and then we start repeating the
3569-- parser @collect@ again. The parser fails if the recovery parser fails.
3571-- For example, this can be used to find a key frame in a video stream after an
3576{-# INLINE manyThen #-}
3577manyThen :: -- (Foldable t, Monad m) =>
3578 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3579manyThen _parser _recover _f = undefined
3581-------------------------------------------------------------------------------
3582-- Repeated Alternatives
3583-------------------------------------------------------------------------------
3585-- | Keep trying a parser up to a maximum of @n@ failures. When the parser
3586-- fails the input consumed till now is dropped and the new instance is tried
3587-- on the fresh input.
3591{-# INLINE retryMaxTotal #-}
3592retryMaxTotal :: -- (Monad m) =>
3593 Int -> Parser a m b -> Fold m b c -> Parser a m c
3594retryMaxTotal _n _p _f = undefined
3596-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.
3600{-# INLINE retryMaxSuccessive #-}
3601retryMaxSuccessive :: -- (Monad m) =>
3602 Int -> Parser a m b -> Fold m b c -> Parser a m c
3603retryMaxSuccessive _n _p _f = undefined
3605-- | Keep trying a parser until it succeeds. When the parser fails the input
3606-- consumed till now is dropped and the new instance is tried on the fresh
3612retry :: -- (Monad m) =>
3613 Parser a m b -> Parser a m b
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list