3-- Module : Streamly.Internal.Data.Parser
4-- Copyright : (c) 2020 Composewell Technologies
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
10module Streamly.Internal.Data.Parser
21 -- * Downgrade to Fold
24 -- First order parsers
45 -- All of these can be expressed in terms of either
56 -- * Sequence parsers (tokenizers)
58 -- | Parsers chained in series, if one parser terminates the composition
59 -- terminates. Currently we are using folds to collect the output of the
60 -- parsers but we can use Parsers instead of folds to make the composition
61 -- more powerful. For example, we can do:
63 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
64 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
65 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
69 -- | Grab a sequence of input elements without inspecting them
71 -- , take -- takeBetween 0 n
72 , takeEQ -- takeBetween n n
73 , takeGE -- takeBetween n maxBound
74 -- , takeGE1 -- take1 -- takeBetween 1 n
77 -- Grab a sequence of input elements by inspecting them
90 -- ** Separated by elements
91 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
92 -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
93 -- separator parsing, also see 'intersperseQuotedBy' fold.
95 -- These can be implemented modularly with refolds, using takeWhile and
106 -- ** Grouped by element comparison
109 , groupByRollingEither
111 -- ** Framed by elements
112 -- | Also see 'intersperseQuotedBy' fold.
113 -- Framed by a one or more ocurrences of a separator around a word like
114 -- spaces or quotes. No nesting.
115 , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
120 -- Framed by separate start and end characters, potentially nested.
121 -- blockWithQuotes allows quotes inside a block. However,
122 -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and
123 -- block with escaping.
127 , takeFramedByGeneric
131 -- , prefixOf -- match any prefix of a given string
132 -- , suffixOf -- match any suffix of a given string
133 -- , infixOf -- match any substring of a given string
140 -- Second order parsers (parsers using parsers)
141 -- * Binary Combinators
143 -- ** Sequential Applicative
148 -- ** Parallel Applicatives
152 -- , teeTill -- like manyTill but parallel
155 -- ** Sequential Alternative
159 -- ** Parallel Alternatives
165 -- * N-ary Combinators
166 -- ** Sequential Collection
170 -- ** Sequential Repetition
173 -- , countBetweenTill
178 -- ** Interleaved Repetition
179 -- Use two folds, run a primary parser, its rejected values go to the
184 -- , deintercalatePrefix
185 -- , deintercalateSuffix
188 -- | TODO: traditional implmentations of these may be of limited use. For
189 -- example, consider parsing lines separated by @\\r\\n@. The main parser
190 -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
191 -- can apply the "sep" parser.
193 -- We can instead implement these as special cases of deintercalate.
212 -- A simple and stupid impl would be to just convert the stream to an array
213 -- and give the array reference to all consumers. The array can be grown on
214 -- demand by any consumer and truncated when nonbody needs it.
216 -- -- ** Distribute to collection
217 -- -- ** Distribute to repetition
219 -- ** Interleaved collection
226 -- -- ** Interleaved repetition
227 -- repeat one parser and when it fails run an error recovery parser
228 -- e.g. to find a key frame in the stream after an error
230 -- ** Collection of Alternatives
236 -- , fastestN -- first N successful in time
237 -- , choiceN -- first N successful in position
239 -- , choice -- first successful in position
241 -- ** Repeated Alternatives
261import Control.Monad (when)
262import Data.Bifunctor (first)
263import Fusion.Plugin.Types (Fuse(..))
264import Streamly.Internal.Data.Fold.Type (Fold(..))
265import Streamly.Internal.Data.SVar.Type (defState)
266import Streamly.Internal.Data.Either.Strict (Either'(..))
267import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
268import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
269import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
271import qualified Data.Foldable as Foldable
272import qualified Streamly.Internal.Data.Fold.Type as FL
273import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
274import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
277 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
278 , zip, filter, dropWhile)
279-- import Streamly.Internal.Data.Parser.ParserD.Tee
280import Streamly.Internal.Data.Parser.ParserD.Type
282#include "DocTestDataParser.hs"
284-------------------------------------------------------------------------------
285-- Downgrade a parser to a Fold
286-------------------------------------------------------------------------------
288-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the
289-- parser fails or tries to backtrack.
291-- This can be useful in combinators that accept a Fold and we know that a
292-- Parser cannot fail or failure exception is acceptable as there is no way to
298toFold :: Monad m => Parser a m b -> Fold m a b
299toFold (Parser pstep pinitial pextract) = Fold step initial extract
306 IPartial s -> return $ FL.Partial s
307 IDone b -> return $ FL.Done b
309 error $ "toFold: parser throws error in initial" ++ err
311 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
312 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
313 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
314 eerror err = error $ "toFold: parser throws error: " ++ err
319 Partial 0 s -> return $ FL.Partial s
320 Continue 0 s -> return $ FL.Partial s
321 Done 0 b -> return $ FL.Done b
322 Partial n _ -> perror n
323 Continue n _ -> cerror n
325 Error err -> eerror err
331 Partial n _ -> perror n
332 Continue n _ -> cerror n
334 Error err -> eerror err
336-------------------------------------------------------------------------------
337-- Upgrade folds to parses
338-------------------------------------------------------------------------------
340-- | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the
343{-# INLINE fromFold #-}
344fromFold :: Monad m => Fold m a b -> Parser a m b
345fromFold (Fold fstep finitial fextract) = Parser step initial extract
353 FL.Partial s1 -> IPartial s1
360 FL.Partial s1 -> Partial 0 s1
361 FL.Done b -> Done 0 b
363 extract = fmap (Done 0) . fextract
365-- | Convert a Maybe returning fold to an error returning parser. The first
366-- argument is the error message that the parser would return when the fold
371{-# INLINE fromFoldMaybe #-}
372fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b
373fromFoldMaybe errMsg (Fold fstep finitial fextract) =
374 Parser step initial extract
382 FL.Partial s1 -> IPartial s1
386 Nothing -> IError errMsg
392 FL.Partial s1 -> Partial 0 s1
396 Nothing -> Error errMsg
401 Just x -> return $ Done 0 x
402 Nothing -> return $ Error errMsg
404-------------------------------------------------------------------------------
406-------------------------------------------------------------------------------
408-- | Peek the head element of a stream, without consuming it. Fails if it
409-- encounters end of input.
411-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]
415-- peek = lookAhead (satisfy True)
419peek :: Monad m => Parser a m a
420peek = Parser step initial extract
424 initial = return $ IPartial ()
426 step () a = return $ Done 1 a
428 extract () = return $ Error "peek: end of input"
430-- | Succeeds if we are at the end of input, fails otherwise.
432-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]
436eof :: Monad m => Parser a m ()
437eof = Parser step initial extract
441 initial = return $ IPartial ()
443 step () _ = return $ Error "eof: not at end of input"
445 extract () = return $ Done 0 ()
447-- | Return the next element of the input. Returns 'Nothing'
448-- on end of input. Also known as 'head'.
452{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}
454next :: Monad m => Parser a m (Maybe a)
455next = Parser step initial extract
459 initial = pure $ IPartial ()
461 step () a = pure $ Done 0 (Just a)
463 extract () = pure $ Done 0 Nothing
465-- | Map an 'Either' returning function on the next element in the stream. If
466-- the function returns 'Left err', the parser fails with the error message
467-- @err@ otherwise returns the 'Right' value.
472either :: Monad m => (a -> Either String b) -> Parser a m b
473either f = Parser step initial extract
477 initial = return $ IPartial ()
482 Left err -> Error err
484 extract () = return $ Error "end of input"
486-- | Map a 'Maybe' returning function on the next element in the stream. The
487-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
490-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
491-- >>> maybe f = Parser.either (toEither . f)
493-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)
498maybe :: Monad m => (a -> Maybe b) -> Parser a m b
499-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
500maybe parserF = Parser step initial extract
504 initial = return $ IPartial ()
509 Nothing -> Error "maybe: predicate failed"
511 extract () = return $ Error "maybe: end of input"
513-- | Returns the next element if it passes the predicate, fails otherwise.
515-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]
518-- >>> toMaybe f x = if f x then Just x else Nothing
519-- >>> satisfy f = Parser.maybe (toMaybe f)
521{-# INLINE satisfy #-}
522satisfy :: Monad m => (a -> Bool) -> Parser a m a
523-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
524satisfy predicate = Parser step initial extract
528 initial = return $ IPartial ()
533 else Error "satisfy: predicate failed"
535 extract () = return $ Error "satisfy: end of input"
537-- | Consume one element from the head of the stream. Fails if it encounters
540-- >>> one = Parser.satisfy $ const True
543one :: Monad m => Parser a m a
544one = satisfy $ const True
546-- Alternate names: "only", "onlyThis".
548-- | Match a specific element.
550-- >>> oneEq x = Parser.satisfy (== x)
553oneEq :: (Monad m, Eq a) => a -> Parser a m a
554oneEq x = satisfy (== x)
556-- Alternate names: "exclude", "notThis".
558-- | Match anything other than the supplied element.
560-- >>> oneNotEq x = Parser.satisfy (/= x)
562{-# INLINE oneNotEq #-}
563oneNotEq :: (Monad m, Eq a) => a -> Parser a m a
564oneNotEq x = satisfy (/= x)
566-- | Match any one of the elements in the supplied list.
568-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)
570-- When performance matters a pattern matching predicate could be more
571-- efficient than a 'Foldable' datatype:
582-- GHC may use a binary search instead of linear search in the list.
583-- Alternatively, you can also use an array instead of list for storage and
587oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
588oneOf xs = satisfy (`Foldable.elem` xs)
590-- | See performance notes in 'oneOf'.
592-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)
595noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
596noneOf xs = satisfy (`Foldable.notElem` xs)
598-------------------------------------------------------------------------------
600-------------------------------------------------------------------------------
602-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
603{-# ANN type Tuple'Fused Fuse #-}
604data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
606-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input
607-- elements and folds them using the supplied fold.
609-- Stops after @n@ elements.
610-- Fails if the stream ends before @m@ elements could be taken.
616-- takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)
617-- where prsr = Parser.takeBetween low high Fold.toList
622-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]
625-- >>> takeBetween' 2 4 [1, 2]
628-- >>> takeBetween' 2 4 [1]
629-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")
631-- >>> takeBetween' 0 0 [1, 2]
634-- >>> takeBetween' 0 1 []
637-- @takeBetween@ is the most general take operation, other take operations can
638-- be defined in terms of takeBetween. For example:
640-- >>> take n = Parser.takeBetween 0 n
641-- >>> takeEQ n = Parser.takeBetween n n
642-- >>> takeGE n = Parser.takeBetween n maxBound
646{-# INLINE takeBetween #-}
647takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
648takeBetween low high (Fold fstep finitial fextract) =
650 Parser step initial (extract streamErr)
655 "takeBetween: Expecting alteast " ++ show low
656 ++ " elements, got " ++ show i
659 "takeBetween: lower bound - " ++ show low
660 ++ " is greater than higher bound - " ++ show high
662 foldErr :: Int -> String
664 "takeBetween: the collecting fold terminated after"
665 ++ " consuming" ++ show i ++ " elements"
666 ++ " minimum" ++ show low ++ " elements needed"
668 -- Exactly the same as snext except different constructors, we can possibly
669 -- deduplicate the two.
675 let s1 = Tuple'Fused i1 s
677 -- XXX ideally this should be a Continue instead
678 then return $ IPartial s1
679 else iextract foldErr s1
684 else IError (foldErr i1)
687 when (low >= 0 && high >= 0 && low > high)
690 finitial >>= inext (-1)
692 -- Keep the impl same as inext
698 let s1 = Tuple'Fused i1 s
700 then return $ Continue 0 s1
701 else extract foldErr s1
706 else Error (foldErr i1)
708 step (Tuple'Fused i s) a = fstep s a >>= snext i
710 extract f (Tuple'Fused i s)
711 | i >= low && i <= high = fmap (Done 0) (fextract s)
712 | otherwise = return $ Error (f i)
714 -- XXX Need to make Initial return type Step to deduplicate this
715 iextract f (Tuple'Fused i s)
716 | i >= low && i <= high = fmap IDone (fextract s)
717 | otherwise = return $ IError (f i)
719-- | Stops after taking exactly @n@ input elements.
721-- * Stops - after consuming @n@ elements.
722-- * Fails - if the stream or the collecting fold ends before it can collect
723-- exactly @n@ elements.
725-- >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]
728-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
729-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")
732takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
733takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
742 then return $ IPartial $ Tuple'Fused 1 s
743 else fmap IDone (fextract s)
744 FL.Done b -> return $
747 $ "takeEQ: Expecting exactly " ++ show n
748 ++ " elements, fold terminated without"
749 ++ " consuming any elements"
752 step (Tuple'Fused i1 r) a = do
758 FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s
761 $ "takeEQ: Expecting exactly " ++ show n
762 ++ " elements, fold terminated on " ++ show i1
767 FL.Partial s -> fextract s
768 FL.Done b -> return b
770 extract (Tuple'Fused i _) =
771 -- Using the count "i" in the message below causes large performance
772 -- regression unless we use Fuse annotation on Tuple.
775 $ "takeEQ: Expecting exactly " ++ show n
776 ++ " elements, input terminated on " ++ show (i - 1)
778{-# ANN type TakeGEState Fuse #-}
783-- | Take at least @n@ input elements, but can collect more.
785-- * Stops - when the collecting fold stops.
786-- * Fails - if the stream or the collecting fold ends before producing @n@
789-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
790-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")
792-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
798takeGE :: Monad m => Int -> Fold m a b -> Parser a m b
799takeGE n (Fold fstep finitial fextract) = Parser step initial extract
808 then return $ IPartial $ TakeGELT 1 s
809 else return $ IPartial $ TakeGEGE s
810 FL.Done b -> return $
813 $ "takeGE: Expecting at least " ++ show n
814 ++ " elements, fold terminated without"
815 ++ " consuming any elements"
818 step (TakeGELT i1 r) a = do
824 FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s
827 $ "takeGE: Expecting at least " ++ show n
828 ++ " elements, fold terminated on " ++ show i1
833 FL.Partial s -> Partial 0 $ TakeGEGE s
834 FL.Done b -> Done 0 b
835 step (TakeGEGE r) a = do
839 FL.Partial s -> Partial 0 $ TakeGEGE s
840 FL.Done b -> Done 0 b
842 extract (TakeGELT i _) =
845 $ "takeGE: Expecting at least " ++ show n
846 ++ " elements, input terminated on " ++ show (i - 1)
847 extract (TakeGEGE r) = fmap (Done 0) $ fextract r
849-------------------------------------------------------------------------------
850-- Conditional splitting
851-------------------------------------------------------------------------------
853-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.
855-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the
856-- input. The combinator stops when the condition fails or if the collecting
859-- Other interesting parsers can be implemented in terms of this parser:
861-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
862-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)
864-- Stops: when the condition fails or the collecting parser stops.
865-- Fails: when the collecting parser fails.
869{-# INLINE takeWhileP #-}
870takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
871takeWhileP predicate (Parser pstep pinitial pextract) =
872 Parser step pinitial pextract
881 -- XXX need a map on count
883 Error err -> return $ Error err
884 Done n s1 -> return $ Done (n + 1) s1
885 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
886 Continue n s1 -> return $ Continue (n + 1) s1
888-- | Collect stream elements until an element fails the predicate. The element
889-- on which the predicate fails is returned back to the input stream.
891-- * Stops - when the predicate fails or the collecting fold stops.
894-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]
897-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)
899-- We can implement a @breakOn@ using 'takeWhile':
902-- breakOn p = takeWhile (not p)
905{-# INLINE takeWhile #-}
906takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
907-- takeWhile cond f = takeWhileP cond (fromFold f)
908takeWhile predicate (Fold fstep finitial fextract) =
909 Parser step initial extract
916 FL.Partial s -> IPartial s
925 FL.Partial s1 -> Partial 0 s1
926 FL.Done b -> Done 0 b
927 else Done 1 <$> fextract s
929 extract s = fmap (Done 0) (fextract s)
932-- XXX This may not be composable because of the b argument. We can instead
933-- return a "Reparse b a m b" so that those can be composed.
934{-# INLINE takeWhile1X #-}
935takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b
936-- We can implement this using satisfy and takeWhile. We can use "satisfy
937-- p", fold the result with the refold and then use the "takeWhile p" and
938-- fold that using the refold.
939takeWhile1 acc cond f = undefined
942-- | Like 'takeWhile' but takes at least one element otherwise fails.
944-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
946{-# INLINE takeWhile1 #-}
947takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
948-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)
949takeWhile1 predicate (Fold fstep finitial fextract) =
950 Parser step initial extract
957 FL.Partial s -> IPartial (Left' s)
960 $ "takeWhile1: fold terminated without consuming:"
963 {-# INLINE process #-}
968 FL.Partial s1 -> Partial 0 (Right' s1)
969 FL.Done b -> Done 0 b
974 else return $ Error "takeWhile1: predicate failed on first element"
982 extract (Left' _) = return $ Error "takeWhile1: end of input"
983 extract (Right' s) = fmap (Done 0) (fextract s)
985-- | Drain the input as long as the predicate succeeds, running the effects and
986-- discarding the results.
988-- This is also called @skipWhile@ in some parsing libraries.
990-- >>> dropWhile p = Parser.takeWhile p Fold.drain
992{-# INLINE dropWhile #-}
993dropWhile :: Monad m => (a -> Bool) -> Parser a m ()
994dropWhile p = takeWhile p FL.drain
996-------------------------------------------------------------------------------
998-------------------------------------------------------------------------------
1000{-# ANN type FramedEscState Fuse #-}
1001data FramedEscState s =
1002 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
1004-- XXX We can remove Maybe from esc
1005{-# INLINE takeFramedByGeneric #-}
1006takeFramedByGeneric :: Monad m =>
1007 Maybe (a -> Bool) -- is escape char?
1008 -> Maybe (a -> Bool) -- is frame begin?
1009 -> Maybe (a -> Bool) -- is frame end?
1012takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
1014 Parser step initial extract
1022 FL.Partial s -> IPartial (FrameEscInit s)
1024 error "takeFramedByGeneric: fold done without input"
1026 {-# INLINE process #-}
1031 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1032 FL.Done b -> Done 0 b
1034 {-# INLINE processNoEsc #-}
1035 processNoEsc s a n =
1040 -- takeFramedBy case
1044 then Done 0 <$> fextract s
1045 else process s a (n - 1)
1047 let n1 = if isBegin a then n + 1 else n
1049 Nothing -> -- takeEndBy case
1051 then Done 0 <$> fextract s
1053 Nothing -> -- takeStartBy case
1057 then Done 0 <$> fextract s
1060 error $ "takeFramedByGeneric: "
1061 ++ "Both begin and end frame predicate missing"
1063 {-# INLINE processCheckEsc #-}
1064 processCheckEsc s a n =
1068 then return $ Partial 0 $ FrameEscEsc s n
1069 else processNoEsc s a n
1070 Nothing -> processNoEsc s a n
1072 step (FrameEscInit s) a =
1076 then return $ Partial 0 (FrameEscGo s 0)
1077 else return $ Error "takeFramedByGeneric: missing frame start"
1082 then Done 0 <$> fextract s
1083 else processCheckEsc s a 0
1085 error "Both begin and end frame predicate missing"
1086 step (FrameEscGo s n) a = processCheckEsc s a n
1087 step (FrameEscEsc s n) a = process s a n
1089 err = return . Error
1091 extract (FrameEscInit _) =
1092 err "takeFramedByGeneric: empty token"
1093 extract (FrameEscGo s _) =
1097 Nothing -> fmap (Done 0) $ fextract s
1098 Just _ -> err "takeFramedByGeneric: missing frame end"
1099 Nothing -> err "takeFramedByGeneric: missing closing frame"
1100 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1102data BlockParseState s =
1104 | BlockUnquoted !Int !s
1105 | BlockQuoted !Int !s
1106 | BlockQuotedEsc !Int !s
1108-- Blocks can be of different types e.g. {} or (). We only parse from the
1109-- perspective of the outermost block type. The nesting of that block are
1110-- checked. Any other block types nested inside it are opaque to us and can be
1111-- parsed when the contents of the block are parsed.
1113-- XXX Put a limit on nest level to keep the API safe.
1115-- | Parse a block enclosed within open, close brackets. Block contents may be
1116-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1117-- within quotes if escaped. A block can have a nested block inside it.
1119-- Quote begin and end chars are the same. Block brackets and quote chars must
1120-- not overlap. Block start and end brackets must be different for nesting
1121-- blocks within blocks.
1123-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1124-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1125-- Right "msg: \"hello world\""
1127{-# INLINE blockWithQuotes #-}
1128blockWithQuotes :: (Monad m, Eq a) =>
1129 (a -> Bool) -- ^ escape char
1130 -> (a -> Bool) -- ^ quote char, to quote inside brackets
1131 -> a -- ^ Block opening bracket
1132 -> a -- ^ Block closing bracket
1135blockWithQuotes isEsc isQuote bopen bclose
1136 (Fold fstep finitial fextract) =
1137 Parser step initial extract
1145 FL.Partial s -> IPartial (BlockInit s)
1147 error "blockWithQuotes: fold finished without input"
1149 {-# INLINE process #-}
1150 process s a nextState = do
1154 FL.Partial s1 -> Continue 0 (nextState s1)
1155 FL.Done b -> Done 0 b
1157 step (BlockInit s) a =
1160 then Continue 0 $ BlockUnquoted 1 s
1161 else Error "blockWithQuotes: missing block start"
1162 step (BlockUnquoted level s) a
1163 | a == bopen = process s a (BlockUnquoted (level + 1))
1166 then fmap (Done 0) (fextract s)
1167 else process s a (BlockUnquoted (level - 1))
1168 | isQuote a = process s a (BlockQuoted level)
1169 | otherwise = process s a (BlockUnquoted level)
1170 step (BlockQuoted level s) a
1171 | isEsc a = process s a (BlockQuotedEsc level)
1174 then process s a (BlockUnquoted level)
1175 else process s a (BlockQuoted level)
1176 step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1178 err = return . Error
1180 extract (BlockInit s) = fmap (Done 0) $ fextract s
1181 extract (BlockUnquoted level _) =
1182 err $ "blockWithQuotes: finished at block nest level " ++ show level
1183 extract (BlockQuoted level _) =
1184 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1185 ++ "at block nest level " ++ show level
1186 extract (BlockQuotedEsc level _) =
1187 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1188 ++ "after an escape char, at block nest level " ++ show level
1190-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1191-- the supplied predicate. The separator is also taken with the token.
1193-- This can be combined with other parsers to implement other interesting
1194-- parsers as follows:
1196-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)
1197-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)
1199-- >>> takeEndBy = Parser.takeEndByEsc (const False)
1201-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting
1202-- parser in the takeEndBy parser can decide whether to fail or not if the
1203-- stream does not end with separator.
1207{-# INLINE takeEndBy #-}
1208takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
1209-- takeEndBy = takeEndByEsc (const False)
1210takeEndBy cond (Parser pstep pinitial pextract) =
1212 Parser step initial pextract
1222 else extractStep pextract res
1224-- | Like 'takeEndBy' but the separator elements can be escaped using an
1225-- escape char determined by the first predicate. The escape characters are
1229{-# INLINE takeEndByEsc #-}
1230takeEndByEsc :: Monad m =>
1231 (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
1232takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
1234 Parser step initial extract
1238 initial = first Left' <$> pinitial
1240 step (Left' s) a = do
1242 then return $ Partial 0 $ Right' s
1246 then return $ first Left' res
1247 else fmap (first Left') $ extractStep pextract res
1249 step (Right' s) a = do
1251 return $ first Left' res
1253 extract (Left' s) = fmap (first Left') $ pextract s
1254 extract (Right' _) =
1255 return $ Error "takeEndByEsc: trailing escape"
1257-- | Like 'takeEndBy' but the separator is dropped.
1259-- See also "Streamly.Data.Fold.takeEndBy_".
1263{-# INLINE takeEndBy_ #-}
1264takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b
1267 takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)
1269takeEndBy_ cond (Parser pstep pinitial pextract) =
1271 Parser step pinitial pextract
1280-- | Take either the separator or the token. Separator is a Left value and
1281-- token is Right value.
1284{-# INLINE takeEitherSepBy #-}
1285takeEitherSepBy :: -- Monad m =>
1286 (a -> Bool) -> Fold m (Either a b) c -> Parser a m c
1287takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond
1289-- | Parse a token that starts with an element chosen by the predicate. The
1290-- parser fails if the input does not start with the selected element.
1292-- * Stops - when the predicate succeeds in non-leading position.
1293-- * Fails - when the predicate fails in the leading position.
1295-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)
1299-- >>> p = Parser.takeStartBy (== ',') Fold.toList
1300-- >>> leadingComma = Stream.parse p . Stream.fromList
1301-- >>> leadingComma "a,b"
1302-- Left (ParseError "takeStartBy: missing frame start")
1304-- >>> leadingComma ",,"
1306-- >>> leadingComma ",a,b"
1308-- >>> leadingComma ""
1313{-# INLINE takeStartBy #-}
1314takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1315takeStartBy cond (Fold fstep finitial fextract) =
1317 Parser step initial extract
1325 FL.Partial s -> IPartial (Left' s)
1326 FL.Done _ -> IError "takeStartBy: fold done without input"
1328 {-# INLINE process #-}
1333 FL.Partial s1 -> Partial 0 (Right' s1)
1334 FL.Done b -> Done 0 b
1339 else return $ Error "takeStartBy: missing frame start"
1343 else Done 1 <$> fextract s
1345 extract (Left' s) = fmap (Done 0) $ fextract s
1346 extract (Right' s) = fmap (Done 0) $ fextract s
1348-- | Like 'takeStartBy' but drops the separator.
1350-- >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing
1352{-# INLINE takeStartBy_ #-}
1353takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1354takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing
1356-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a
1357-- begin and end predicate, and an escape character. The frame begin and end
1358-- characters lose their special meaning if preceded by the escape character.
1360-- Nested frames are allowed if begin and end markers are different, nested
1361-- frames must be balanced unless escaped, nested frame markers are emitted as
1366-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList
1367-- >>> Stream.parse p $ Stream.fromList "{hello}"
1369-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"
1370-- Right "hello {world}"
1371-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
1372-- Right "hello {world"
1373-- >>> Stream.parse p $ Stream.fromList "{hello {world}"
1374-- Left (ParseError "takeFramedByEsc_: missing frame end")
1377{-# INLINE takeFramedByEsc_ #-}
1378takeFramedByEsc_ :: Monad m =>
1379 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1380-- takeFramedByEsc_ isEsc isEnd p =
1381-- takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)
1382takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
1384 Parser step initial extract
1392 FL.Partial s -> IPartial (FrameEscInit s)
1394 error "takeFramedByEsc_: fold done without input"
1396 {-# INLINE process #-}
1401 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1402 FL.Done b -> Done 0 b
1404 step (FrameEscInit s) a =
1406 then return $ Partial 0 (FrameEscGo s 0)
1407 else return $ Error "takeFramedByEsc_: missing frame start"
1408 step (FrameEscGo s n) a =
1410 then return $ Partial 0 $ FrameEscEsc s n
1414 let n1 = if isBegin a then n + 1 else n
1418 then Done 0 <$> fextract s
1419 else process s a (n - 1)
1420 step (FrameEscEsc s n) a = process s a n
1422 err = return . Error
1424 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1425 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1426 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1428data FramedState s = FrameInit !s | FrameGo !s Int
1430-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an
1433-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)
1435{-# INLINE takeFramedBy_ #-}
1436takeFramedBy_ :: Monad m =>
1437 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1438-- takeFramedBy_ isBegin isEnd =
1439-- takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)
1440takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
1442 Parser step initial extract
1450 FL.Partial s -> IPartial (FrameInit s)
1452 error "takeFramedBy_: fold done without input"
1454 {-# INLINE process #-}
1459 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1460 FL.Done b -> Done 0 b
1462 step (FrameInit s) a =
1464 then return $ Continue 0 (FrameGo s 0)
1465 else return $ Error "takeFramedBy_: missing frame start"
1466 step (FrameGo s n) a
1468 let n1 = if isBegin a then n + 1 else n
1470 | n == 0 = Done 0 <$> fextract s
1471 | otherwise = process s a (n - 1)
1473 err = return . Error
1475 extract (FrameInit _) = err "takeFramedBy_: empty token"
1476 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1478-------------------------------------------------------------------------------
1479-- Grouping and words
1480-------------------------------------------------------------------------------
1482data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1484-- Note we can also get words using something like:
1485-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)
1487-- But that won't be as efficient and ergonomic.
1489-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
1490-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
1491-- @["a","b"]@. In other words, its like parsing words from whitespace
1494-- * Stops - when it finds a word separator after a non-word element
1497-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)
1500-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)
1503{-# INLINE wordBy #-}
1504wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1505wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1509 {-# INLINE worder #-}
1514 FL.Partial s1 -> Partial 0 $ WBWord s1
1515 FL.Done b -> Done 0 b
1521 FL.Partial s -> IPartial $ WBLeft s
1522 FL.Done b -> IDone b
1525 if not (predicate a)
1527 else return $ Partial 0 $ WBLeft s
1529 if not (predicate a)
1533 return $ Partial 0 $ WBRight b
1534 step (WBRight b) a =
1536 $ if not (predicate a)
1538 else Partial 0 $ WBRight b
1540 extract (WBLeft s) = fmap (Done 0) $ fextract s
1541 extract (WBWord s) = fmap (Done 0) $ fextract s
1542 extract (WBRight b) = return (Done 0 b)
1544data WordFramedState s b =
1545 WordFramedSkipPre !s
1546 | WordFramedWord !s !Int
1547 | WordFramedEsc !s !Int
1548 | WordFramedSkipPost !b
1550-- | Like 'wordBy' but treats anything inside a pair of quotes as a single
1551-- word, the quotes can be escaped by an escape character. Recursive quotes
1552-- are possible if quote begin and end characters are different, quotes must be
1553-- balanced. Outermost quotes are stripped.
1555-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList
1556-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"
1558-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"
1560-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"
1562-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"
1565-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList
1566-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""
1569{-# INLINE wordFramedBy #-}
1570wordFramedBy :: Monad m =>
1571 (a -> Bool) -- ^ Matches escape elem?
1572 -> (a -> Bool) -- ^ Matches left quote?
1573 -> (a -> Bool) -- ^ matches right quote?
1574 -> (a -> Bool) -- ^ matches word separator?
1577wordFramedBy isEsc isBegin isEnd isSep
1578 (Fold fstep finitial fextract) =
1579 Parser step initial extract
1587 FL.Partial s -> IPartial (WordFramedSkipPre s)
1589 error "wordFramedBy: fold done without input"
1591 {-# INLINE process #-}
1596 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1597 FL.Done b -> Done 0 b
1599 step (WordFramedSkipPre s) a
1600 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1601 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1602 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1604 return $ Error "wordFramedBy: missing frame start"
1605 | otherwise = process s a 0
1606 step (WordFramedWord s n) a
1607 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1608 | n == 0 && isSep a = do
1610 return $ Partial 0 $ WordFramedSkipPost b
1612 -- We need to use different order for checking begin and end for
1613 -- the n == 0 and n == 1 case so that when the begin and end
1614 -- character is the same we treat the one after begin as end.
1617 -- Need to check isBegin first
1619 then return $ Continue 0 $ WordFramedWord s 1
1621 then return $ Error "wordFramedBy: missing frame start"
1624 -- Need to check isEnd first
1628 then return $ Continue 0 $ WordFramedWord s 0
1629 else process s a (n - 1)
1631 then process s a (n + 1)
1633 step (WordFramedEsc s n) a = process s a n
1634 step (WordFramedSkipPost b) a =
1638 else Partial 0 $ WordFramedSkipPost b
1640 err = return . Error
1642 extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s
1643 extract (WordFramedWord s n) =
1645 then fmap (Done 0) $ fextract s
1646 else err "wordFramedBy: missing frame end"
1647 extract (WordFramedEsc _ _) =
1648 err "wordFramedBy: trailing escape"
1649 extract (WordFramedSkipPost b) = return (Done 0 b)
1651data WordQuotedState s b a =
1652 WordQuotedSkipPre !s
1653 | WordUnquotedWord !s
1654 | WordQuotedWord !s !Int !a !a
1655 | WordUnquotedEsc !s
1656 | WordQuotedEsc !s !Int !a !a
1657 | WordQuotedSkipPost !b
1659-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
1660-- word separators within specified quotes or brackets are ignored. Quotes and
1661-- escape characters can be processed. If the end quote is different from the
1662-- start quote it is called a bracket. The following quoting rules apply:
1664-- * In an unquoted string a character may be preceded by an escape character.
1665-- The escape character is removed and the character following it is treated
1666-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
1668-- * Any part of the word can be placed within quotes. Inside quotes all
1669-- characters are treated literally with no special meaning. Quoting character
1670-- itself cannot be used within quotes unless escape processing within quotes
1671-- is applied to allow it.
1672-- * Optionally escape processing for quoted part can be specified. Escape
1673-- character has no special meaning inside quotes unless it is followed by a
1674-- character that has a escape translation specified, in that case the escape
1675-- character is removed, and the specified translation is applied to the
1676-- character following it. This can be used to escape the quoting character
1677-- itself within quotes.
1678-- * There can be multiple quoting characters, when a quote starts, all other
1679-- quoting characters within that quote lose any special meaning until the
1681-- * A starting quote char without an ending char generates a parse error. An
1682-- ending bracket char without a corresponding bracket begin is ignored.
1683-- * Brackets can be nested.
1685-- We should note that unquoted and quoted escape processing are different. In
1686-- unquoted part escape character is always removed. In quoted part it is
1687-- removed only if followed by a special meaning character. This is consistent
1688-- with how shell performs escape processing.
1690-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
1691-- ((nested) brackets).
1699-- >>> '\'' -> Just x
1703-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
1704-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1705-- Right "a\"b'c\";'d\"e'f"
1707-- Note that outer quotes and backslashes from the input string are consumed by
1708-- Haskell, therefore, the actual input string passed to the parser is:
1711-- Similarly, when printing, double quotes are escaped by Haskell.
1715-- Shell like quote processing can be performed by using quote char specific
1716-- escape processing, single quotes with no escapes, and double quotes with
1719-- JSON string processing can also be achieved except the "\uXXXX" style
1720-- escaping for Unicode characters.
1722{-# INLINE wordWithQuotes #-}
1723wordWithQuotes :: (Monad m, Eq a) =>
1724 Bool -- ^ Retain the quotes and escape chars in the output
1725 -> (a -> a -> Maybe a) -- ^ quote char -> escaped char -> translated char
1726 -> a -- ^ Matches an escape elem?
1727 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1728 -> (a -> Bool) -- ^ Matches a word separator?
1731wordWithQuotes keepQuotes tr escChar toRight isSep
1732 (Fold fstep finitial fextract) =
1733 Parser step initial extract
1737 -- Can be used to generate parse error for a bracket end without a bracket
1739 isInvalid = const False
1741 isEsc = (== escChar)
1747 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1749 error "wordKeepQuotes: fold done without input"
1751 {-# INLINE processQuoted #-}
1752 processQuoted s a n ql qr = do
1756 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)
1757 FL.Done b -> Done 0 b
1759 {-# INLINE processUnquoted #-}
1760 processUnquoted s a = do
1764 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1765 FL.Done b -> Done 0 b
1767 step (WordQuotedSkipPre s) a
1768 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1769 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1774 then processQuoted s a 1 a qr
1775 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1778 return $ Error "wordKeepQuotes: invalid unquoted char"
1779 | otherwise -> processUnquoted s a
1780 step (WordUnquotedWord s) a
1781 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1784 return $ Partial 0 $ WordQuotedSkipPost b
1789 then processQuoted s a 1 a qr
1790 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1793 then return $ Error "wordKeepQuotes: invalid unquoted char"
1794 else processUnquoted s a
1795 step (WordQuotedWord s n ql qr) a
1796 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr
1798 -- XXX Will this ever occur? Will n ever be 0?
1799 | n == 0 && isSep a = do
1801 return $ Partial 0 $ WordQuotedSkipPost b
1808 then processUnquoted s a
1809 else return $ Continue 0 $ WordUnquotedWord s
1810 else processQuoted s a (n - 1) ql qr
1812 then processQuoted s a (n + 1) ql qr
1813 else processQuoted s a n ql qr
1814 step (WordUnquotedEsc s) a = processUnquoted s a
1815 step (WordQuotedEsc s n ql qr) a =
1818 res <- fstep s escChar
1820 FL.Partial s1 -> processQuoted s1 a n ql qr
1821 FL.Done b -> return $ Done 0 b
1822 Just x -> processQuoted s x n ql qr
1823 step (WordQuotedSkipPost b) a =
1827 else Partial 0 $ WordQuotedSkipPost b
1829 err = return . Error
1831 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1832 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1833 extract (WordQuotedWord s n _ _) =
1835 then fmap (Done 0) $ fextract s
1836 else err "wordWithQuotes: missing frame end"
1837 extract WordQuotedEsc {} =
1838 err "wordWithQuotes: trailing escape"
1839 extract (WordUnquotedEsc _) =
1840 err "wordWithQuotes: trailing escape"
1841 extract (WordQuotedSkipPost b) = return (Done 0 b)
1843-- | 'wordWithQuotes' without processing the quotes and escape function
1844-- supplied to escape the quote char within a quote. Can be used to parse words
1845-- keeping the quotes and escapes intact.
1847-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
1849{-# INLINE wordKeepQuotes #-}
1850wordKeepQuotes :: (Monad m, Eq a) =>
1852 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1853 -> (a -> Bool) -- ^ Matches a word separator?
1857 -- Escape the quote char itself
1858 wordWithQuotes True (\q x -> if q == x then Just x else Nothing)
1860-- See the "Quoting Rules" section in the "bash" manual page for a primer on
1861-- how quotes are used by shells.
1863-- | 'wordWithQuotes' with quote processing applied and escape function
1864-- supplied to escape the quote char within a quote. Can be ysed to parse words
1865-- and processing the quoting and escaping at the same time.
1867-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
1869{-# INLINE wordProcessQuotes #-}
1870wordProcessQuotes :: (Monad m, Eq a) =>
1872 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1873 -> (a -> Bool) -- ^ Matches a word separator?
1877 -- Escape the quote char itself
1878 wordWithQuotes False (\q x -> if q == x then Just x else Nothing)
1880{-# ANN type GroupByState Fuse #-}
1881data GroupByState a s
1883 | GroupByGrouping !a !s
1885-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
1886-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1887-- 'True' @b@ is also assigned to the same group. If @a \`cmp` c@ is 'True'
1888-- then @c@ is also assigned to the same group and so on. When the comparison
1889-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1890-- the result of the fold is the result of the parser.
1892-- * Stops - when the comparison fails.
1897-- Stream.fold Fold.toList
1898-- . Stream.parseMany (Parser.groupBy eq Fold.toList)
1902-- >>> runGroupsBy (<) []
1905-- >>> runGroupsBy (<) [1]
1908-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]
1909-- [Right [3,5,4],Right [1,2],Right [0]]
1911{-# INLINE groupBy #-}
1912groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1913groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1917 {-# INLINE grouper #-}
1922 FL.Done b -> Done 0 b
1923 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1929 FL.Partial s -> IPartial $ GroupByInit s
1930 FL.Done b -> IDone b
1932 step (GroupByInit s) a = grouper s a a
1933 step (GroupByGrouping a0 s) a =
1936 else Done 1 <$> fextract s
1938 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1939 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1941-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
1942-- successive elements in the input stream. Assuming the input stream
1943-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser
1944-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1945-- 'True' @b@ is also assigned to the same group. If @b \`cmp` c@ is 'True'
1946-- then @c@ is also assigned to the same group and so on. When the comparison
1947-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1948-- the result of the fold is the result of the parser.
1950-- * Stops - when the comparison fails.
1954-- runGroupsByRolling eq =
1955-- Stream.fold Fold.toList
1956-- . Stream.parseMany (Parser.groupByRolling eq Fold.toList)
1960-- >>> runGroupsByRolling (<) []
1963-- >>> runGroupsByRolling (<) [1]
1966-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]
1967-- [Right [3,5],Right [4],Right [1,2],Right [0]]
1971{-# INLINE groupByRolling #-}
1972groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1973groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1977 {-# INLINE grouper #-}
1982 FL.Done b -> Done 0 b
1983 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1989 FL.Partial s -> IPartial $ GroupByInit s
1990 FL.Done b -> IDone b
1992 step (GroupByInit s) a = grouper s a
1993 step (GroupByGrouping a0 s) a =
1996 else Done 1 <$> fextract s
1998 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1999 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
2001{-# ANN type GroupByStatePair Fuse #-}
2002data GroupByStatePair a s1 s2
2003 = GroupByInitPair !s1 !s2
2004 | GroupByGroupingPair !a !s1 !s2
2005 | GroupByGroupingPairL !a !s1 !s2
2006 | GroupByGroupingPairR !a !s1 !s2
2008-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
2009-- the first fold as long as the predicate holds 'True', if the predicate is
2010-- 'False' collects using the second fold as long as it remains 'False'.
2011-- Returns 'Left' for the first case and 'Right' for the second case.
2013-- For example, if we want to detect sorted sequences in a stream, both
2014-- ascending and descending cases we can use 'groupByRollingEither (<=)
2015-- Fold.toList Fold.toList'.
2018{-# INLINE groupByRollingEither #-}
2019groupByRollingEither :: Monad m =>
2020 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)
2023 (Fold fstep1 finitial1 fextract1)
2024 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
2028 {-# INLINE grouper #-}
2029 grouper s1 s2 a = do
2030 return $ Continue 0 (GroupByGroupingPair a s1 s2)
2032 {-# INLINE grouperL2 #-}
2033 grouperL2 s1 s2 a = do
2037 FL.Done b -> Done 0 (Left b)
2038 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
2040 {-# INLINE grouperL #-}
2041 grouperL s1 s2 a0 a = do
2044 FL.Done b -> return $ Done 0 (Left b)
2045 FL.Partial s11 -> grouperL2 s11 s2 a
2047 {-# INLINE grouperR2 #-}
2048 grouperR2 s1 s2 a = do
2052 FL.Done b -> Done 0 (Right b)
2053 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
2055 {-# INLINE grouperR #-}
2056 grouperR s1 s2 a0 a = do
2059 FL.Done b -> return $ Done 0 (Right b)
2060 FL.Partial s21 -> grouperR2 s1 s21 a
2069 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
2070 FL.Done b -> IDone (Right b)
2071 FL.Done b -> IDone (Left b)
2073 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
2075 step (GroupByGroupingPair a0 s1 s2) a =
2077 then grouperL s1 s2 a0 a
2078 else grouperR s1 s2 a0 a
2080 step (GroupByGroupingPairL a0 s1 s2) a =
2082 then grouperL2 s1 s2 a
2083 else Done 1 . Left <$> fextract1 s1
2085 step (GroupByGroupingPairR a0 s1 s2) a =
2087 then grouperR2 s1 s2 a
2088 else Done 1 . Right <$> fextract2 s2
2090 extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1
2091 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1
2092 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2
2093 extract (GroupByGroupingPair a s1 _) = do
2096 FL.Done b -> return $ Done 0 (Left b)
2097 FL.Partial s11 -> Done 0 . Left <$> fextract1 s11
2099-- XXX use an Unfold instead of a list?
2100-- XXX custom combinators for matching list, array and stream?
2101-- XXX rename to listBy?
2103-- | Match the given sequence of elements using the given comparison function.
2104-- Returns the original sequence if successful.
2108-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs
2112-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"
2115-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
2116-- Left (ParseError "streamEqBy: mismtach occurred")
2118{-# INLINE listEqBy #-}
2119listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
2120listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs
2122listEqBy cmp str = Parser step initial extract
2126 -- XXX Should return IDone in initial for [] case
2127 initial = return $ IPartial str
2129 step [] _ = return $ Done 0 str
2134 else Error "listEqBy: failed, yet to match the last element"
2140 $ "listEqBy: failed, yet to match "
2141 ++ show (length xs + 1) ++ " elements"
2146 $ "listEqBy: end of input, yet to match "
2147 ++ show (length xs) ++ " elements"
2150{-# INLINE streamEqByInternal #-}
2151streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2152streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract
2157 r <- sstep defState state
2159 D.Yield x s -> return $ IPartial (Just' x, s)
2160 D.Stop -> return $ IDone ()
2161 -- Need Skip/Continue in initial to loop right here
2162 D.Skip s -> return $ IPartial (Nothing', s)
2164 step (Just' x, st) a =
2167 r <- sstep defState st
2170 D.Yield x1 s -> Continue 0 (Just' x1, s)
2172 D.Skip s -> Continue 1 (Nothing', s)
2173 else return $ Error "streamEqBy: mismtach occurred"
2174 step (Nothing', st) a = do
2175 r <- sstep defState st
2180 then Continue 0 (Nothing', s)
2181 else Error "streamEqBy: mismatch occurred"
2183 D.Skip s -> Continue 1 (Nothing', s)
2185 extract _ = return $ Error "streamEqBy: end of input"
2187-- | Like 'listEqBy' but uses a stream instead of a list and does not return
2190{-# INLINE streamEqBy #-}
2191streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2192-- XXX Somehow composing this with "*>" is much faster on the microbenchmark.
2193-- Need to investigate why.
2194streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()
2197-- | Match the input sequence with the supplied list and return it if
2200-- >>> listEq = Parser.listEqBy (==)
2202{-# INLINE listEq #-}
2203listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]
2204listEq = listEqBy (==)
2206-- | Match if the input stream is a subsequence of the argument stream i.e. all
2207-- the elements of the input stream occur, in order, in the argument stream.
2208-- The elements do not have to occur consecutively. A sequence is considered a
2209-- subsequence of itself.
2210{-# INLINE subsequenceBy #-}
2211subsequenceBy :: -- Monad m =>
2212 (a -> a -> Bool) -> Stream m a -> Parser a m ()
2213subsequenceBy = undefined
2216-- Should go in Data.Parser.Regex in streamly package so that it can depend on
2218{-# INLINE regexPosix #-}
2219regexPosix :: -- Monad m =>
2220 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2221regexPosix = undefined
2223{-# INLINE regexPCRE #-}
2224regexPCRE :: -- Monad m =>
2225 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2226regexPCRE = undefined
2229-------------------------------------------------------------------------------
2230-- Transformations on input
2231-------------------------------------------------------------------------------
2233-- Initial needs a "Continue" constructor to implement scans on parsers. As a
2234-- parser can always return a Continue in initial when we feed the fold's
2235-- initial result to it. We can work this around for postscan by introducing an
2236-- initial state and calling "initial" only on the first input.
2238-- | Stateful scan on the input of a parser using a Fold.
2242{-# INLINE postscan #-}
2243postscan :: -- Monad m =>
2244 Fold m a b -> Parser b m c -> Parser a m c
2247{-# INLINE zipWithM #-}
2248zipWithM :: Monad m =>
2249 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x
2250zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
2251 Parser step initial extract
2259 r <- sstep defState state
2261 D.Yield x s -> return $ IPartial (Just' x, s, fs)
2265 -- Need Skip/Continue in initial to loop right here
2266 D.Skip s -> return $ IPartial (Nothing', s, fs)
2267 FL.Done x -> return $ IDone x
2269 step (Just' a, st, fs) b = do
2273 FL.Partial fs1 -> do
2274 r <- sstep defState st
2276 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
2280 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
2281 FL.Done x -> return $ Done 0 x
2282 step (Nothing', st, fs) b = do
2283 r <- sstep defState st
2290 return $ Continue 0 (Nothing', s, fs1)
2291 FL.Done x -> return $ Done 0 x
2295 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
2297 extract _ = return $ Error "zipWithM: end of input"
2299-- | Zip the input of a fold with a stream.
2304zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x
2305zip = zipWithM (curry return)
2307-- | Pair each element of a fold input with its index, starting from index 0.
2310{-# INLINE indexed #-}
2311indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b
2312indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
2314-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
2315-- function using a fold indexing function that attaches an index to each input
2316-- element and a filtering function that filters using @(index, element) ->
2317-- Bool) as predicate.
2322-- filterWithIndex = makeIndexFilter indexed filter
2323-- filterWithAbsTime = makeIndexFilter timestamped filter
2324-- filterWithRelTime = makeIndexFilter timeIndexed filter
2328{-# INLINE makeIndexFilter #-}
2330 (Fold m (s, a) b -> Parser a m b)
2331 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
2332 -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)
2333makeIndexFilter f comb g = f . comb g . FL.lmap snd
2335-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
2336-- then every element at strides of @stride@.
2339{-# INLINE sampleFromthen #-}
2340sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
2341sampleFromthen offset size =
2342 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
2344--------------------------------------------------------------------------------
2346--------------------------------------------------------------------------------
2348-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
2349-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
2353-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
2355-- > span_ (< 1) [1,2,3]
2358-- > span_ (< 2) [1,2,3]
2361-- > span_ (< 4) [1,2,3]
2368span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2369span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
2371-- | Break the input stream into two groups, the first group takes the input as
2372-- long as the predicate applied to the first element of the stream and next
2373-- input element holds 'True', the second group takes the rest of the input.
2377{-# INLINE spanBy #-}
2380 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2381spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
2383-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
2384-- predicate is applied to the previous and the next input elements.
2387{-# INLINE spanByRolling #-}
2390 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2391spanByRolling eq f1 f2 =
2392 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
2394-------------------------------------------------------------------------------
2396-------------------------------------------------------------------------------
2398-- | Takes at-most @n@ input elements.
2400-- * Stops - when the collecting parser stops.
2401-- * Fails - when the collecting parser fails.
2403-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2406-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2407-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")
2411takeP :: Monad m => Int -> Parser a m b -> Parser a m b
2412takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
2421 then return $ IPartial $ Tuple' 0 s
2423 IDone b -> return $ IDone b
2424 IError e -> return $ IError e
2426 step (Tuple' cnt r) a = do
2434 then return $ Partial 0 $ Tuple' cnt1 s
2438 Done n b -> Done n b
2439 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2440 Error err -> Error err
2441 Partial _ _ -> error "takeP: Partial in extract"
2446 then return $ Continue 0 $ Tuple' cnt1 s
2450 Done n b -> Done n b
2451 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2452 Error err -> Error err
2453 Partial _ _ -> error "takeP: Partial in extract"
2455 let taken = cnt1 - n
2457 return $ Partial n $ Tuple' taken s
2459 let taken = cnt1 - n
2461 return $ Continue n $ Tuple' taken s
2462 Done n b -> return $ Done n b
2463 Error str -> return $ Error str
2465 extract (Tuple' cnt r) = do
2468 Done n b -> Done n b
2469 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
2470 Error err -> Error err
2471 Partial _ _ -> error "takeP: Partial in extract"
2473 -- XXX Need to make the Initial type Step to remove this
2478 Error err -> IError err
2479 _ -> error "Bug: takeP invalid state in initial"
2481-- | Run a parser without consuming the input.
2483{-# INLINE lookAhead #-}
2484lookAhead :: Monad m => Parser a m b -> Parser a m b
2485lookAhead (Parser step1 initial1 _) = Parser step initial extract
2491 return $ case res of
2492 IPartial s -> IPartial (Tuple'Fused 0 s)
2494 IError e -> IError e
2496 step (Tuple'Fused cnt st) a = do
2501 Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2502 Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2503 Done _ b -> Done cnt1 b
2504 Error err -> Error err
2506 -- XXX returning an error let's us backtrack. To implement it in a way so
2507 -- that it terminates on eof without an error then we need a way to
2508 -- backtrack on eof, that will require extract to return 'Step' type.
2509 extract (Tuple'Fused n _) =
2512 $ "lookAhead: end of input after consuming "
2513 ++ show n ++ " elements"
2515-------------------------------------------------------------------------------
2517-------------------------------------------------------------------------------
2519-- To deinterleave we can chain two parsers one behind the other. The input is
2520-- given to the first parser and the input definitively rejected by the first
2521-- parser is given to the second parser.
2523-- We can either have the parsers themselves buffer the input or use the shared
2524-- global buffer to hold it until none of the parsers need it. When the first
2525-- parser returns Skip (i.e. rewind) we let the second parser consume the
2526-- rejected input and when it is done we move the cursor forward to the first
2527-- parser again. This will require a "move forward" command as well.
2529-- To implement grep we can use three parsers, one to find the pattern, one
2530-- to store the context behind the pattern and one to store the context in
2531-- front of the pattern. When a match occurs we need to emit the accumulator of
2532-- all the three parsers. One parser can count the line numbers to provide the
2535{-# ANN type DeintercalateAllState Fuse #-}
2536data DeintercalateAllState fs sp ss =
2537 DeintercalateAllInitL !fs
2538 | DeintercalateAllL !fs !sp
2539 | DeintercalateAllInitR !fs
2540 | DeintercalateAllR !fs !ss
2542-- XXX rename this to intercalate
2544-- Having deintercalateAll for accepting or rejecting entire input could be
2545-- useful. For example, in case of JSON parsing we get an entire block of
2546-- key-value pairs which we need to verify. This version may be simpler, more
2547-- efficient. We could implement this as a stream operation like parseMany.
2549-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
2550-- example, in case of csv parsing as we are feeding a line to a fold we can
2553-- | Like 'deintercalate' but the entire input must satisfy the pattern
2554-- otherwise the parser fails. This is many times faster than deintercalate.
2556-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2557-- >>> p2 = Parser.satisfy (== '+')
2558-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
2559-- >>> Stream.parse p $ Stream.fromList ""
2561-- >>> Stream.parse p $ Stream.fromList "1"
2563-- >>> Stream.parse p $ Stream.fromList "1+"
2564-- Left (ParseError "takeWhile1: end of input")
2565-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2566-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2568{-# INLINE deintercalateAll #-}
2569deintercalateAll :: Monad m =>
2572 -> Fold m (Either x y) z
2575 (Parser stepL initialL extractL)
2576 (Parser stepR initialR _)
2577 (Fold fstep finitial fextract) = Parser step initial extract
2582 error $ "deintercalate: " ++ p ++ " parser cannot "
2583 ++ status ++ " without input"
2588 FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2589 FL.Done c -> return $ IDone c
2591 {-# INLINE processL #-}
2592 processL foldAction n nextState = do
2595 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2596 FL.Done c -> return $ Done n c
2598 {-# INLINE runStepL #-}
2599 runStepL fs sL a = do
2602 Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2603 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2605 processL (fstep fs (Left b)) n DeintercalateAllInitR
2606 Error err -> return $ Error err
2608 {-# INLINE processR #-}
2609 processR foldAction n = do
2612 FL.Partial fs1 -> do
2615 IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
2616 IDone _ -> errMsg "left" "succeed"
2617 IError _ -> errMsg "left" "fail"
2618 FL.Done c -> return $ Done n c
2620 {-# INLINE runStepR #-}
2621 runStepR fs sR a = do
2624 Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2625 Continue n s -> return $ Continue n (DeintercalateAllR fs s)
2626 Done n b -> processR (fstep fs (Right b)) n
2627 Error err -> return $ Error err
2629 step (DeintercalateAllInitL fs) a = do
2632 IPartial s -> runStepL fs s a
2633 IDone _ -> errMsg "left" "succeed"
2634 IError _ -> errMsg "left" "fail"
2635 step (DeintercalateAllL fs sL) a = runStepL fs sL a
2636 step (DeintercalateAllInitR fs) a = do
2639 IPartial s -> runStepR fs s a
2640 IDone _ -> errMsg "right" "succeed"
2641 IError _ -> errMsg "right" "fail"
2642 step (DeintercalateAllR fs sR) a = runStepR fs sR a
2644 {-# INLINE extractResult #-}
2645 extractResult n fs r = do
2648 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2649 FL.Done c -> return (Done n c)
2650 extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs
2651 extract (DeintercalateAllL fs sL) = do
2654 Done n b -> extractResult n fs (Left b)
2655 Error err -> return $ Error err
2656 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2657 Partial _ _ -> error "Partial in extract"
2658 extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs
2659 extract (DeintercalateAllR _ _) =
2660 return $ Error "deintercalateAll: input ended at 'Right' value"
2662{-# ANN type DeintercalateState Fuse #-}
2663data DeintercalateState b fs sp ss =
2664 DeintercalateInitL !fs
2665 | DeintercalateL !Int !fs !sp
2666 | DeintercalateInitR !fs
2667 | DeintercalateR !Int !fs !ss
2668 | DeintercalateRL !Int !b !fs !sp
2670-- XXX Add tests that the next character that we take after running a parser is
2671-- correct. Especially for the parsers that maintain a count. In the stream
2672-- finished case (extract) as well as not finished case.
2674-- | Apply two parsers alternately to an input stream. The input stream is
2675-- considered an interleaving of two patterns. The two parsers represent the
2676-- two patterns. Parsing starts at the first parser and stops at the first
2677-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2678-- input or single parse of the first parser is accepted.
2680-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2681-- >>> p2 = Parser.satisfy (== '+')
2682-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2683-- >>> Stream.parse p $ Stream.fromList ""
2685-- >>> Stream.parse p $ Stream.fromList "1"
2687-- >>> Stream.parse p $ Stream.fromList "1+"
2689-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2690-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2692{-# INLINE deintercalate #-}
2693deintercalate :: Monad m =>
2696 -> Fold m (Either x y) z
2699 (Parser stepL initialL extractL)
2700 (Parser stepR initialR _)
2701 (Fold fstep finitial fextract) = Parser step initial extract
2706 error $ "deintercalate: " ++ p ++ " parser cannot "
2707 ++ status ++ " without input"
2712 FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2713 FL.Done c -> return $ IDone c
2715 {-# INLINE processL #-}
2716 processL foldAction n nextState = do
2719 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2720 FL.Done c -> return $ Done n c
2722 {-# INLINE runStepL #-}
2723 runStepL cnt fs sL a = do
2727 Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2728 Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2730 processL (fstep fs (Left b)) n DeintercalateInitR
2733 return $ Done cnt1 xs
2735 {-# INLINE processR #-}
2736 processR cnt b fs n = do
2739 IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2740 IDone _ -> errMsg "left" "succeed"
2741 IError _ -> errMsg "left" "fail"
2743 {-# INLINE runStepR #-}
2744 runStepR cnt fs sR a = do
2748 Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2749 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2750 Done n b -> processR (cnt1 - n) b fs n
2753 return $ Done cnt1 xs
2755 step (DeintercalateInitL fs) a = do
2758 IPartial s -> runStepL 0 fs s a
2759 IDone _ -> errMsg "left" "succeed"
2760 IError _ -> errMsg "left" "fail"
2761 step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2762 step (DeintercalateInitR fs) a = do
2765 IPartial s -> runStepR 0 fs s a
2766 IDone _ -> errMsg "right" "succeed"
2767 IError _ -> errMsg "right" "fail"
2768 step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2769 step (DeintercalateRL cnt bR fs sL) a = do
2773 Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2774 Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2776 res <- fstep fs (Right bR)
2778 FL.Partial fs1 -> do
2779 fres <- fstep fs1 (Left bL)
2782 return $ Partial n (DeintercalateInitR fs2)
2783 FL.Done c -> return $ Done n c
2784 -- XXX We could have the fold accept pairs of (bR, bL)
2785 FL.Done _ -> error "Fold terminated consuming partial input"
2788 return $ Done cnt1 xs
2790 {-# INLINE extractResult #-}
2791 extractResult n fs r = do
2794 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2795 FL.Done c -> return (Done n c)
2797 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs
2798 extract (DeintercalateL cnt fs sL) = do
2801 Done n b -> extractResult n fs (Left b)
2802 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2803 Partial _ _ -> error "Partial in extract"
2806 return $ Done cnt xs
2807 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs
2808 extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs
2809 extract (DeintercalateRL cnt bR fs sL) = do
2813 res <- fstep fs (Right bR)
2815 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2816 FL.Done _ -> error "Fold terminated consuming partial input"
2817 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2818 Partial _ _ -> error "Partial in extract"
2821 return $ Done cnt xs
2823{-# ANN type Deintercalate1State Fuse #-}
2824data Deintercalate1State b fs sp ss =
2825 Deintercalate1InitL !Int !fs !sp
2826 | Deintercalate1InitR !fs
2827 | Deintercalate1R !Int !fs !ss
2828 | Deintercalate1RL !Int !b !fs !sp
2830-- | Apply two parsers alternately to an input stream. The input stream is
2831-- considered an interleaving of two patterns. The two parsers represent the
2832-- two patterns. Parsing starts at the first parser and stops at the first
2833-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2834-- input or single parse of the first parser is accepted.
2836-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2837-- >>> p2 = Parser.satisfy (== '+')
2838-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2839-- >>> Stream.parse p $ Stream.fromList ""
2840-- Left (ParseError "takeWhile1: end of input")
2841-- >>> Stream.parse p $ Stream.fromList "1"
2843-- >>> Stream.parse p $ Stream.fromList "1+"
2845-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2846-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2848{-# INLINE deintercalate1 #-}
2849deintercalate1 :: Monad m =>
2852 -> Fold m (Either x y) z
2855 (Parser stepL initialL extractL)
2856 (Parser stepR initialR _)
2857 (Fold fstep finitial fextract) = Parser step initial extract
2862 error $ "deintercalate: " ++ p ++ " parser cannot "
2863 ++ status ++ " without input"
2871 IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2872 IDone _ -> errMsg "left" "succeed"
2873 IError _ -> errMsg "left" "fail"
2874 FL.Done c -> return $ IDone c
2876 {-# INLINE processL #-}
2877 processL foldAction n nextState = do
2880 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2881 FL.Done c -> return $ Done n c
2883 {-# INLINE runStepInitL #-}
2884 runStepInitL cnt fs sL a = do
2888 Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2889 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2891 processL (fstep fs (Left b)) n Deintercalate1InitR
2892 Error err -> return $ Error err
2894 {-# INLINE processR #-}
2895 processR cnt b fs n = do
2898 IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2899 IDone _ -> errMsg "left" "succeed"
2900 IError _ -> errMsg "left" "fail"
2902 {-# INLINE runStepR #-}
2903 runStepR cnt fs sR a = do
2907 Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2908 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2909 Done n b -> processR (cnt1 - n) b fs n
2912 return $ Done cnt1 xs
2914 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2915 step (Deintercalate1InitR fs) a = do
2918 IPartial s -> runStepR 0 fs s a
2919 IDone _ -> errMsg "right" "succeed"
2920 IError _ -> errMsg "right" "fail"
2921 step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2922 step (Deintercalate1RL cnt bR fs sL) a = do
2926 Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2927 Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2929 res <- fstep fs (Right bR)
2931 FL.Partial fs1 -> do
2932 fres <- fstep fs1 (Left bL)
2935 return $ Partial n (Deintercalate1InitR fs2)
2936 FL.Done c -> return $ Done n c
2937 -- XXX We could have the fold accept pairs of (bR, bL)
2938 FL.Done _ -> error "Fold terminated consuming partial input"
2941 return $ Done cnt1 xs
2943 {-# INLINE extractResult #-}
2944 extractResult n fs r = do
2947 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2948 FL.Done c -> return (Done n c)
2950 extract (Deintercalate1InitL cnt fs sL) = do
2953 Done n b -> extractResult n fs (Left b)
2954 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2955 Partial _ _ -> error "Partial in extract"
2956 Error err -> return $ Error err
2957 extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2958 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2959 extract (Deintercalate1RL cnt bR fs sL) = do
2963 res <- fstep fs (Right bR)
2965 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2966 FL.Done _ -> error "Fold terminated consuming partial input"
2967 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2968 Partial _ _ -> error "Partial in extract"
2971 return $ Done cnt xs
2973{-# ANN type SepByState Fuse #-}
2974data SepByState fs sp ss =
2976 | SepByL !Int !fs !sp
2978 | SepByR !Int !fs !ss
2980-- | Apply two parsers alternately to an input stream. Parsing starts at the
2981-- first parser and stops at the first parser. The output of the first parser
2982-- is emiited and the output of the second parser is discarded. It can be used
2983-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
2984-- of the first parser is accepted.
2988-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
2989-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)
2993-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2994-- >>> p2 = Parser.satisfy (== '+')
2995-- >>> p = Parser.sepBy p1 p2 Fold.toList
2996-- >>> Stream.parse p $ Stream.fromList ""
2998-- >>> Stream.parse p $ Stream.fromList "1"
3000-- >>> Stream.parse p $ Stream.fromList "1+"
3002-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3003-- Right ["1","2","3"]
3007 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3008-- This has similar performance as the custom impl below.
3009-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
3011 (Parser stepL initialL extractL)
3012 (Parser stepR initialR _)
3013 (Fold fstep finitial fextract) = Parser step initial extract
3018 error $ "sepBy: " ++ p ++ " parser cannot "
3019 ++ status ++ " without input"
3024 FL.Partial fs -> return $ IPartial $ SepByInitL fs
3025 FL.Done c -> return $ IDone c
3027 {-# INLINE processL #-}
3028 processL foldAction n nextState = do
3031 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3032 FL.Done c -> return $ Done n c
3034 {-# INLINE runStepL #-}
3035 runStepL cnt fs sL a = do
3039 Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3040 Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3042 processL (fstep fs b) n SepByInitR
3045 return $ Done cnt1 xs
3047 {-# INLINE processR #-}
3048 processR cnt fs n = do
3051 IPartial ps -> return $ Continue n (SepByL cnt fs ps)
3052 IDone _ -> errMsg "left" "succeed"
3053 IError _ -> errMsg "left" "fail"
3055 {-# INLINE runStepR #-}
3056 runStepR cnt fs sR a = do
3060 Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3061 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3062 Done n _ -> processR (cnt1 - n) fs n
3065 return $ Done cnt1 xs
3067 step (SepByInitL fs) a = do
3070 IPartial s -> runStepL 0 fs s a
3071 IDone _ -> errMsg "left" "succeed"
3072 IError _ -> errMsg "left" "fail"
3073 step (SepByL cnt fs sL) a = runStepL cnt fs sL a
3074 step (SepByInitR fs) a = do
3077 IPartial s -> runStepR 0 fs s a
3078 IDone _ -> errMsg "right" "succeed"
3079 IError _ -> errMsg "right" "fail"
3080 step (SepByR cnt fs sR) a = runStepR cnt fs sR a
3082 {-# INLINE extractResult #-}
3083 extractResult n fs r = do
3086 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3087 FL.Done c -> return (Done n c)
3089 extract (SepByInitL fs) = fmap (Done 0) $ fextract fs
3090 extract (SepByL cnt fs sL) = do
3093 Done n b -> extractResult n fs b
3094 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
3095 Partial _ _ -> error "Partial in extract"
3098 return $ Done cnt xs
3099 extract (SepByInitR fs) = fmap (Done 0) $ fextract fs
3100 extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs
3102-- | Non-backtracking version of sepBy. Several times faster.
3103{-# INLINE sepByAll #-}
3104sepByAll :: Monad m =>
3105 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3106sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)
3108-- XXX This can be implemented using refold, parse one and then continue
3109-- collecting the rest in that.
3111{-# ANN type SepBy1State Fuse #-}
3112data SepBy1State fs sp ss =
3113 SepBy1InitL !Int !fs sp
3114 | SepBy1L !Int !fs !sp
3116 | SepBy1R !Int !fs !ss
3119{-# INLINE sepBy1 #-}
3121 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3122sepBy1 p sep sink = do
3124 f <- fromEffect $ FL.reduce sink
3125 f1 <- fromEffect $ FL.snoc f x
3129-- | Like 'sepBy' but requires at least one successful parse.
3133-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
3137-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3138-- >>> p2 = Parser.satisfy (== '+')
3139-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
3140-- >>> Stream.parse p $ Stream.fromList ""
3141-- Left (ParseError "takeWhile1: end of input")
3142-- >>> Stream.parse p $ Stream.fromList "1"
3144-- >>> Stream.parse p $ Stream.fromList "1+"
3146-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3147-- Right ["1","2","3"]
3149{-# INLINE sepBy1 #-}
3151 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3153 (Parser stepL initialL extractL)
3154 (Parser stepR initialR _)
3155 (Fold fstep finitial fextract) = Parser step initial extract
3160 error $ "sepBy: " ++ p ++ " parser cannot "
3161 ++ status ++ " without input"
3169 IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
3170 IDone _ -> errMsg "left" "succeed"
3171 IError _ -> errMsg "left" "fail"
3172 FL.Done c -> return $ IDone c
3174 {-# INLINE processL #-}
3175 processL foldAction n nextState = do
3178 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3179 FL.Done c -> return $ Done n c
3181 {-# INLINE runStepInitL #-}
3182 runStepInitL cnt fs sL a = do
3186 Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3187 Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3189 processL (fstep fs b) n SepBy1InitR
3190 Error err -> return $ Error err
3192 {-# INLINE runStepL #-}
3193 runStepL cnt fs sL a = do
3197 Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3198 Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3200 processL (fstep fs b) n SepBy1InitR
3203 return $ Done cnt1 xs
3205 {-# INLINE processR #-}
3206 processR cnt fs n = do
3209 IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3210 IDone _ -> errMsg "left" "succeed"
3211 IError _ -> errMsg "left" "fail"
3213 {-# INLINE runStepR #-}
3214 runStepR cnt fs sR a = do
3218 Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3219 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3220 Done n _ -> processR (cnt1 - n) fs n
3223 return $ Done cnt1 xs
3225 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3226 step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3227 step (SepBy1InitR fs) a = do
3230 IPartial s -> runStepR 0 fs s a
3231 IDone _ -> errMsg "right" "succeed"
3232 IError _ -> errMsg "right" "fail"
3233 step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3235 {-# INLINE extractResult #-}
3236 extractResult n fs r = do
3239 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3240 FL.Done c -> return (Done n c)
3242 extract (SepBy1InitL cnt fs sL) = do
3245 Done n b -> extractResult n fs b
3246 Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3247 Partial _ _ -> error "Partial in extract"
3248 Error err -> return $ Error err
3249 extract (SepBy1L cnt fs sL) = do
3252 Done n b -> extractResult n fs b
3253 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3254 Partial _ _ -> error "Partial in extract"
3257 return $ Done cnt xs
3258 extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs
3259 extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs
3261-------------------------------------------------------------------------------
3262-- Interleaving a collection of parsers
3263-------------------------------------------------------------------------------
3265-- | Apply a collection of parsers to an input stream in a round robin fashion.
3266-- Each parser is applied until it stops and then we repeat starting with the
3267-- the first parser again.
3271{-# INLINE roundRobin #-}
3272roundRobin :: -- (Foldable t, Monad m) =>
3273 t (Parser a m b) -> Fold m b c -> Parser a m c
3274roundRobin _ps _f = undefined
3276-------------------------------------------------------------------------------
3277-- Sequential Collection
3278-------------------------------------------------------------------------------
3280-- | @sequence f p@ collects sequential parses of parsers in a
3281-- serial stream @p@ using the fold @f@. Fails if the input ends or any
3282-- of the parsers fail.
3286{-# INLINE sequence #-}
3287sequence :: Monad m =>
3288 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c
3289sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
3290 Parser step initial extract
3297 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
3298 FL.Done c -> return $ IDone c
3300 -- state does not contain any parser
3301 -- yield a new parser from the stream
3302 step (Nothing', ss, fs) _ = do
3303 sres <- sstep defState ss
3305 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
3309 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
3311 -- state holds a parser that may or may not have been
3312 -- initialized. pinit holds the initial parser state
3313 -- or modified parser state respectively
3314 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
3322 Just' $ Parser pstep (return $ IPartial ps2) pextr
3323 in return $ Partial n (newP, ss, fs)
3326 Just' $ Parser pstep (return $ IPartial ps2) pextr
3327 in return $ Continue n (newP, ss, fs)
3332 return $ Partial n (Nothing', ss, fs1)
3333 FL.Done c -> return $ Done n c
3334 Error msg -> return $ Error msg
3339 return $ Partial 1 (Nothing', ss, fs1)
3340 FL.Done c -> return $ Done 1 c
3341 IError err -> return $ Error err
3343 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
3344 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
3353 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3354 FL.Done c -> return (Done n c)
3355 Error err -> return $ Error err
3356 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
3357 Partial _ _ -> error "Partial in extract"
3361 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
3362 FL.Done c -> return (Done 0 c)
3363 IError err -> return $ Error err
3365-------------------------------------------------------------------------------
3366-- Alternative Collection
3367-------------------------------------------------------------------------------
3370-- | @choice parsers@ applies the @parsers@ in order and returns the first
3373-- This is same as 'asum' but more efficient.
3377{-# INLINE choice #-}
3378choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b
3379choice = foldl1 shortest
3382-------------------------------------------------------------------------------
3383-- Sequential Repetition
3384-------------------------------------------------------------------------------
3386-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the
3387-- results. Parsing stops or fails if the collecting parser stops or fails.
3392manyP :: -- MonadCatch m =>
3393 Parser a m b -> Parser b m c -> Parser a m c
3394manyP _p _f = undefined
3396-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
3397-- input stream and push the parse results to a downstream fold.
3399-- Stops: when the downstream fold stops or the parser fails.
3400-- Fails: never, produces zero or more results.
3402-- >>> many = Parser.countBetween 0 maxBound
3404-- Compare with 'Control.Applicative.many'.
3407many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3409-- many = countBetween 0 maxBound
3411-- Note: many1 would perhaps be a better name for this and consistent with
3412-- other names like takeWhile1. But we retain the name "some" for
3415-- | Collect one or more parses. Apply the supplied parser repeatedly on the
3416-- input stream and push the parse results to a downstream fold.
3418-- Stops: when the downstream fold stops or the parser fails.
3419-- Fails: if it stops without producing a single result.
3421-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)
3422-- >>> some = Parser.countBetween 1 maxBound
3424-- Compare with 'Control.Applicative.some'.
3427some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3429-- some p f = manyP p (takeGE 1 f)
3430-- some = countBetween 1 maxBound
3432-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
3433-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
3434-- the input ends or the parser fails before @m@ results are collected.
3436-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)
3440{-# INLINE countBetween #-}
3441countBetween :: -- MonadCatch m =>
3442 Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
3443countBetween _m _n _p = undefined
3444-- countBetween m n p f = manyP p (takeBetween m n f)
3446-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
3447-- the fold @f@. Fails if the input ends or the parser fails before @n@
3448-- results are collected.
3450-- >>> count n = Parser.countBetween n n
3451-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)
3456count :: -- MonadCatch m =>
3457 Int -> Parser a m b -> Fold m b c -> Parser a m c
3458count n = countBetween n n
3459-- count n p f = manyP p (takeEQ n f)
3461-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a
3462-- 'Fold'. Parsing stops or fails if the collecting parser stops or fails.
3464-- We can implemnent parsers like the following using 'manyTillP':
3467-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p
3472{-# INLINE manyTillP #-}
3473manyTillP :: -- Monad m =>
3474 Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
3475manyTillP _p1 _p2 _f = undefined
3476 -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f
3478{-# ANN type ManyTillState Fuse #-}
3479data ManyTillState fs sr sl
3480 = ManyTillR !Int !fs !sr
3483-- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@
3484-- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is
3485-- tried again and so on. The parser stops when @test@ succeeds. The output of
3486-- @test@ is discarded and the output of @chunking@ is accumulated by the
3487-- supplied fold. The parser fails if @chunking@ fails.
3489-- Stops when the fold @f@ stops.
3491{-# INLINE manyTill #-}
3493 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3494manyTill (Parser stepL initialL extractL)
3495 (Parser stepR initialR _)
3496 (Fold fstep finitial fextract) =
3497 Parser step initial extract
3501 -- Caution: Mutual recursion
3503 scrutL fs p c d e = do
3506 IPartial sl -> return $ c (ManyTillL fs sl)
3510 FL.Partial fs1 -> scrutR fs1 p c d e
3511 FL.Done fb -> return $ d fb
3512 IError err -> return $ e err
3514 scrutR fs p c d e = do
3517 IPartial sr -> return $ p (ManyTillR 0 fs sr)
3518 IDone _ -> d <$> fextract fs
3519 IError _ -> scrutL fs p c d e
3524 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
3525 FL.Done b -> return $ IDone b
3527 step (ManyTillR cnt fs st) a = do
3530 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
3532 assertM(cnt + 1 - n >= 0)
3533 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
3541 return $ Continue (cnt + 1) (ManyTillL fs sl)
3553 FL.Done fb -> return $ Done cnt1 fb
3554 IError err -> return $ Error err
3555 step (ManyTillL fs st) a = do
3558 Partial n s -> return $ Partial n (ManyTillL fs s)
3559 Continue n s -> return $ Continue n (ManyTillL fs s)
3564 scrutR s (Partial n) (Continue n) (Done n) Error
3565 FL.Done b1 -> return $ Done n b1
3566 Error err -> return $ Error err
3568 extract (ManyTillL fs sR) = do
3574 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3575 FL.Done c -> return (Done n c)
3576 Error err -> return $ Error err
3577 Continue n s -> return $ Continue n (ManyTillL fs s)
3578 Partial _ _ -> error "Partial in extract"
3579 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs
3581-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
3582-- collects the output in the supplied fold. If the the parser @collect@ fails,
3583-- parser @recover@ is run until it stops and then we start repeating the
3584-- parser @collect@ again. The parser fails if the recovery parser fails.
3586-- For example, this can be used to find a key frame in a video stream after an
3591{-# INLINE manyThen #-}
3592manyThen :: -- (Foldable t, Monad m) =>
3593 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3594manyThen _parser _recover _f = undefined
3596-------------------------------------------------------------------------------
3597-- Repeated Alternatives
3598-------------------------------------------------------------------------------
3600-- | Keep trying a parser up to a maximum of @n@ failures. When the parser
3601-- fails the input consumed till now is dropped and the new instance is tried
3602-- on the fresh input.
3606{-# INLINE retryMaxTotal #-}
3607retryMaxTotal :: -- (Monad m) =>
3608 Int -> Parser a m b -> Fold m b c -> Parser a m c
3609retryMaxTotal _n _p _f = undefined
3611-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.
3615{-# INLINE retryMaxSuccessive #-}
3616retryMaxSuccessive :: -- (Monad m) =>
3617 Int -> Parser a m b -> Fold m b c -> Parser a m c
3618retryMaxSuccessive _n _p _f = undefined
3620-- | Keep trying a parser until it succeeds. When the parser fails the input
3621-- consumed till now is dropped and the new instance is tried on the fresh
3627retry :: -- (Monad m) =>
3628 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