2-- Module : Streamly.Internal.Data.Parser.ParserD
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
9-- Fast backtracking parsers with stream fusion and native streaming
12-- 'Applicative' and 'Control.Applicative.Alternative' type class based
13-- combinators from the
14-- <http://hackage.haskell.org/package/parser-combinators parser-combinators>
15-- package can also be used with the 'Parser' type. However, there are two
16-- important differences between @parser-combinators@ and the equivalent ones
17-- provided in this module in terms of performance:
19-- 1) @parser-combinators@ use plain Haskell lists to collect the results, in a
20-- strict Monad like IO, the results are necessarily buffered before they can
21-- be consumed. This may not perform optimally in streaming applications
22-- processing large amounts of data. Equivalent combinators in this module can
23-- consume the results of parsing using a 'Fold', thus providing a scalability
24-- and a composable consumer.
26-- 2) Several combinators in this module can be many times faster because of
27-- stream fusion. For example, 'Streamly.Internal.Data.Parser.many' combinator
28-- in this module is much faster than the 'Control.Applicative.many' combinator
29-- of 'Control.Applicative.Alternative' type class.
33-- Failing parsers in this module throw the 'D.ParseError' exception.
37-- As far as possible, try that the names of the combinators in this module are
40-- * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>
41-- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>
42-- * <http://hackage.haskell.org/package/megaparsec megaparsec>
43-- * <http://hackage.haskell.org/package/attoparsec attoparsec>
44-- * <http://hackage.haskell.org/package/parsec parsec>
46module Streamly.Internal.Data.Parser.ParserD
53 -- * Downgrade to Fold
56 -- First order parsers
77 -- All of these can be expressed in terms of either
88 -- * Sequence parsers (tokenizers)
90 -- | Parsers chained in series, if one parser terminates the composition
91 -- terminates. Currently we are using folds to collect the output of the
92 -- parsers but we can use Parsers instead of folds to make the composition
93 -- more powerful. For example, we can do:
95 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
96 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
97 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
101 -- | Grab a sequence of input elements without inspecting them
103 -- , take -- takeBetween 0 n
104 , takeEQ -- takeBetween n n
105 , takeGE -- takeBetween n maxBound
106 -- , takeGE1 -- take1 -- takeBetween 1 n
109 -- Grab a sequence of input elements by inspecting them
122 -- ** Separated by elements
123 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
124 -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
125 -- separator parsing, also see 'intersperseQuotedBy' fold.
127 -- These can be implemented modularly with refolds, using takeWhile and
138 -- ** Grouped by element comparison
141 , groupByRollingEither
143 -- ** Framed by elements
144 -- | Also see 'intersperseQuotedBy' fold.
145 -- Framed by a one or more ocurrences of a separator around a word like
146 -- spaces or quotes. No nesting.
147 , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
152 -- Framed by separate start and end characters, potentially nested.
153 -- blockWithQuotes allows quotes inside a block. However,
154 -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and
155 -- block with escaping.
159 , takeFramedByGeneric
163 -- , prefixOf -- match any prefix of a given string
164 -- , suffixOf -- match any suffix of a given string
165 -- , infixOf -- match any substring of a given string
172 -- Second order parsers (parsers using parsers)
173 -- * Binary Combinators
175 -- ** Sequential Applicative
180 -- ** Parallel Applicatives
184 -- , teeTill -- like manyTill but parallel
187 -- ** Sequential Alternative
191 -- ** Parallel Alternatives
197 -- * N-ary Combinators
198 -- ** Sequential Collection
202 -- ** Sequential Repetition
205 -- , countBetweenTill
210 -- ** Interleaved Repetition
211 -- Use two folds, run a primary parser, its rejected values go to the
216 -- , deintercalatePrefix
217 -- , deintercalateSuffix
220 -- | TODO: traditional implmentations of these may be of limited use. For
221 -- example, consider parsing lines separated by @\\r\\n@. The main parser
222 -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
223 -- can apply the "sep" parser.
225 -- We can instead implement these as special cases of deintercalate.
244 -- A simple and stupid impl would be to just convert the stream to an array
245 -- and give the array reference to all consumers. The array can be grown on
246 -- demand by any consumer and truncated when nonbody needs it.
248 -- -- ** Distribute to collection
249 -- -- ** Distribute to repetition
251 -- ** Interleaved collection
258 -- -- ** Interleaved repetition
259 -- repeat one parser and when it fails run an error recovery parser
260 -- e.g. to find a key frame in the stream after an error
262 -- ** Collection of Alternatives
268 -- , fastestN -- first N successful in time
269 -- , choiceN -- first N successful in position
271 -- , choice -- first successful in position
273 -- ** Repeated Alternatives
293import Control.Monad (when)
294import Data.Bifunctor (first)
295import Fusion.Plugin.Types (Fuse(..))
296import Streamly.Internal.Data.Fold.Type (Fold(..))
297import Streamly.Internal.Data.SVar.Type (defState)
298import Streamly.Internal.Data.Either.Strict (Either'(..))
299import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
300import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
301import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
303import qualified Data.Foldable as Foldable
304import qualified Streamly.Internal.Data.Fold.Type as FL
305import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
306import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
309 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
310 , zip, filter, dropWhile)
311-- import Streamly.Internal.Data.Parser.ParserD.Tee
312import Streamly.Internal.Data.Parser.ParserD.Type
317-- >>> import Prelude hiding ()
318-- >>> import Control.Applicative
319-- >>> import Data.Char (isSpace)
320-- >>> import qualified Data.Foldable as Foldable
321-- >>> import qualified Data.Maybe as Maybe
322-- >>> import qualified Streamly.Data.Stream as Stream
323-- >>> import qualified Streamly.Internal.Data.Stream as Stream
324-- >>> import qualified Streamly.Internal.Data.Fold as Fold
325-- >>> import qualified Streamly.Internal.Data.Parser as Parser
327-------------------------------------------------------------------------------
328-- Downgrade a parser to a Fold
329-------------------------------------------------------------------------------
331-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the
332-- parser fails or tries to backtrack.
334-- This can be useful in combinators that accept a Fold and we know that a
335-- Parser cannot fail or failure exception is acceptable as there is no way to
341toFold :: Monad m => Parser a m b -> Fold m a b
342toFold (Parser pstep pinitial pextract) = Fold step initial extract
349 IPartial s -> return $ FL.Partial s
350 IDone b -> return $ FL.Done b
352 error $ "toFold: parser throws error in initial" ++ err
354 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
355 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
356 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
357 eerror err = error $ "toFold: parser throws error: " ++ err
362 Partial 0 s -> return $ FL.Partial s
363 Continue 0 s -> return $ FL.Partial s
364 Done 0 b -> return $ FL.Done b
365 Partial n _ -> perror n
366 Continue n _ -> cerror n
368 Error err -> eerror err
374 Partial n _ -> perror n
375 Continue n _ -> cerror n
377 Error err -> eerror err
379-------------------------------------------------------------------------------
380-- Upgrade folds to parses
381-------------------------------------------------------------------------------
383-- | Make a 'Parser' from a 'Fold'.
385{-# INLINE fromFold #-}
386fromFold :: Monad m => Fold m a b -> Parser a m b
387fromFold (Fold fstep finitial fextract) = Parser step initial extract
395 FL.Partial s1 -> IPartial s1
402 FL.Partial s1 -> Partial 0 s1
403 FL.Done b -> Done 0 b
405 extract = fmap (Done 0) . fextract
407-- | Convert a Maybe returning fold to an error returning parser. The first
408-- argument is the error message that the parser would return when the fold
413{-# INLINE fromFoldMaybe #-}
414fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b
415fromFoldMaybe errMsg (Fold fstep finitial fextract) =
416 Parser step initial extract
424 FL.Partial s1 -> IPartial s1
428 Nothing -> IError errMsg
434 FL.Partial s1 -> Partial 0 s1
438 Nothing -> Error errMsg
443 Just x -> return $ Done 0 x
444 Nothing -> return $ Error errMsg
446-------------------------------------------------------------------------------
448-------------------------------------------------------------------------------
450-- | Peek the head element of a stream, without consuming it. Fails if it
451-- encounters end of input.
453-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]
457-- peek = lookAhead (satisfy True)
461peek :: Monad m => Parser a m a
462peek = Parser step initial extract
466 initial = return $ IPartial ()
468 step () a = return $ Done 1 a
470 extract () = return $ Error "peek: end of input"
472-- | Succeeds if we are at the end of input, fails otherwise.
474-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]
478eof :: Monad m => Parser a m ()
479eof = Parser step initial extract
483 initial = return $ IPartial ()
485 step () _ = return $ Error "eof: not at end of input"
487 extract () = return $ Done 0 ()
489-- | Return the next element of the input. Returns 'Nothing'
490-- on end of input. Also known as 'head'.
494{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}
496next :: Monad m => Parser a m (Maybe a)
497next = Parser step initial extract
501 initial = pure $ IPartial ()
503 step () a = pure $ Done 0 (Just a)
505 extract () = pure $ Done 0 Nothing
507-- | Map an 'Either' returning function on the next element in the stream. If
508-- the function returns 'Left err', the parser fails with the error message
509-- @err@ otherwise returns the 'Right' value.
514either :: Monad m => (a -> Either String b) -> Parser a m b
515either f = Parser step initial extract
519 initial = return $ IPartial ()
524 Left err -> Error err
526 extract () = return $ Error "end of input"
528-- | Map a 'Maybe' returning function on the next element in the stream. The
529-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
532-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
533-- >>> maybe f = Parser.either (toEither . f)
535-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)
540maybe :: Monad m => (a -> Maybe b) -> Parser a m b
541-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
542maybe parserF = Parser step initial extract
546 initial = return $ IPartial ()
551 Nothing -> Error "maybe: predicate failed"
553 extract () = return $ Error "maybe: end of input"
555-- | Returns the next element if it passes the predicate, fails otherwise.
557-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]
560-- >>> toMaybe f x = if f x then Just x else Nothing
561-- >>> satisfy f = Parser.maybe (toMaybe f)
563{-# INLINE satisfy #-}
564satisfy :: Monad m => (a -> Bool) -> Parser a m a
565-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
566satisfy predicate = Parser step initial extract
570 initial = return $ IPartial ()
575 else Error "satisfy: predicate failed"
577 extract () = return $ Error "satisfy: end of input"
579-- | Consume one element from the head of the stream. Fails if it encounters
582-- >>> one = Parser.satisfy $ const True
585one :: Monad m => Parser a m a
586one = satisfy $ const True
588-- Alternate names: "only", "onlyThis".
590-- | Match a specific element.
592-- >>> oneEq x = Parser.satisfy (== x)
595oneEq :: (Monad m, Eq a) => a -> Parser a m a
596oneEq x = satisfy (== x)
598-- Alternate names: "exclude", "notThis".
600-- | Match anything other than the supplied element.
602-- >>> oneNotEq x = Parser.satisfy (/= x)
604{-# INLINE oneNotEq #-}
605oneNotEq :: (Monad m, Eq a) => a -> Parser a m a
606oneNotEq x = satisfy (/= x)
608-- | Match any one of the elements in the supplied list.
610-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)
612-- When performance matters a pattern matching predicate could be more
613-- efficient than a 'Foldable' datatype:
624-- GHC may use a binary search instead of linear search in the list.
625-- Alternatively, you can also use an array instead of list for storage and
629oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
630oneOf xs = satisfy (`Foldable.elem` xs)
632-- | See performance notes in 'oneOf'.
634-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)
637noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
638noneOf xs = satisfy (`Foldable.notElem` xs)
640-------------------------------------------------------------------------------
642-------------------------------------------------------------------------------
644-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
645{-# ANN type Tuple'Fused Fuse #-}
646data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
648-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input
649-- elements and folds them using the supplied fold.
651-- Stops after @n@ elements.
652-- Fails if the stream ends before @m@ elements could be taken.
658-- takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)
659-- where prsr = Parser.takeBetween low high Fold.toList
664-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]
667-- >>> takeBetween' 2 4 [1, 2]
670-- >>> takeBetween' 2 4 [1]
671-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")
673-- >>> takeBetween' 0 0 [1, 2]
676-- >>> takeBetween' 0 1 []
679-- @takeBetween@ is the most general take operation, other take operations can
680-- be defined in terms of takeBetween. For example:
682-- >>> take n = Parser.takeBetween 0 n
683-- >>> takeEQ n = Parser.takeBetween n n
684-- >>> takeGE n = Parser.takeBetween n maxBound
688{-# INLINE takeBetween #-}
689takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
690takeBetween low high (Fold fstep finitial fextract) =
692 Parser step initial (extract streamErr)
697 "takeBetween: Expecting alteast " ++ show low
698 ++ " elements, got " ++ show i
701 "takeBetween: lower bound - " ++ show low
702 ++ " is greater than higher bound - " ++ show high
704 foldErr :: Int -> String
706 "takeBetween: the collecting fold terminated after"
707 ++ " consuming" ++ show i ++ " elements"
708 ++ " minimum" ++ show low ++ " elements needed"
710 -- Exactly the same as snext except different constructors, we can possibly
711 -- deduplicate the two.
717 let s1 = Tuple'Fused i1 s
719 -- XXX ideally this should be a Continue instead
720 then return $ IPartial s1
721 else iextract foldErr s1
726 else IError (foldErr i1)
729 when (low >= 0 && high >= 0 && low > high)
732 finitial >>= inext (-1)
734 -- Keep the impl same as inext
740 let s1 = Tuple'Fused i1 s
742 then return $ Continue 0 s1
743 else extract foldErr s1
748 else Error (foldErr i1)
750 step (Tuple'Fused i s) a = fstep s a >>= snext i
752 extract f (Tuple'Fused i s)
753 | i >= low && i <= high = fmap (Done 0) (fextract s)
754 | otherwise = return $ Error (f i)
756 -- XXX Need to make Initial return type Step to deduplicate this
757 iextract f (Tuple'Fused i s)
758 | i >= low && i <= high = fmap IDone (fextract s)
759 | otherwise = return $ IError (f i)
761-- | Stops after taking exactly @n@ input elements.
763-- * Stops - after consuming @n@ elements.
764-- * Fails - if the stream or the collecting fold ends before it can collect
765-- exactly @n@ elements.
767-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
768-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")
771takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
772takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
781 FL.Partial s -> IPartial $ Tuple' 0 s
786 $ "takeEQ: Expecting exactly " ++ show cnt
787 ++ " elements, fold terminated without"
788 ++ " consuming any elements"
795 FL.Partial s -> Continue 0 $ Tuple' i1 s
798 $ "takeEQ: Expecting exactly " ++ show cnt
799 ++ " elements, fold terminated on " ++ show i1
804 FL.Partial s -> fextract s
805 FL.Done b -> return b
806 -- XXX we should not reach here when initial returns Step type
807 -- reachable only when n == 0
808 | otherwise = Done 1 <$> fextract r
815 | i == 0 && cnt == 0 = fmap (Done 0) $ fextract r
819 $ "takeEQ: Expecting exactly " ++ show cnt
820 ++ " elements, input terminated on " ++ show i
822-- | Take at least @n@ input elements, but can collect more.
824-- * Stops - when the collecting fold stops.
825-- * Fails - if the stream or the collecting fold ends before producing @n@
828-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
829-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")
831-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
837takeGE :: Monad m => Int -> Fold m a b -> Parser a m b
838takeGE n (Fold fstep finitial fextract) = Parser step initial extract
847 FL.Partial s -> IPartial $ Tuple' 0 s
852 $ "takeGE: Expecting at least " ++ show cnt
853 ++ " elements, fold terminated without"
854 ++ " consuming any elements"
861 FL.Partial s -> Continue 0 $ Tuple' i1 s
864 $ "takeGE: Expecting at least " ++ show cnt
865 ++ " elements, fold terminated on " ++ show i1
870 FL.Partial s -> Partial 0 $ Tuple' i1 s
871 FL.Done b -> Done 0 b
878 | i >= cnt = fmap (Done 0) $ fextract r
882 $ "takeGE: Expecting at least " ++ show cnt
883 ++ " elements, input terminated on " ++ show i
885-------------------------------------------------------------------------------
886-- Conditional splitting
887-------------------------------------------------------------------------------
889-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.
891-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the
892-- input. The combinator stops when the condition fails or if the collecting
895-- Other interesting parsers can be implemented in terms of this parser:
897-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
898-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)
900-- Stops: when the condition fails or the collecting parser stops.
901-- Fails: when the collecting parser fails.
905{-# INLINE takeWhileP #-}
906takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
907takeWhileP predicate (Parser pstep pinitial pextract) =
908 Parser step pinitial pextract
917 -- XXX need a map on count
919 Error err -> return $ Error err
920 Done n s1 -> return $ Done (n + 1) s1
921 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
922 Continue n s1 -> return $ Continue (n + 1) s1
924-- | Collect stream elements until an element fails the predicate. The element
925-- on which the predicate fails is returned back to the input stream.
927-- * Stops - when the predicate fails or the collecting fold stops.
930-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]
933-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)
935-- We can implement a @breakOn@ using 'takeWhile':
938-- breakOn p = takeWhile (not p)
941{-# INLINE takeWhile #-}
942takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
943-- takeWhile cond f = takeWhileP cond (fromFold f)
944takeWhile predicate (Fold fstep finitial fextract) =
945 Parser step initial extract
952 FL.Partial s -> IPartial s
961 FL.Partial s1 -> Partial 0 s1
962 FL.Done b -> Done 0 b
963 else Done 1 <$> fextract s
965 extract s = fmap (Done 0) (fextract s)
968-- XXX This may not be composable because of the b argument. We can instead
969-- return a "Reparse b a m b" so that those can be composed.
970{-# INLINE takeWhile1X #-}
971takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b
972-- We can implement this using satisfy and takeWhile. We can use "satisfy
973-- p", fold the result with the refold and then use the "takeWhile p" and
974-- fold that using the refold.
975takeWhile1 acc cond f = undefined
978-- | Like 'takeWhile' but takes at least one element otherwise fails.
980-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
982{-# INLINE takeWhile1 #-}
983takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
984-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)
985takeWhile1 predicate (Fold fstep finitial fextract) =
986 Parser step initial extract
993 FL.Partial s -> IPartial (Left' s)
996 $ "takeWhile1: fold terminated without consuming:"
999 {-# INLINE process #-}
1004 FL.Partial s1 -> Partial 0 (Right' s1)
1005 FL.Done b -> Done 0 b
1010 else return $ Error "takeWhile1: predicate failed on first element"
1018 extract (Left' _) = return $ Error "takeWhile1: end of input"
1019 extract (Right' s) = fmap (Done 0) (fextract s)
1021-- | Drain the input as long as the predicate succeeds, running the effects and
1022-- discarding the results.
1024-- This is also called @skipWhile@ in some parsing libraries.
1026-- >>> dropWhile p = Parser.takeWhile p Fold.drain
1028{-# INLINE dropWhile #-}
1029dropWhile :: Monad m => (a -> Bool) -> Parser a m ()
1030dropWhile p = takeWhile p FL.drain
1032-------------------------------------------------------------------------------
1034-------------------------------------------------------------------------------
1036data FramedEscState s =
1037 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
1039-- XXX We can remove Maybe from esc
1040{-# INLINE takeFramedByGeneric #-}
1041takeFramedByGeneric :: Monad m =>
1042 Maybe (a -> Bool) -- is escape char?
1043 -> Maybe (a -> Bool) -- is frame begin?
1044 -> Maybe (a -> Bool) -- is frame end?
1047takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
1049 Parser step initial extract
1057 FL.Partial s -> IPartial (FrameEscInit s)
1059 error "takeFramedByGeneric: fold done without input"
1061 {-# INLINE process #-}
1066 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1067 FL.Done b -> Done 0 b
1069 {-# INLINE processNoEsc #-}
1070 processNoEsc s a n =
1075 -- takeFramedBy case
1079 then Done 0 <$> fextract s
1080 else process s a (n - 1)
1082 let n1 = if isBegin a then n + 1 else n
1084 Nothing -> -- takeEndBy case
1086 then Done 0 <$> fextract s
1088 Nothing -> -- takeStartBy case
1092 then Done 0 <$> fextract s
1095 error $ "takeFramedByGeneric: "
1096 ++ "Both begin and end frame predicate missing"
1098 {-# INLINE processCheckEsc #-}
1099 processCheckEsc s a n =
1103 then return $ Partial 0 $ FrameEscEsc s n
1104 else processNoEsc s a n
1105 Nothing -> processNoEsc s a n
1107 step (FrameEscInit s) a =
1111 then return $ Partial 0 (FrameEscGo s 0)
1112 else return $ Error "takeFramedByGeneric: missing frame start"
1117 then Done 0 <$> fextract s
1118 else processCheckEsc s a 0
1120 error "Both begin and end frame predicate missing"
1121 step (FrameEscGo s n) a = processCheckEsc s a n
1122 step (FrameEscEsc s n) a = process s a n
1124 err = return . Error
1126 extract (FrameEscInit _) =
1127 err "takeFramedByGeneric: empty token"
1128 extract (FrameEscGo s _) =
1132 Nothing -> fmap (Done 0) $ fextract s
1133 Just _ -> err "takeFramedByGeneric: missing frame end"
1134 Nothing -> err "takeFramedByGeneric: missing closing frame"
1135 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1137data BlockParseState s =
1139 | BlockUnquoted !Int !s
1140 | BlockQuoted !Int !s
1141 | BlockQuotedEsc !Int !s
1143-- Blocks can be of different types e.g. {} or (). We only parse from the
1144-- perspective of the outermost block type. The nesting of that block are
1145-- checked. Any other block types nested inside it are opaque to us and can be
1146-- parsed when the contents of the block are parsed.
1148-- XXX Put a limit on nest level to keep the API safe.
1150-- | Parse a block enclosed within open, close brackets. Block contents may be
1151-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1152-- within quotes if escaped. A block can have a nested block inside it.
1154-- Quote begin and end chars are the same. Block brackets and quote chars must
1155-- not overlap. Block start and end brackets must be different for nesting
1156-- blocks within blocks.
1158-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1159-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1160-- Right "msg: \"hello world\""
1162{-# INLINE blockWithQuotes #-}
1163blockWithQuotes :: (Monad m, Eq a) =>
1164 (a -> Bool) -- ^ escape char
1165 -> (a -> Bool) -- ^ quote char, to quote inside brackets
1166 -> a -- ^ Block opening bracket
1167 -> a -- ^ Block closing bracket
1170blockWithQuotes isEsc isQuote bopen bclose
1171 (Fold fstep finitial fextract) =
1172 Parser step initial extract
1180 FL.Partial s -> IPartial (BlockInit s)
1182 error "blockWithQuotes: fold finished without input"
1184 {-# INLINE process #-}
1185 process s a nextState = do
1189 FL.Partial s1 -> Continue 0 (nextState s1)
1190 FL.Done b -> Done 0 b
1192 step (BlockInit s) a =
1195 then Continue 0 $ BlockUnquoted 1 s
1196 else Error "blockWithQuotes: missing block start"
1197 step (BlockUnquoted level s) a
1198 | a == bopen = process s a (BlockUnquoted (level + 1))
1201 then fmap (Done 0) (fextract s)
1202 else process s a (BlockUnquoted (level - 1))
1203 | isQuote a = process s a (BlockQuoted level)
1204 | otherwise = process s a (BlockUnquoted level)
1205 step (BlockQuoted level s) a
1206 | isEsc a = process s a (BlockQuotedEsc level)
1209 then process s a (BlockUnquoted level)
1210 else process s a (BlockQuoted level)
1211 step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1213 err = return . Error
1215 extract (BlockInit s) = fmap (Done 0) $ fextract s
1216 extract (BlockUnquoted level _) =
1217 err $ "blockWithQuotes: finished at block nest level " ++ show level
1218 extract (BlockQuoted level _) =
1219 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1220 ++ "at block nest level " ++ show level
1221 extract (BlockQuotedEsc level _) =
1222 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1223 ++ "after an escape char, at block nest level " ++ show level
1225-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1226-- the supplied predicate. The separator is also taken with the token.
1228-- This can be combined with other parsers to implement other interesting
1229-- parsers as follows:
1231-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)
1232-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)
1234-- >>> takeEndBy = Parser.takeEndByEsc (const False)
1236-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting
1237-- parser in the takeEndBy parser can decide whether to fail or not if the
1238-- stream does not end with separator.
1242{-# INLINE takeEndBy #-}
1243takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
1244-- takeEndBy = takeEndByEsc (const False)
1245takeEndBy cond (Parser pstep pinitial pextract) =
1247 Parser step initial pextract
1257 else extractStep pextract res
1259-- | Like 'takeEndBy' but the separator elements can be escaped using an
1260-- escape char determined by the first predicate. The escape characters are
1264{-# INLINE takeEndByEsc #-}
1265takeEndByEsc :: Monad m =>
1266 (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
1267takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
1269 Parser step initial extract
1273 initial = first Left' <$> pinitial
1275 step (Left' s) a = do
1277 then return $ Partial 0 $ Right' s
1281 then return $ first Left' res
1282 else fmap (first Left') $ extractStep pextract res
1284 step (Right' s) a = do
1286 return $ first Left' res
1288 extract (Left' s) = fmap (first Left') $ pextract s
1289 extract (Right' _) =
1290 return $ Error "takeEndByEsc: trailing escape"
1292-- | Like 'takeEndBy' but the separator is dropped.
1294-- See also "Streamly.Data.Fold.takeEndBy_".
1298{-# INLINE takeEndBy_ #-}
1299takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b
1302 takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)
1304takeEndBy_ cond (Parser pstep pinitial pextract) =
1306 Parser step pinitial pextract
1315-- | Take either the separator or the token. Separator is a Left value and
1316-- token is Right value.
1319{-# INLINE takeEitherSepBy #-}
1320takeEitherSepBy :: -- Monad m =>
1321 (a -> Bool) -> Fold m (Either a b) c -> Parser a m c
1322takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond
1324-- | Parse a token that starts with an element chosen by the predicate. The
1325-- parser fails if the input does not start with the selected element.
1327-- * Stops - when the predicate succeeds in non-leading position.
1328-- * Fails - when the predicate fails in the leading position.
1330-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)
1334-- >>> p = Parser.takeStartBy (== ',') Fold.toList
1335-- >>> leadingComma = Stream.parse p . Stream.fromList
1336-- >>> leadingComma "a,b"
1337-- Left (ParseError "takeStartBy: missing frame start")
1339-- >>> leadingComma ",,"
1341-- >>> leadingComma ",a,b"
1343-- >>> leadingComma ""
1348{-# INLINE takeStartBy #-}
1349takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1350takeStartBy cond (Fold fstep finitial fextract) =
1352 Parser step initial extract
1360 FL.Partial s -> IPartial (Left' s)
1361 FL.Done _ -> IError "takeStartBy: fold done without input"
1363 {-# INLINE process #-}
1368 FL.Partial s1 -> Partial 0 (Right' s1)
1369 FL.Done b -> Done 0 b
1374 else return $ Error "takeStartBy: missing frame start"
1378 else Done 1 <$> fextract s
1380 extract (Left' s) = fmap (Done 0) $ fextract s
1381 extract (Right' s) = fmap (Done 0) $ fextract s
1383-- | Like 'takeStartBy' but drops the separator.
1385-- >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing
1387{-# INLINE takeStartBy_ #-}
1388takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1389takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing
1391-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a
1392-- begin and end predicate, and an escape character. The frame begin and end
1393-- characters lose their special meaning if preceded by the escape character.
1395-- Nested frames are allowed if begin and end markers are different, nested
1396-- frames must be balanced unless escaped, nested frame markers are emitted as
1401-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList
1402-- >>> Stream.parse p $ Stream.fromList "{hello}"
1404-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"
1405-- Right "hello {world}"
1406-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
1407-- Right "hello {world"
1408-- >>> Stream.parse p $ Stream.fromList "{hello {world}"
1409-- Left (ParseError "takeFramedByEsc_: missing frame end")
1412{-# INLINE takeFramedByEsc_ #-}
1413takeFramedByEsc_ :: Monad m =>
1414 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1415-- takeFramedByEsc_ isEsc isEnd p =
1416-- takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)
1417takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
1419 Parser step initial extract
1427 FL.Partial s -> IPartial (FrameEscInit s)
1429 error "takeFramedByEsc_: fold done without input"
1431 {-# INLINE process #-}
1436 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1437 FL.Done b -> Done 0 b
1439 step (FrameEscInit s) a =
1441 then return $ Partial 0 (FrameEscGo s 0)
1442 else return $ Error "takeFramedByEsc_: missing frame start"
1443 step (FrameEscGo s n) a =
1445 then return $ Partial 0 $ FrameEscEsc s n
1449 let n1 = if isBegin a then n + 1 else n
1453 then Done 0 <$> fextract s
1454 else process s a (n - 1)
1455 step (FrameEscEsc s n) a = process s a n
1457 err = return . Error
1459 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1460 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1461 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1463data FramedState s = FrameInit !s | FrameGo !s Int
1465-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an
1468-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)
1470{-# INLINE takeFramedBy_ #-}
1471takeFramedBy_ :: Monad m =>
1472 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1473-- takeFramedBy_ isBegin isEnd =
1474-- takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)
1475takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
1477 Parser step initial extract
1485 FL.Partial s -> IPartial (FrameInit s)
1487 error "takeFramedBy_: fold done without input"
1489 {-# INLINE process #-}
1494 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1495 FL.Done b -> Done 0 b
1497 step (FrameInit s) a =
1499 then return $ Continue 0 (FrameGo s 0)
1500 else return $ Error "takeFramedBy_: missing frame start"
1501 step (FrameGo s n) a
1503 let n1 = if isBegin a then n + 1 else n
1505 | n == 0 = Done 0 <$> fextract s
1506 | otherwise = process s a (n - 1)
1508 err = return . Error
1510 extract (FrameInit _) = err "takeFramedBy_: empty token"
1511 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1513-------------------------------------------------------------------------------
1514-- Grouping and words
1515-------------------------------------------------------------------------------
1517data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1519-- Note we can also get words using something like:
1520-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)
1522-- But that won't be as efficient and ergonomic.
1524-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
1525-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
1526-- @["a","b"]@. In other words, its like parsing words from whitespace
1529-- * Stops - when it finds a word separator after a non-word element
1532-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)
1535-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)
1538{-# INLINE wordBy #-}
1539wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1540wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1544 {-# INLINE worder #-}
1549 FL.Partial s1 -> Partial 0 $ WBWord s1
1550 FL.Done b -> Done 0 b
1556 FL.Partial s -> IPartial $ WBLeft s
1557 FL.Done b -> IDone b
1560 if not (predicate a)
1562 else return $ Partial 0 $ WBLeft s
1564 if not (predicate a)
1568 return $ Partial 0 $ WBRight b
1569 step (WBRight b) a =
1571 $ if not (predicate a)
1573 else Partial 0 $ WBRight b
1575 extract (WBLeft s) = fmap (Done 0) $ fextract s
1576 extract (WBWord s) = fmap (Done 0) $ fextract s
1577 extract (WBRight b) = return (Done 0 b)
1579data WordFramedState s b =
1580 WordFramedSkipPre !s
1581 | WordFramedWord !s !Int
1582 | WordFramedEsc !s !Int
1583 | WordFramedSkipPost !b
1585-- | Like 'wordBy' but treats anything inside a pair of quotes as a single
1586-- word, the quotes can be escaped by an escape character. Recursive quotes
1587-- are possible if quote begin and end characters are different, quotes must be
1588-- balanced. Outermost quotes are stripped.
1590-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList
1591-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"
1593-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"
1595-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"
1597-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"
1600-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList
1601-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""
1604{-# INLINE wordFramedBy #-}
1605wordFramedBy :: Monad m =>
1606 (a -> Bool) -- ^ Matches escape elem?
1607 -> (a -> Bool) -- ^ Matches left quote?
1608 -> (a -> Bool) -- ^ matches right quote?
1609 -> (a -> Bool) -- ^ matches word separator?
1612wordFramedBy isEsc isBegin isEnd isSep
1613 (Fold fstep finitial fextract) =
1614 Parser step initial extract
1622 FL.Partial s -> IPartial (WordFramedSkipPre s)
1624 error "wordFramedBy: fold done without input"
1626 {-# INLINE process #-}
1631 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1632 FL.Done b -> Done 0 b
1634 step (WordFramedSkipPre s) a
1635 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1636 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1637 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1639 return $ Error "wordFramedBy: missing frame start"
1640 | otherwise = process s a 0
1641 step (WordFramedWord s n) a
1642 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1643 | n == 0 && isSep a = do
1645 return $ Partial 0 $ WordFramedSkipPost b
1647 -- We need to use different order for checking begin and end for
1648 -- the n == 0 and n == 1 case so that when the begin and end
1649 -- character is the same we treat the one after begin as end.
1652 -- Need to check isBegin first
1654 then return $ Continue 0 $ WordFramedWord s 1
1656 then return $ Error "wordFramedBy: missing frame start"
1659 -- Need to check isEnd first
1663 then return $ Continue 0 $ WordFramedWord s 0
1664 else process s a (n - 1)
1666 then process s a (n + 1)
1668 step (WordFramedEsc s n) a = process s a n
1669 step (WordFramedSkipPost b) a =
1673 else Partial 0 $ WordFramedSkipPost b
1675 err = return . Error
1677 extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s
1678 extract (WordFramedWord s n) =
1680 then fmap (Done 0) $ fextract s
1681 else err "wordFramedBy: missing frame end"
1682 extract (WordFramedEsc _ _) =
1683 err "wordFramedBy: trailing escape"
1684 extract (WordFramedSkipPost b) = return (Done 0 b)
1686data WordQuotedState s b a =
1687 WordQuotedSkipPre !s
1688 | WordUnquotedWord !s
1689 | WordQuotedWord !s !Int !a !a
1690 | WordUnquotedEsc !s
1691 | WordQuotedEsc !s !Int !a !a
1692 | WordQuotedSkipPost !b
1694-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
1695-- word separators within specified quotes or brackets are ignored. Quotes and
1696-- escape characters can be processed. If the end quote is different from the
1697-- start quote it is called a bracket. The following quoting rules apply:
1699-- * In an unquoted string a character may be preceded by an escape character.
1700-- The escape character is removed and the character following it is treated
1701-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
1703-- * Any part of the word can be placed within quotes. Inside quotes all
1704-- characters are treated literally with no special meaning. Quoting character
1705-- itself cannot be used within quotes unless escape processing within quotes
1706-- is applied to allow it.
1707-- * Optionally escape processing for quoted part can be specified. Escape
1708-- character has no special meaning inside quotes unless it is followed by a
1709-- character that has a escape translation specified, in that case the escape
1710-- character is removed, and the specified translation is applied to the
1711-- character following it. This can be used to escape the quoting character
1712-- itself within quotes.
1713-- * There can be multiple quoting characters, when a quote starts, all other
1714-- quoting characters within that quote lose any special meaning until the
1716-- * A starting quote char without an ending char generates a parse error. An
1717-- ending bracket char without a corresponding bracket begin is ignored.
1718-- * Brackets can be nested.
1720-- We should note that unquoted and quoted escape processing are different. In
1721-- unquoted part escape character is always removed. In quoted part it is
1722-- removed only if followed by a special meaning character. This is consistent
1723-- with how shell performs escape processing.
1725-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
1726-- ((nested) brackets).
1734-- >>> '\'' -> Just x
1738-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
1739-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1740-- Right "a\"b'c\";'d\"e'f"
1742-- Note that outer quotes and backslashes from the input string are consumed by
1743-- Haskell, therefore, the actual input string passed to the parser is:
1746-- Similarly, when printing, double quotes are escaped by Haskell.
1750-- Shell like quote processing can be performed by using quote char specific
1751-- escape processing, single quotes with no escapes, and double quotes with
1754-- JSON string processing can also be achieved except the "\uXXXX" style
1755-- escaping for Unicode characters.
1757{-# INLINE wordWithQuotes #-}
1758wordWithQuotes :: (Monad m, Eq a) =>
1759 Bool -- ^ Retain the quotes and escape chars in the output
1760 -> (a -> a -> Maybe a) -- ^ quote char -> escaped char -> translated char
1761 -> a -- ^ Matches an escape elem?
1762 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1763 -> (a -> Bool) -- ^ Matches a word separator?
1766wordWithQuotes keepQuotes tr escChar toRight isSep
1767 (Fold fstep finitial fextract) =
1768 Parser step initial extract
1772 -- Can be used to generate parse error for a bracket end without a bracket
1774 isInvalid = const False
1776 isEsc = (== escChar)
1782 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1784 error "wordKeepQuotes: fold done without input"
1786 {-# INLINE processQuoted #-}
1787 processQuoted s a n ql qr = do
1791 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)
1792 FL.Done b -> Done 0 b
1794 {-# INLINE processUnquoted #-}
1795 processUnquoted s a = do
1799 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1800 FL.Done b -> Done 0 b
1802 step (WordQuotedSkipPre s) a
1803 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1804 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1809 then processQuoted s a 1 a qr
1810 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1813 return $ Error "wordKeepQuotes: invalid unquoted char"
1814 | otherwise -> processUnquoted s a
1815 step (WordUnquotedWord s) a
1816 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1819 return $ Partial 0 $ WordQuotedSkipPost b
1824 then processQuoted s a 1 a qr
1825 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1828 then return $ Error "wordKeepQuotes: invalid unquoted char"
1829 else processUnquoted s a
1830 step (WordQuotedWord s n ql qr) a
1831 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr
1833 -- XXX Will this ever occur? Will n ever be 0?
1834 | n == 0 && isSep a = do
1836 return $ Partial 0 $ WordQuotedSkipPost b
1843 then processUnquoted s a
1844 else return $ Continue 0 $ WordUnquotedWord s
1845 else processQuoted s a (n - 1) ql qr
1847 then processQuoted s a (n + 1) ql qr
1848 else processQuoted s a n ql qr
1849 step (WordUnquotedEsc s) a = processUnquoted s a
1850 step (WordQuotedEsc s n ql qr) a =
1853 res <- fstep s escChar
1855 FL.Partial s1 -> processQuoted s1 a n ql qr
1856 FL.Done b -> return $ Done 0 b
1857 Just x -> processQuoted s x n ql qr
1858 step (WordQuotedSkipPost b) a =
1862 else Partial 0 $ WordQuotedSkipPost b
1864 err = return . Error
1866 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1867 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1868 extract (WordQuotedWord s n _ _) =
1870 then fmap (Done 0) $ fextract s
1871 else err "wordWithQuotes: missing frame end"
1872 extract WordQuotedEsc {} =
1873 err "wordWithQuotes: trailing escape"
1874 extract (WordUnquotedEsc _) =
1875 err "wordWithQuotes: trailing escape"
1876 extract (WordQuotedSkipPost b) = return (Done 0 b)
1878-- | 'wordWithQuotes' without processing the quotes and escape function
1879-- supplied to escape the quote char within a quote. Can be used to parse words
1880-- keeping the quotes and escapes intact.
1882-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
1884{-# INLINE wordKeepQuotes #-}
1885wordKeepQuotes :: (Monad m, Eq a) =>
1887 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1888 -> (a -> Bool) -- ^ Matches a word separator?
1892 -- Escape the quote char itself
1893 wordWithQuotes True (\q x -> if q == x then Just x else Nothing)
1895-- See the "Quoting Rules" section in the "bash" manual page for a primer on
1896-- how quotes are used by shells.
1898-- | 'wordWithQuotes' with quote processing applied and escape function
1899-- supplied to escape the quote char within a quote. Can be ysed to parse words
1900-- and processing the quoting and escaping at the same time.
1902-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
1904{-# INLINE wordProcessQuotes #-}
1905wordProcessQuotes :: (Monad m, Eq a) =>
1907 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1908 -> (a -> Bool) -- ^ Matches a word separator?
1912 -- Escape the quote char itself
1913 wordWithQuotes False (\q x -> if q == x then Just x else Nothing)
1915{-# ANN type GroupByState Fuse #-}
1916data GroupByState a s
1918 | GroupByGrouping !a !s
1920-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
1921-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1922-- 'True' @b@ is also assigned to the same group. If @a \`cmp` c@ is 'True'
1923-- then @c@ is also assigned to the same group and so on. When the comparison
1924-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1925-- the result of the fold is the result of the parser.
1927-- * Stops - when the comparison fails.
1932-- Stream.fold Fold.toList
1933-- . Stream.parseMany (Parser.groupBy eq Fold.toList)
1937-- >>> runGroupsBy (<) []
1940-- >>> runGroupsBy (<) [1]
1943-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]
1944-- [Right [3,5,4],Right [1,2],Right [0]]
1946{-# INLINE groupBy #-}
1947groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1948groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1952 {-# INLINE grouper #-}
1957 FL.Done b -> Done 0 b
1958 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1964 FL.Partial s -> IPartial $ GroupByInit s
1965 FL.Done b -> IDone b
1967 step (GroupByInit s) a = grouper s a a
1968 step (GroupByGrouping a0 s) a =
1971 else Done 1 <$> fextract s
1973 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1974 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1976-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
1977-- successive elements in the input stream. Assuming the input stream
1978-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser
1979-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1980-- 'True' @b@ is also assigned to the same group. If @b \`cmp` c@ is 'True'
1981-- then @c@ is also assigned to the same group and so on. When the comparison
1982-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1983-- the result of the fold is the result of the parser.
1985-- * Stops - when the comparison fails.
1989-- runGroupsByRolling eq =
1990-- Stream.fold Fold.toList
1991-- . Stream.parseMany (Parser.groupByRolling eq Fold.toList)
1995-- >>> runGroupsByRolling (<) []
1998-- >>> runGroupsByRolling (<) [1]
2001-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]
2002-- [Right [3,5],Right [4],Right [1,2],Right [0]]
2006{-# INLINE groupByRolling #-}
2007groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
2008groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
2012 {-# INLINE grouper #-}
2017 FL.Done b -> Done 0 b
2018 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
2024 FL.Partial s -> IPartial $ GroupByInit s
2025 FL.Done b -> IDone b
2027 step (GroupByInit s) a = grouper s a
2028 step (GroupByGrouping a0 s) a =
2031 else Done 1 <$> fextract s
2033 extract (GroupByInit s) = fmap (Done 0) $ fextract s
2034 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
2036{-# ANN type GroupByStatePair Fuse #-}
2037data GroupByStatePair a s1 s2
2038 = GroupByInitPair !s1 !s2
2039 | GroupByGroupingPair !a !s1 !s2
2040 | GroupByGroupingPairL !a !s1 !s2
2041 | GroupByGroupingPairR !a !s1 !s2
2043-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
2044-- the first fold as long as the predicate holds 'True', if the predicate is
2045-- 'False' collects using the second fold as long as it remains 'False'.
2046-- Returns 'Left' for the first case and 'Right' for the second case.
2048-- For example, if we want to detect sorted sequences in a stream, both
2049-- ascending and descending cases we can use 'groupByRollingEither (<=)
2050-- Fold.toList Fold.toList'.
2053{-# INLINE groupByRollingEither #-}
2054groupByRollingEither :: Monad m =>
2055 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)
2058 (Fold fstep1 finitial1 fextract1)
2059 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
2063 {-# INLINE grouper #-}
2064 grouper s1 s2 a = do
2065 return $ Continue 0 (GroupByGroupingPair a s1 s2)
2067 {-# INLINE grouperL2 #-}
2068 grouperL2 s1 s2 a = do
2072 FL.Done b -> Done 0 (Left b)
2073 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
2075 {-# INLINE grouperL #-}
2076 grouperL s1 s2 a0 a = do
2079 FL.Done b -> return $ Done 0 (Left b)
2080 FL.Partial s11 -> grouperL2 s11 s2 a
2082 {-# INLINE grouperR2 #-}
2083 grouperR2 s1 s2 a = do
2087 FL.Done b -> Done 0 (Right b)
2088 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
2090 {-# INLINE grouperR #-}
2091 grouperR s1 s2 a0 a = do
2094 FL.Done b -> return $ Done 0 (Right b)
2095 FL.Partial s21 -> grouperR2 s1 s21 a
2104 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
2105 FL.Done b -> IDone (Right b)
2106 FL.Done b -> IDone (Left b)
2108 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
2110 step (GroupByGroupingPair a0 s1 s2) a =
2112 then grouperL s1 s2 a0 a
2113 else grouperR s1 s2 a0 a
2115 step (GroupByGroupingPairL a0 s1 s2) a =
2117 then grouperL2 s1 s2 a
2118 else Done 1 . Left <$> fextract1 s1
2120 step (GroupByGroupingPairR a0 s1 s2) a =
2122 then grouperR2 s1 s2 a
2123 else Done 1 . Right <$> fextract2 s2
2125 extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1
2126 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1
2127 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2
2128 extract (GroupByGroupingPair a s1 _) = do
2131 FL.Done b -> return $ Done 0 (Left b)
2132 FL.Partial s11 -> Done 0 . Left <$> fextract1 s11
2134-- XXX use an Unfold instead of a list?
2135-- XXX custom combinators for matching list, array and stream?
2136-- XXX rename to listBy?
2138-- | Match the given sequence of elements using the given comparison function.
2139-- Returns the original sequence if successful.
2143-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs
2147-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"
2150-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
2151-- Left (ParseError "streamEqBy: mismtach occurred")
2153{-# INLINE listEqBy #-}
2154listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
2155listEqBy cmp xs = streamEqBy cmp (D.fromList xs) *> fromPure xs
2157listEqBy cmp str = Parser step initial extract
2161 -- XXX Should return IDone in initial for [] case
2162 initial = return $ IPartial str
2164 step [] _ = return $ Done 0 str
2169 else Error "listEqBy: failed, yet to match the last element"
2175 $ "listEqBy: failed, yet to match "
2176 ++ show (length xs + 1) ++ " elements"
2181 $ "listEqBy: end of input, yet to match "
2182 ++ show (length xs) ++ " elements"
2185-- | Like 'listEqBy' but uses a stream instead of a list and does not return
2188-- See also: "Streamly.Data.Stream.streamEqBy"
2190{-# INLINE streamEqBy #-}
2191streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2192streamEqBy cmp (D.Stream sstep state) = Parser step initial extract
2197 r <- sstep defState state
2199 D.Yield x s -> return $ IPartial (Just' x, s)
2200 D.Stop -> return $ IDone ()
2201 -- Need Skip/Continue in initial to loop right here
2202 D.Skip s -> return $ IPartial (Nothing', s)
2204 step (Just' x, st) a =
2207 r <- sstep defState st
2210 D.Yield x1 s -> Continue 0 (Just' x1, s)
2212 D.Skip s -> Continue 1 (Nothing', s)
2213 else return $ Error "streamEqBy: mismtach occurred"
2214 step (Nothing', st) a = do
2215 r <- sstep defState st
2220 then Continue 0 (Nothing', s)
2221 else Error "streamEqBy: mismatch occurred"
2223 D.Skip s -> Continue 1 (Nothing', s)
2225 extract _ = return $ Error "streamEqBy: end of input"
2228-- | Match the input sequence with the supplied list and return it if
2231-- >>> listEq = Parser.listEqBy (==)
2233{-# INLINE listEq #-}
2234listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]
2235listEq = listEqBy (==)
2237-- | Match if the input stream is a subsequence of the argument stream i.e. all
2238-- the elements of the input stream occur, in order, in the argument stream.
2239-- The elements do not have to occur consecutively. A sequence is considered a
2240-- subsequence of itself.
2241{-# INLINE subsequenceBy #-}
2242subsequenceBy :: -- Monad m =>
2243 (a -> a -> Bool) -> Stream m a -> Parser a m ()
2244subsequenceBy = undefined
2247-- Should go in Data.Parser.Regex in streamly package so that it can depend on
2249{-# INLINE regexPosix #-}
2250regexPosix :: -- Monad m =>
2251 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2252regexPosix = undefined
2254{-# INLINE regexPCRE #-}
2255regexPCRE :: -- Monad m =>
2256 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2257regexPCRE = undefined
2260-------------------------------------------------------------------------------
2261-- Transformations on input
2262-------------------------------------------------------------------------------
2264-- Initial needs a "Continue" constructor to implement scans on parsers. As a
2265-- parser can always return a Continue in initial when we feed the fold's
2266-- initial result to it. We can work this around for postscan by introducing an
2267-- initial state and calling "initial" only on the first input.
2269-- | Stateful scan on the input of a parser using a Fold.
2273{-# INLINE postscan #-}
2274postscan :: -- Monad m =>
2275 Fold m a b -> Parser b m c -> Parser a m c
2278{-# INLINE zipWithM #-}
2279zipWithM :: Monad m =>
2280 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x
2281zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
2282 Parser step initial extract
2290 r <- sstep defState state
2292 D.Yield x s -> return $ IPartial (Just' x, s, fs)
2296 -- Need Skip/Continue in initial to loop right here
2297 D.Skip s -> return $ IPartial (Nothing', s, fs)
2298 FL.Done x -> return $ IDone x
2300 step (Just' a, st, fs) b = do
2304 FL.Partial fs1 -> do
2305 r <- sstep defState st
2307 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
2311 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
2312 FL.Done x -> return $ Done 0 x
2313 step (Nothing', st, fs) b = do
2314 r <- sstep defState st
2321 return $ Continue 0 (Nothing', s, fs1)
2322 FL.Done x -> return $ Done 0 x
2326 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
2328 extract _ = return $ Error "zipWithM: end of input"
2330-- | Zip the input of a fold with a stream.
2335zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x
2336zip = zipWithM (curry return)
2338-- | Pair each element of a fold input with its index, starting from index 0.
2341{-# INLINE indexed #-}
2342indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b
2343indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
2345-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
2346-- function using a fold indexing function that attaches an index to each input
2347-- element and a filtering function that filters using @(index, element) ->
2348-- Bool) as predicate.
2353-- filterWithIndex = makeIndexFilter indexed filter
2354-- filterWithAbsTime = makeIndexFilter timestamped filter
2355-- filterWithRelTime = makeIndexFilter timeIndexed filter
2359{-# INLINE makeIndexFilter #-}
2361 (Fold m (s, a) b -> Parser a m b)
2362 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
2363 -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)
2364makeIndexFilter f comb g = f . comb g . FL.lmap snd
2366-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
2367-- then every element at strides of @stride@.
2370{-# INLINE sampleFromthen #-}
2371sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
2372sampleFromthen offset size =
2373 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
2375--------------------------------------------------------------------------------
2377--------------------------------------------------------------------------------
2379-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
2380-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
2384-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
2386-- > span_ (< 1) [1,2,3]
2389-- > span_ (< 2) [1,2,3]
2392-- > span_ (< 4) [1,2,3]
2399span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2400span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
2402-- | Break the input stream into two groups, the first group takes the input as
2403-- long as the predicate applied to the first element of the stream and next
2404-- input element holds 'True', the second group takes the rest of the input.
2408{-# INLINE spanBy #-}
2411 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2412spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
2414-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
2415-- predicate is applied to the previous and the next input elements.
2418{-# INLINE spanByRolling #-}
2421 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2422spanByRolling eq f1 f2 =
2423 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
2425-------------------------------------------------------------------------------
2427-------------------------------------------------------------------------------
2429-- | Takes at-most @n@ input elements.
2431-- * Stops - when the collecting parser stops.
2432-- * Fails - when the collecting parser fails.
2434-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2437-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2438-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")
2442takeP :: Monad m => Int -> Parser a m b -> Parser a m b
2443takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
2452 then return $ IPartial $ Tuple' 0 s
2454 IDone b -> return $ IDone b
2455 IError e -> return $ IError e
2457 step (Tuple' cnt r) a = do
2465 then return $ Partial 0 $ Tuple' cnt1 s
2469 Done n b -> Done n b
2470 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2471 Error err -> Error err
2472 Partial _ _ -> error "takeP: Partial in extract"
2477 then return $ Continue 0 $ Tuple' cnt1 s
2481 Done n b -> Done n b
2482 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2483 Error err -> Error err
2484 Partial _ _ -> error "takeP: Partial in extract"
2486 let taken = cnt1 - n
2488 return $ Partial n $ Tuple' taken s
2490 let taken = cnt1 - n
2492 return $ Continue n $ Tuple' taken s
2493 Done n b -> return $ Done n b
2494 Error str -> return $ Error str
2496 extract (Tuple' cnt r) = do
2499 Done n b -> Done n b
2500 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
2501 Error err -> Error err
2502 Partial _ _ -> error "takeP: Partial in extract"
2504 -- XXX Need to make the Initial type Step to remove this
2509 Error err -> IError err
2510 _ -> error "Bug: takeP invalid state in initial"
2512-- | Run a parser without consuming the input.
2514{-# INLINE lookAhead #-}
2515lookAhead :: Monad m => Parser a m b -> Parser a m b
2516lookAhead (Parser step1 initial1 _) = Parser step initial extract
2522 return $ case res of
2523 IPartial s -> IPartial (Tuple' 0 s)
2525 IError e -> IError e
2527 step (Tuple' cnt st) a = do
2532 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
2533 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
2534 Done _ b -> Done cnt1 b
2535 Error err -> Error err
2537 -- XXX returning an error let's us backtrack. To implement it in a way so
2538 -- that it terminates on eof without an error then we need a way to
2539 -- backtrack on eof, that will require extract to return 'Step' type.
2540 extract (Tuple' n _) =
2543 $ "lookAhead: end of input after consuming "
2544 ++ show n ++ " elements"
2546-------------------------------------------------------------------------------
2548-------------------------------------------------------------------------------
2550-- To deinterleave we can chain two parsers one behind the other. The input is
2551-- given to the first parser and the input definitively rejected by the first
2552-- parser is given to the second parser.
2554-- We can either have the parsers themselves buffer the input or use the shared
2555-- global buffer to hold it until none of the parsers need it. When the first
2556-- parser returns Skip (i.e. rewind) we let the second parser consume the
2557-- rejected input and when it is done we move the cursor forward to the first
2558-- parser again. This will require a "move forward" command as well.
2560-- To implement grep we can use three parsers, one to find the pattern, one
2561-- to store the context behind the pattern and one to store the context in
2562-- front of the pattern. When a match occurs we need to emit the accumulator of
2563-- all the three parsers. One parser can count the line numbers to provide the
2566{-# ANN type DeintercalateAllState Fuse #-}
2567data DeintercalateAllState fs sp ss =
2568 DeintercalateAllInitL !fs
2569 | DeintercalateAllL !fs !sp
2570 | DeintercalateAllInitR !fs
2571 | DeintercalateAllR !fs !ss
2573-- XXX rename this to intercalate
2575-- Having deintercalateAll for accepting or rejecting entire input could be
2576-- useful. For example, in case of JSON parsing we get an entire block of
2577-- key-value pairs which we need to verify. This version may be simpler, more
2578-- efficient. We could implement this as a stream operation like parseMany.
2580-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
2581-- example, in case of csv parsing as we are feeding a line to a fold we can
2584-- | Like 'deintercalate' but the entire input must satisfy the pattern
2585-- otherwise the parser fails. This is many times faster than deintercalate.
2587-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2588-- >>> p2 = Parser.satisfy (== '+')
2589-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
2590-- >>> Stream.parse p $ Stream.fromList ""
2592-- >>> Stream.parse p $ Stream.fromList "1"
2594-- >>> Stream.parse p $ Stream.fromList "1+"
2595-- Left (ParseError "takeWhile1: end of input")
2596-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2597-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2599{-# INLINE deintercalateAll #-}
2600deintercalateAll :: Monad m =>
2603 -> Fold m (Either x y) z
2606 (Parser stepL initialL extractL)
2607 (Parser stepR initialR _)
2608 (Fold fstep finitial fextract) = Parser step initial extract
2613 error $ "deintercalate: " ++ p ++ " parser cannot "
2614 ++ status ++ " without input"
2619 FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2620 FL.Done c -> return $ IDone c
2622 {-# INLINE processL #-}
2623 processL foldAction n nextState = do
2626 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2627 FL.Done c -> return $ Done n c
2629 {-# INLINE runStepL #-}
2630 runStepL fs sL a = do
2633 Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2634 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2636 processL (fstep fs (Left b)) n DeintercalateAllInitR
2637 Error err -> return $ Error err
2639 {-# INLINE processR #-}
2640 processR foldAction n = do
2643 FL.Partial fs1 -> do
2646 IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
2647 IDone _ -> errMsg "left" "succeed"
2648 IError _ -> errMsg "left" "fail"
2649 FL.Done c -> return $ Done n c
2651 {-# INLINE runStepR #-}
2652 runStepR fs sR a = do
2655 Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2656 Continue n s -> return $ Continue n (DeintercalateAllR fs s)
2657 Done n b -> processR (fstep fs (Right b)) n
2658 Error err -> return $ Error err
2660 step (DeintercalateAllInitL fs) a = do
2663 IPartial s -> runStepL fs s a
2664 IDone _ -> errMsg "left" "succeed"
2665 IError _ -> errMsg "left" "fail"
2666 step (DeintercalateAllL fs sL) a = runStepL fs sL a
2667 step (DeintercalateAllInitR fs) a = do
2670 IPartial s -> runStepR fs s a
2671 IDone _ -> errMsg "right" "succeed"
2672 IError _ -> errMsg "right" "fail"
2673 step (DeintercalateAllR fs sR) a = runStepR fs sR a
2675 {-# INLINE extractResult #-}
2676 extractResult n fs r = do
2679 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2680 FL.Done c -> return (Done n c)
2681 extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs
2682 extract (DeintercalateAllL fs sL) = do
2685 Done n b -> extractResult n fs (Left b)
2686 Error err -> return $ Error err
2687 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2688 Partial _ _ -> error "Partial in extract"
2689 extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs
2690 extract (DeintercalateAllR _ _) =
2691 return $ Error "deintercalateAll: input ended at 'Right' value"
2693{-# ANN type DeintercalateState Fuse #-}
2694data DeintercalateState b fs sp ss =
2695 DeintercalateInitL !fs
2696 | DeintercalateL !Int !fs !sp
2697 | DeintercalateInitR !fs
2698 | DeintercalateR !Int !fs !ss
2699 | DeintercalateRL !Int !b !fs !sp
2701-- XXX Add tests that the next character that we take after running a parser is
2702-- correct. Especially for the parsers that maintain a count. In the stream
2703-- finished case (extract) as well as not finished case.
2705-- | Apply two parsers alternately to an input stream. The input stream is
2706-- considered an interleaving of two patterns. The two parsers represent the
2707-- two patterns. Parsing starts at the first parser and stops at the first
2708-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2709-- input or single parse of the first parser is accepted.
2711-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2712-- >>> p2 = Parser.satisfy (== '+')
2713-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2714-- >>> Stream.parse p $ Stream.fromList ""
2716-- >>> Stream.parse p $ Stream.fromList "1"
2718-- >>> Stream.parse p $ Stream.fromList "1+"
2720-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2721-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2723{-# INLINE deintercalate #-}
2724deintercalate :: Monad m =>
2727 -> Fold m (Either x y) z
2730 (Parser stepL initialL extractL)
2731 (Parser stepR initialR _)
2732 (Fold fstep finitial fextract) = Parser step initial extract
2737 error $ "deintercalate: " ++ p ++ " parser cannot "
2738 ++ status ++ " without input"
2743 FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2744 FL.Done c -> return $ IDone c
2746 {-# INLINE processL #-}
2747 processL foldAction n nextState = do
2750 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2751 FL.Done c -> return $ Done n c
2753 {-# INLINE runStepL #-}
2754 runStepL cnt fs sL a = do
2758 Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2759 Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2761 processL (fstep fs (Left b)) n DeintercalateInitR
2764 return $ Done cnt1 xs
2766 {-# INLINE processR #-}
2767 processR cnt b fs n = do
2770 IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2771 IDone _ -> errMsg "left" "succeed"
2772 IError _ -> errMsg "left" "fail"
2774 {-# INLINE runStepR #-}
2775 runStepR cnt fs sR a = do
2779 Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2780 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2781 Done n b -> processR (cnt1 - n) b fs n
2784 return $ Done cnt1 xs
2786 step (DeintercalateInitL fs) a = do
2789 IPartial s -> runStepL 0 fs s a
2790 IDone _ -> errMsg "left" "succeed"
2791 IError _ -> errMsg "left" "fail"
2792 step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2793 step (DeintercalateInitR fs) a = do
2796 IPartial s -> runStepR 0 fs s a
2797 IDone _ -> errMsg "right" "succeed"
2798 IError _ -> errMsg "right" "fail"
2799 step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2800 step (DeintercalateRL cnt bR fs sL) a = do
2804 Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2805 Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2807 res <- fstep fs (Right bR)
2809 FL.Partial fs1 -> do
2810 fres <- fstep fs1 (Left bL)
2813 return $ Partial n (DeintercalateInitR fs2)
2814 FL.Done c -> return $ Done n c
2815 -- XXX We could have the fold accept pairs of (bR, bL)
2816 FL.Done _ -> error "Fold terminated consuming partial input"
2819 return $ Done cnt1 xs
2821 {-# INLINE extractResult #-}
2822 extractResult n fs r = do
2825 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2826 FL.Done c -> return (Done n c)
2828 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs
2829 extract (DeintercalateL cnt fs sL) = do
2832 Done n b -> extractResult n fs (Left b)
2833 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2834 Partial _ _ -> error "Partial in extract"
2837 return $ Done cnt xs
2838 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs
2839 extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs
2840 extract (DeintercalateRL cnt bR fs sL) = do
2844 res <- fstep fs (Right bR)
2846 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2847 FL.Done _ -> error "Fold terminated consuming partial input"
2848 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2849 Partial _ _ -> error "Partial in extract"
2852 return $ Done cnt xs
2854{-# ANN type Deintercalate1State Fuse #-}
2855data Deintercalate1State b fs sp ss =
2856 Deintercalate1InitL !Int !fs !sp
2857 | Deintercalate1InitR !fs
2858 | Deintercalate1R !Int !fs !ss
2859 | Deintercalate1RL !Int !b !fs !sp
2861-- | Apply two parsers alternately to an input stream. The input stream is
2862-- considered an interleaving of two patterns. The two parsers represent the
2863-- two patterns. Parsing starts at the first parser and stops at the first
2864-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2865-- input or single parse of the first parser is accepted.
2867-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2868-- >>> p2 = Parser.satisfy (== '+')
2869-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2870-- >>> Stream.parse p $ Stream.fromList ""
2871-- Left (ParseError "takeWhile1: end of input")
2872-- >>> Stream.parse p $ Stream.fromList "1"
2874-- >>> Stream.parse p $ Stream.fromList "1+"
2876-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2877-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2879{-# INLINE deintercalate1 #-}
2880deintercalate1 :: Monad m =>
2883 -> Fold m (Either x y) z
2886 (Parser stepL initialL extractL)
2887 (Parser stepR initialR _)
2888 (Fold fstep finitial fextract) = Parser step initial extract
2893 error $ "deintercalate: " ++ p ++ " parser cannot "
2894 ++ status ++ " without input"
2902 IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2903 IDone _ -> errMsg "left" "succeed"
2904 IError _ -> errMsg "left" "fail"
2905 FL.Done c -> return $ IDone c
2907 {-# INLINE processL #-}
2908 processL foldAction n nextState = do
2911 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2912 FL.Done c -> return $ Done n c
2914 {-# INLINE runStepInitL #-}
2915 runStepInitL cnt fs sL a = do
2919 Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2920 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2922 processL (fstep fs (Left b)) n Deintercalate1InitR
2923 Error err -> return $ Error err
2925 {-# INLINE processR #-}
2926 processR cnt b fs n = do
2929 IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2930 IDone _ -> errMsg "left" "succeed"
2931 IError _ -> errMsg "left" "fail"
2933 {-# INLINE runStepR #-}
2934 runStepR cnt fs sR a = do
2938 Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2939 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2940 Done n b -> processR (cnt1 - n) b fs n
2943 return $ Done cnt1 xs
2945 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2946 step (Deintercalate1InitR fs) a = do
2949 IPartial s -> runStepR 0 fs s a
2950 IDone _ -> errMsg "right" "succeed"
2951 IError _ -> errMsg "right" "fail"
2952 step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2953 step (Deintercalate1RL cnt bR fs sL) a = do
2957 Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2958 Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2960 res <- fstep fs (Right bR)
2962 FL.Partial fs1 -> do
2963 fres <- fstep fs1 (Left bL)
2966 return $ Partial n (Deintercalate1InitR fs2)
2967 FL.Done c -> return $ Done n c
2968 -- XXX We could have the fold accept pairs of (bR, bL)
2969 FL.Done _ -> error "Fold terminated consuming partial input"
2972 return $ Done cnt1 xs
2974 {-# INLINE extractResult #-}
2975 extractResult n fs r = do
2978 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2979 FL.Done c -> return (Done n c)
2981 extract (Deintercalate1InitL cnt fs sL) = do
2984 Done n b -> extractResult n fs (Left b)
2985 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2986 Partial _ _ -> error "Partial in extract"
2987 Error err -> return $ Error err
2988 extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2989 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2990 extract (Deintercalate1RL cnt bR fs sL) = do
2994 res <- fstep fs (Right bR)
2996 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2997 FL.Done _ -> error "Fold terminated consuming partial input"
2998 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2999 Partial _ _ -> error "Partial in extract"
3002 return $ Done cnt xs
3004{-# ANN type SepByState Fuse #-}
3005data SepByState fs sp ss =
3007 | SepByL !Int !fs !sp
3009 | SepByR !Int !fs !ss
3011-- | Apply two parsers alternately to an input stream. Parsing starts at the
3012-- first parser and stops at the first parser. The output of the first parser
3013-- is emiited and the output of the second parser is discarded. It can be used
3014-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
3015-- of the first parser is accepted.
3019-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
3020-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)
3024-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3025-- >>> p2 = Parser.satisfy (== '+')
3026-- >>> p = Parser.sepBy p1 p2 Fold.toList
3027-- >>> Stream.parse p $ Stream.fromList ""
3029-- >>> Stream.parse p $ Stream.fromList "1"
3031-- >>> Stream.parse p $ Stream.fromList "1+"
3033-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3034-- Right ["1","2","3"]
3038 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3039-- This has similar performance as the custom impl below.
3040-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
3042 (Parser stepL initialL extractL)
3043 (Parser stepR initialR _)
3044 (Fold fstep finitial fextract) = Parser step initial extract
3049 error $ "sepBy: " ++ p ++ " parser cannot "
3050 ++ status ++ " without input"
3055 FL.Partial fs -> return $ IPartial $ SepByInitL fs
3056 FL.Done c -> return $ IDone c
3058 {-# INLINE processL #-}
3059 processL foldAction n nextState = do
3062 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3063 FL.Done c -> return $ Done n c
3065 {-# INLINE runStepL #-}
3066 runStepL cnt fs sL a = do
3070 Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3071 Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3073 processL (fstep fs b) n SepByInitR
3076 return $ Done cnt1 xs
3078 {-# INLINE processR #-}
3079 processR cnt fs n = do
3082 IPartial ps -> return $ Continue n (SepByL cnt fs ps)
3083 IDone _ -> errMsg "left" "succeed"
3084 IError _ -> errMsg "left" "fail"
3086 {-# INLINE runStepR #-}
3087 runStepR cnt fs sR a = do
3091 Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3092 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3093 Done n _ -> processR (cnt1 - n) fs n
3096 return $ Done cnt1 xs
3098 step (SepByInitL fs) a = do
3101 IPartial s -> runStepL 0 fs s a
3102 IDone _ -> errMsg "left" "succeed"
3103 IError _ -> errMsg "left" "fail"
3104 step (SepByL cnt fs sL) a = runStepL cnt fs sL a
3105 step (SepByInitR fs) a = do
3108 IPartial s -> runStepR 0 fs s a
3109 IDone _ -> errMsg "right" "succeed"
3110 IError _ -> errMsg "right" "fail"
3111 step (SepByR cnt fs sR) a = runStepR cnt fs sR a
3113 {-# INLINE extractResult #-}
3114 extractResult n fs r = do
3117 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3118 FL.Done c -> return (Done n c)
3120 extract (SepByInitL fs) = fmap (Done 0) $ fextract fs
3121 extract (SepByL cnt fs sL) = do
3124 Done n b -> extractResult n fs b
3125 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
3126 Partial _ _ -> error "Partial in extract"
3129 return $ Done cnt xs
3130 extract (SepByInitR fs) = fmap (Done 0) $ fextract fs
3131 extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs
3133-- | Non-backtracking version of sepBy. Several times faster.
3134{-# INLINE sepByAll #-}
3135sepByAll :: Monad m =>
3136 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3137sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)
3139-- XXX This can be implemented using refold, parse one and then continue
3140-- collecting the rest in that.
3142{-# ANN type SepBy1State Fuse #-}
3143data SepBy1State fs sp ss =
3144 SepBy1InitL !Int !fs sp
3145 | SepBy1L !Int !fs !sp
3147 | SepBy1R !Int !fs !ss
3150{-# INLINE sepBy1 #-}
3152 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3153sepBy1 p sep sink = do
3155 f <- fromEffect $ FL.reduce sink
3156 f1 <- fromEffect $ FL.snoc f x
3160-- | Like 'sepBy' but requires at least one successful parse.
3164-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
3168-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3169-- >>> p2 = Parser.satisfy (== '+')
3170-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
3171-- >>> Stream.parse p $ Stream.fromList ""
3172-- Left (ParseError "takeWhile1: end of input")
3173-- >>> Stream.parse p $ Stream.fromList "1"
3175-- >>> Stream.parse p $ Stream.fromList "1+"
3177-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3178-- Right ["1","2","3"]
3180{-# INLINE sepBy1 #-}
3182 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3184 (Parser stepL initialL extractL)
3185 (Parser stepR initialR _)
3186 (Fold fstep finitial fextract) = Parser step initial extract
3191 error $ "sepBy: " ++ p ++ " parser cannot "
3192 ++ status ++ " without input"
3200 IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
3201 IDone _ -> errMsg "left" "succeed"
3202 IError _ -> errMsg "left" "fail"
3203 FL.Done c -> return $ IDone c
3205 {-# INLINE processL #-}
3206 processL foldAction n nextState = do
3209 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3210 FL.Done c -> return $ Done n c
3212 {-# INLINE runStepInitL #-}
3213 runStepInitL cnt fs sL a = do
3217 Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3218 Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3220 processL (fstep fs b) n SepBy1InitR
3221 Error err -> return $ Error err
3223 {-# INLINE runStepL #-}
3224 runStepL cnt fs sL a = do
3228 Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3229 Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3231 processL (fstep fs b) n SepBy1InitR
3234 return $ Done cnt1 xs
3236 {-# INLINE processR #-}
3237 processR cnt fs n = do
3240 IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3241 IDone _ -> errMsg "left" "succeed"
3242 IError _ -> errMsg "left" "fail"
3244 {-# INLINE runStepR #-}
3245 runStepR cnt fs sR a = do
3249 Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3250 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3251 Done n _ -> processR (cnt1 - n) fs n
3254 return $ Done cnt1 xs
3256 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3257 step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3258 step (SepBy1InitR fs) a = do
3261 IPartial s -> runStepR 0 fs s a
3262 IDone _ -> errMsg "right" "succeed"
3263 IError _ -> errMsg "right" "fail"
3264 step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3266 {-# INLINE extractResult #-}
3267 extractResult n fs r = do
3270 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3271 FL.Done c -> return (Done n c)
3273 extract (SepBy1InitL cnt fs sL) = do
3276 Done n b -> extractResult n fs b
3277 Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3278 Partial _ _ -> error "Partial in extract"
3279 Error err -> return $ Error err
3280 extract (SepBy1L cnt fs sL) = do
3283 Done n b -> extractResult n fs b
3284 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3285 Partial _ _ -> error "Partial in extract"
3288 return $ Done cnt xs
3289 extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs
3290 extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs
3292-------------------------------------------------------------------------------
3293-- Interleaving a collection of parsers
3294-------------------------------------------------------------------------------
3296-- | Apply a collection of parsers to an input stream in a round robin fashion.
3297-- Each parser is applied until it stops and then we repeat starting with the
3298-- the first parser again.
3302{-# INLINE roundRobin #-}
3303roundRobin :: -- (Foldable t, Monad m) =>
3304 t (Parser a m b) -> Fold m b c -> Parser a m c
3305roundRobin _ps _f = undefined
3307-------------------------------------------------------------------------------
3308-- Sequential Collection
3309-------------------------------------------------------------------------------
3311-- | @sequence f p@ collects sequential parses of parsers in a
3312-- serial stream @p@ using the fold @f@. Fails if the input ends or any
3313-- of the parsers fail.
3317{-# INLINE sequence #-}
3318sequence :: Monad m =>
3319 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c
3320sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
3321 Parser step initial extract
3328 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
3329 FL.Done c -> return $ IDone c
3331 -- state does not contain any parser
3332 -- yield a new parser from the stream
3333 step (Nothing', ss, fs) _ = do
3334 sres <- sstep defState ss
3336 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
3340 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
3342 -- state holds a parser that may or may not have been
3343 -- initialized. pinit holds the initial parser state
3344 -- or modified parser state respectively
3345 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
3353 Just' $ Parser pstep (return $ IPartial ps2) pextr
3354 in return $ Partial n (newP, ss, fs)
3357 Just' $ Parser pstep (return $ IPartial ps2) pextr
3358 in return $ Continue n (newP, ss, fs)
3363 return $ Partial n (Nothing', ss, fs1)
3364 FL.Done c -> return $ Done n c
3365 Error msg -> return $ Error msg
3370 return $ Partial 1 (Nothing', ss, fs1)
3371 FL.Done c -> return $ Done 1 c
3372 IError err -> return $ Error err
3374 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
3375 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
3384 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3385 FL.Done c -> return (Done n c)
3386 Error err -> return $ Error err
3387 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
3388 Partial _ _ -> error "Partial in extract"
3392 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
3393 FL.Done c -> return (Done 0 c)
3394 IError err -> return $ Error err
3396-------------------------------------------------------------------------------
3397-- Alternative Collection
3398-------------------------------------------------------------------------------
3401-- | @choice parsers@ applies the @parsers@ in order and returns the first
3404-- This is same as 'asum' but more efficient.
3408{-# INLINE choice #-}
3409choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b
3410choice = foldl1 shortest
3413-------------------------------------------------------------------------------
3414-- Sequential Repetition
3415-------------------------------------------------------------------------------
3417-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the
3418-- results. Parsing stops or fails if the collecting parser stops or fails.
3423manyP :: -- MonadCatch m =>
3424 Parser a m b -> Parser b m c -> Parser a m c
3425manyP _p _f = undefined
3427-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
3428-- input stream and push the parse results to a downstream fold.
3430-- Stops: when the downstream fold stops or the parser fails.
3431-- Fails: never, produces zero or more results.
3433-- >>> many = Parser.countBetween 0 maxBound
3435-- Compare with 'Control.Applicative.many'.
3438many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3440-- many = countBetween 0 maxBound
3442-- Note: many1 would perhaps be a better name for this and consistent with
3443-- other names like takeWhile1. But we retain the name "some" for
3446-- | Collect one or more parses. Apply the supplied parser repeatedly on the
3447-- input stream and push the parse results to a downstream fold.
3449-- Stops: when the downstream fold stops or the parser fails.
3450-- Fails: if it stops without producing a single result.
3452-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)
3453-- >>> some = Parser.countBetween 1 maxBound
3455-- Compare with 'Control.Applicative.some'.
3458some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3460-- some p f = manyP p (takeGE 1 f)
3461-- some = countBetween 1 maxBound
3463-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
3464-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
3465-- the input ends or the parser fails before @m@ results are collected.
3467-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)
3471{-# INLINE countBetween #-}
3472countBetween :: -- MonadCatch m =>
3473 Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
3474countBetween _m _n _p = undefined
3475-- countBetween m n p f = manyP p (takeBetween m n f)
3477-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
3478-- the fold @f@. Fails if the input ends or the parser fails before @n@
3479-- results are collected.
3481-- >>> count n = Parser.countBetween n n
3482-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)
3487count :: -- MonadCatch m =>
3488 Int -> Parser a m b -> Fold m b c -> Parser a m c
3489count n = countBetween n n
3490-- count n p f = manyP p (takeEQ n f)
3492-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a
3493-- 'Fold'. Parsing stops or fails if the collecting parser stops or fails.
3495-- We can implemnent parsers like the following using 'manyTillP':
3498-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p
3503{-# INLINE manyTillP #-}
3504manyTillP :: -- Monad m =>
3505 Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
3506manyTillP _p1 _p2 _f = undefined
3507 -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f
3509{-# ANN type ManyTillState Fuse #-}
3510data ManyTillState fs sr sl
3511 = ManyTillR !Int !fs !sr
3514-- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@
3515-- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is
3516-- tried again and so on. The parser stops when @test@ succeeds. The output of
3517-- @test@ is discarded and the output of @chunking@ is accumulated by the
3518-- supplied fold. The parser fails if @chunking@ fails.
3520-- Stops when the fold @f@ stops.
3522{-# INLINE manyTill #-}
3524 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3525manyTill (Parser stepL initialL extractL)
3526 (Parser stepR initialR _)
3527 (Fold fstep finitial fextract) =
3528 Parser step initial extract
3532 -- Caution: Mutual recursion
3534 scrutL fs p c d e = do
3537 IPartial sl -> return $ c (ManyTillL fs sl)
3541 FL.Partial fs1 -> scrutR fs1 p c d e
3542 FL.Done fb -> return $ d fb
3543 IError err -> return $ e err
3545 scrutR fs p c d e = do
3548 IPartial sr -> return $ p (ManyTillR 0 fs sr)
3549 IDone _ -> d <$> fextract fs
3550 IError _ -> scrutL fs p c d e
3555 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
3556 FL.Done b -> return $ IDone b
3558 step (ManyTillR cnt fs st) a = do
3561 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
3563 assertM(cnt + 1 - n >= 0)
3564 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
3572 return $ Continue (cnt + 1) (ManyTillL fs sl)
3584 FL.Done fb -> return $ Done cnt1 fb
3585 IError err -> return $ Error err
3586 step (ManyTillL fs st) a = do
3589 Partial n s -> return $ Partial n (ManyTillL fs s)
3590 Continue n s -> return $ Continue n (ManyTillL fs s)
3595 scrutR s (Partial n) (Continue n) (Done n) Error
3596 FL.Done b1 -> return $ Done n b1
3597 Error err -> return $ Error err
3599 extract (ManyTillL fs sR) = do
3605 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3606 FL.Done c -> return (Done n c)
3607 Error err -> return $ Error err
3608 Continue n s -> return $ Continue n (ManyTillL fs s)
3609 Partial _ _ -> error "Partial in extract"
3610 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs
3612-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
3613-- collects the output in the supplied fold. If the the parser @collect@ fails,
3614-- parser @recover@ is run until it stops and then we start repeating the
3615-- parser @collect@ again. The parser fails if the recovery parser fails.
3617-- For example, this can be used to find a key frame in a video stream after an
3622{-# INLINE manyThen #-}
3623manyThen :: -- (Foldable t, Monad m) =>
3624 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3625manyThen _parser _recover _f = undefined
3627-------------------------------------------------------------------------------
3628-- Repeated Alternatives
3629-------------------------------------------------------------------------------
3631-- | Keep trying a parser up to a maximum of @n@ failures. When the parser
3632-- fails the input consumed till now is dropped and the new instance is tried
3633-- on the fresh input.
3637{-# INLINE retryMaxTotal #-}
3638retryMaxTotal :: -- (Monad m) =>
3639 Int -> Parser a m b -> Fold m b c -> Parser a m c
3640retryMaxTotal _n _p _f = undefined
3642-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.
3646{-# INLINE retryMaxSuccessive #-}
3647retryMaxSuccessive :: -- (Monad m) =>
3648 Int -> Parser a m b -> Fold m b c -> Parser a m c
3649retryMaxSuccessive _n _p _f = undefined
3651-- | Keep trying a parser until it succeeds. When the parser fails the input
3652-- consumed till now is dropped and the new instance is tried on the fresh
3658retry :: -- (Monad m) =>
3659 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