3-- Module : Streamly.Internal.Data.Parser
4-- Copyright : (c) 2020 Composewell Technologies
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
10module Streamly.Internal.Data.Parser
15 module Streamly.Internal.Data.Parser.Type
16 --, module Streamly.Internal.Data.Parser.Tee
24 -- * Downgrade to Fold
27 -- First order parsers
38 -- All of these can be expressed in terms of either
49 -- * Sequence parsers (tokenizers)
51 -- | Parsers chained in series, if one parser terminates the composition
52 -- terminates. Currently we are using folds to collect the output of the
53 -- parsers but we can use Parsers instead of folds to make the composition
54 -- more powerful. For example, we can do:
56 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
57 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
58 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
62 -- | Grab a sequence of input elements without inspecting them
64 -- , take -- takeBetween 0 n
65 , takeEQ -- takeBetween n n
66 , takeGE -- takeBetween n maxBound
67 -- , takeGE1 -- take1 -- takeBetween 1 n
70 -- Grab a sequence of input elements by inspecting them
83 -- ** Separated by elements
84 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
85 -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
86 -- separator parsing, also see 'intersperseQuotedBy' fold.
88 -- These can be implemented modularly with refolds, using takeWhile and
99 -- ** Grouped by element comparison
102 , groupByRollingEither
104 -- ** Framed by elements
105 -- | Also see 'intersperseQuotedBy' fold.
106 -- Framed by a one or more ocurrences of a separator around a word like
107 -- spaces or quotes. No nesting.
108 , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
113 -- Framed by separate start and end characters, potentially nested.
114 -- blockWithQuotes allows quotes inside a block. However,
115 -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and
116 -- block with escaping.
120 , takeFramedByGeneric
124 -- , prefixOf -- match any prefix of a given string
125 -- , suffixOf -- match any suffix of a given string
126 -- , infixOf -- match any substring of a given string
133 -- Second order parsers (parsers using parsers)
134 -- * Binary Combinators
136 -- ** Parallel Applicatives
140 -- , teeTill -- like manyTill but parallel
144 -- ** Parallel Alternatives
150 -- * N-ary Combinators
151 -- ** Sequential Collection
154 -- ** Sequential Repetition
157 -- , countBetweenTill
162 -- ** Interleaved Repetition
163 -- Use two folds, run a primary parser, its rejected values go to the
168 -- , deintercalatePrefix
169 -- , deintercalateSuffix
172 -- | TODO: traditional implmentations of these may be of limited use. For
173 -- example, consider parsing lines separated by @\\r\\n@. The main parser
174 -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
175 -- can apply the "sep" parser.
177 -- We can instead implement these as special cases of deintercalate.
196 -- A simple and stupid impl would be to just convert the stream to an array
197 -- and give the array reference to all consumers. The array can be grown on
198 -- demand by any consumer and truncated when nonbody needs it.
200 -- -- ** Distribute to collection
201 -- -- ** Distribute to repetition
203 -- ** Interleaved collection
210 -- -- ** Interleaved repetition
211 -- repeat one parser and when it fails run an error recovery parser
212 -- e.g. to find a key frame in the stream after an error
214 -- ** Collection of Alternatives
220 -- , fastestN -- first N successful in time
221 -- , choiceN -- first N successful in position
223 -- , choice -- first successful in position
225 -- ** Repeated Alternatives
245import Control.Monad (when)
246import Data.Bifunctor (first)
247import Fusion.Plugin.Types (Fuse(..))
248import Streamly.Internal.Data.Fold.Type (Fold(..))
249import Streamly.Internal.Data.SVar.Type (defState)
250import Streamly.Internal.Data.Either.Strict (Either'(..))
251import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
252import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
253import Streamly.Internal.Data.Stream.Type (Stream)
255import qualified Data.Foldable as Foldable
256import qualified Streamly.Internal.Data.Fold.Type as FL
257import qualified Streamly.Internal.Data.Stream.Type as D
258import qualified Streamly.Internal.Data.Stream.Generate as D
260import Streamly.Internal.Data.Parser.Type
261--import Streamly.Internal.Data.Parser.Tee -- It's empty
264 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
265 , zip, filter, dropWhile)
267#include "DocTestDataParser.hs"
269-------------------------------------------------------------------------------
270-- Downgrade a parser to a Fold
271-------------------------------------------------------------------------------
273-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the
274-- parser fails or tries to backtrack.
276-- This can be useful in combinators that accept a Fold and we know that a
277-- Parser cannot fail or failure exception is acceptable as there is no way to
283toFold :: Monad m => Parser a m b -> Fold m a b
284toFold (Parser pstep pinitial pextract) = Fold step initial extract
291 IPartial s -> return $ FL.Partial s
292 IDone b -> return $ FL.Done b
294 error $ "toFold: parser throws error in initial" ++ err
296 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
297 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
298 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
299 eerror err = error $ "toFold: parser throws error: " ++ err
304 Partial 0 s -> return $ FL.Partial s
305 Continue 0 s -> return $ FL.Partial s
306 Done 0 b -> return $ FL.Done b
307 Partial n _ -> perror n
308 Continue n _ -> cerror n
310 Error err -> eerror err
316 Partial n _ -> perror n
317 Continue n _ -> cerror n
319 Error err -> eerror err
321-------------------------------------------------------------------------------
322-- Upgrade folds to parses
323-------------------------------------------------------------------------------
325-- | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the
328{-# INLINE fromFold #-}
329fromFold :: Monad m => Fold m a b -> Parser a m b
330fromFold (Fold fstep finitial fextract) = Parser step initial extract
338 FL.Partial s1 -> IPartial s1
345 FL.Partial s1 -> Partial 0 s1
346 FL.Done b -> Done 0 b
348 extract = fmap (Done 0) . fextract
350-- | Convert a Maybe returning fold to an error returning parser. The first
351-- argument is the error message that the parser would return when the fold
356{-# INLINE fromFoldMaybe #-}
357fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b
358fromFoldMaybe errMsg (Fold fstep finitial fextract) =
359 Parser step initial extract
367 FL.Partial s1 -> IPartial s1
371 Nothing -> IError errMsg
377 FL.Partial s1 -> Partial 0 s1
381 Nothing -> Error errMsg
386 Just x -> return $ Done 0 x
387 Nothing -> return $ Error errMsg
389-------------------------------------------------------------------------------
391-------------------------------------------------------------------------------
393-- | Peek the head element of a stream, without consuming it. Fails if it
394-- encounters end of input.
396-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]
400-- peek = lookAhead (satisfy True)
404peek :: Monad m => Parser a m a
405peek = Parser step initial extract
409 initial = return $ IPartial ()
411 step () a = return $ Done 1 a
413 extract () = return $ Error "peek: end of input"
415-- | Succeeds if we are at the end of input, fails otherwise.
417-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]
421eof :: Monad m => Parser a m ()
422eof = Parser step initial extract
426 initial = return $ IPartial ()
428 step () _ = return $ Error "eof: not at end of input"
430 extract () = return $ Done 0 ()
432-- | Return the next element of the input. Returns 'Nothing'
433-- on end of input. Also known as 'head'.
437{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}
439next :: Monad m => Parser a m (Maybe a)
440next = Parser step initial extract
444 initial = pure $ IPartial ()
446 step () a = pure $ Done 0 (Just a)
448 extract () = pure $ Done 0 Nothing
450-- | Map an 'Either' returning function on the next element in the stream. If
451-- the function returns 'Left err', the parser fails with the error message
452-- @err@ otherwise returns the 'Right' value.
457either :: Monad m => (a -> Either String b) -> Parser a m b
458either f = Parser step initial extract
462 initial = return $ IPartial ()
467 Left err -> Error err
469 extract () = return $ Error "end of input"
471-- | Map a 'Maybe' returning function on the next element in the stream. The
472-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
475-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
476-- >>> maybe f = Parser.either (toEither . f)
478-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)
483maybe :: Monad m => (a -> Maybe b) -> Parser a m b
484-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
485maybe parserF = Parser step initial extract
489 initial = return $ IPartial ()
494 Nothing -> Error "maybe: predicate failed"
496 extract () = return $ Error "maybe: end of input"
498-- | Returns the next element if it passes the predicate, fails otherwise.
500-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]
503-- >>> toMaybe f x = if f x then Just x else Nothing
504-- >>> satisfy f = Parser.maybe (toMaybe f)
506{-# INLINE satisfy #-}
507satisfy :: Monad m => (a -> Bool) -> Parser a m a
508-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
509satisfy predicate = Parser step initial extract
513 initial = return $ IPartial ()
518 else Error "satisfy: predicate failed"
520 extract () = return $ Error "satisfy: end of input"
522-- | Consume one element from the head of the stream. Fails if it encounters
525-- >>> one = Parser.satisfy $ const True
528one :: Monad m => Parser a m a
529one = satisfy $ const True
531-- Alternate names: "only", "onlyThis".
533-- | Match a specific element.
535-- >>> oneEq x = Parser.satisfy (== x)
538oneEq :: (Monad m, Eq a) => a -> Parser a m a
539oneEq x = satisfy (== x)
541-- Alternate names: "exclude", "notThis".
543-- | Match anything other than the supplied element.
545-- >>> oneNotEq x = Parser.satisfy (/= x)
547{-# INLINE oneNotEq #-}
548oneNotEq :: (Monad m, Eq a) => a -> Parser a m a
549oneNotEq x = satisfy (/= x)
551-- | Match any one of the elements in the supplied list.
553-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)
555-- When performance matters a pattern matching predicate could be more
556-- efficient than a 'Foldable' datatype:
567-- GHC may use a binary search instead of linear search in the list.
568-- Alternatively, you can also use an array instead of list for storage and
572oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
573oneOf xs = satisfy (`Foldable.elem` xs)
575-- | See performance notes in 'oneOf'.
577-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)
580noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
581noneOf xs = satisfy (`Foldable.notElem` xs)
583-------------------------------------------------------------------------------
585-------------------------------------------------------------------------------
587-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
588{-# ANN type Tuple'Fused Fuse #-}
589data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
591-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input
592-- elements and folds them using the supplied fold.
594-- Stops after @n@ elements.
595-- Fails if the stream ends before @m@ elements could be taken.
601-- takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)
602-- where prsr = Parser.takeBetween low high Fold.toList
607-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]
610-- >>> takeBetween' 2 4 [1, 2]
613-- >>> takeBetween' 2 4 [1]
614-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")
616-- >>> takeBetween' 0 0 [1, 2]
619-- >>> takeBetween' 0 1 []
622-- @takeBetween@ is the most general take operation, other take operations can
623-- be defined in terms of takeBetween. For example:
625-- >>> take n = Parser.takeBetween 0 n
626-- >>> takeEQ n = Parser.takeBetween n n
627-- >>> takeGE n = Parser.takeBetween n maxBound
631{-# INLINE takeBetween #-}
632takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
633takeBetween low high (Fold fstep finitial fextract) =
635 Parser step initial (extract streamErr)
640 "takeBetween: Expecting alteast " ++ show low
641 ++ " elements, got " ++ show i
644 "takeBetween: lower bound - " ++ show low
645 ++ " is greater than higher bound - " ++ show high
647 foldErr :: Int -> String
649 "takeBetween: the collecting fold terminated after"
650 ++ " consuming" ++ show i ++ " elements"
651 ++ " minimum" ++ show low ++ " elements needed"
653 -- Exactly the same as snext except different constructors, we can possibly
654 -- deduplicate the two.
660 let s1 = Tuple'Fused i1 s
662 -- XXX ideally this should be a Continue instead
663 then return $ IPartial s1
664 else iextract foldErr s1
669 else IError (foldErr i1)
672 when (low >= 0 && high >= 0 && low > high)
675 finitial >>= inext (-1)
677 -- Keep the impl same as inext
683 let s1 = Tuple'Fused i1 s
685 then return $ Continue 0 s1
687 then return $ Partial 0 s1
688 else fmap (Done 0) (fextract s)
693 else Error (foldErr i1)
695 step (Tuple'Fused i s) a = fstep s a >>= snext i
697 extract f (Tuple'Fused i s)
698 | i >= low && i <= high = fmap (Done 0) (fextract s)
699 | otherwise = return $ Error (f i)
701 -- XXX Need to make Initial return type Step to deduplicate this
702 iextract f (Tuple'Fused i s)
703 | i >= low && i <= high = fmap IDone (fextract s)
704 | otherwise = return $ IError (f i)
706-- | Stops after taking exactly @n@ input elements.
708-- * Stops - after consuming @n@ elements.
709-- * Fails - if the stream or the collecting fold ends before it can collect
710-- exactly @n@ elements.
712-- >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]
715-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
716-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")
719takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
720takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
729 then return $ IPartial $ Tuple'Fused 1 s
730 else fmap IDone (fextract s)
731 FL.Done b -> return $
734 $ "takeEQ: Expecting exactly " ++ show n
735 ++ " elements, fold terminated without"
736 ++ " consuming any elements"
739 step (Tuple'Fused i1 r) a = do
745 FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s
748 $ "takeEQ: Expecting exactly " ++ show n
749 ++ " elements, fold terminated on " ++ show i1
754 FL.Partial s -> fextract s
755 FL.Done b -> return b
757 extract (Tuple'Fused i _) =
758 -- Using the count "i" in the message below causes large performance
759 -- regression unless we use Fuse annotation on Tuple.
762 $ "takeEQ: Expecting exactly " ++ show n
763 ++ " elements, input terminated on " ++ show (i - 1)
765{-# ANN type TakeGEState Fuse #-}
770-- | Take at least @n@ input elements, but can collect more.
772-- * Stops - when the collecting fold stops.
773-- * Fails - if the stream or the collecting fold ends before producing @n@
776-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
777-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")
779-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
785takeGE :: Monad m => Int -> Fold m a b -> Parser a m b
786takeGE n (Fold fstep finitial fextract) = Parser step initial extract
795 then return $ IPartial $ TakeGELT 1 s
796 else return $ IPartial $ TakeGEGE s
797 FL.Done b -> return $
800 $ "takeGE: Expecting at least " ++ show n
801 ++ " elements, fold terminated without"
802 ++ " consuming any elements"
805 step (TakeGELT i1 r) a = do
811 FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s
814 $ "takeGE: Expecting at least " ++ show n
815 ++ " elements, fold terminated on " ++ show i1
820 FL.Partial s -> Partial 0 $ TakeGEGE s
821 FL.Done b -> Done 0 b
822 step (TakeGEGE r) a = do
826 FL.Partial s -> Partial 0 $ TakeGEGE s
827 FL.Done b -> Done 0 b
829 extract (TakeGELT i _) =
832 $ "takeGE: Expecting at least " ++ show n
833 ++ " elements, input terminated on " ++ show (i - 1)
834 extract (TakeGEGE r) = fmap (Done 0) $ fextract r
836-------------------------------------------------------------------------------
837-- Conditional splitting
838-------------------------------------------------------------------------------
840-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.
842-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the
843-- input. The combinator stops when the condition fails or if the collecting
846-- Other interesting parsers can be implemented in terms of this parser:
848-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
849-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)
851-- Stops: when the condition fails or the collecting parser stops.
852-- Fails: when the collecting parser fails.
856{-# INLINE takeWhileP #-}
857takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
858takeWhileP predicate (Parser pstep pinitial pextract) =
859 Parser step pinitial pextract
868 -- XXX need a map on count
870 Error err -> return $ Error err
871 Done n s1 -> return $ Done (n + 1) s1
872 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
873 Continue n s1 -> return $ Continue (n + 1) s1
875-- | Collect stream elements until an element fails the predicate. The element
876-- on which the predicate fails is returned back to the input stream.
878-- * Stops - when the predicate fails or the collecting fold stops.
881-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]
884-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)
886-- We can implement a @breakOn@ using 'takeWhile':
889-- breakOn p = takeWhile (not p)
892{-# INLINE takeWhile #-}
893takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
894-- takeWhile cond f = takeWhileP cond (fromFold f)
895takeWhile predicate (Fold fstep finitial fextract) =
896 Parser step initial extract
903 FL.Partial s -> IPartial s
912 FL.Partial s1 -> Partial 0 s1
913 FL.Done b -> Done 0 b
914 else Done 1 <$> fextract s
916 extract s = fmap (Done 0) (fextract s)
919-- XXX This may not be composable because of the b argument. We can instead
920-- return a "Reparse b a m b" so that those can be composed.
921{-# INLINE takeWhile1X #-}
922takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b
923-- We can implement this using satisfy and takeWhile. We can use "satisfy
924-- p", fold the result with the refold and then use the "takeWhile p" and
925-- fold that using the refold.
926takeWhile1 acc cond f = undefined
929-- | Like 'takeWhile' but takes at least one element otherwise fails.
931-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
933{-# INLINE takeWhile1 #-}
934takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
935-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)
936takeWhile1 predicate (Fold fstep finitial fextract) =
937 Parser step initial extract
944 FL.Partial s -> IPartial (Left' s)
947 $ "takeWhile1: fold terminated without consuming:"
950 {-# INLINE process #-}
955 FL.Partial s1 -> Partial 0 (Right' s1)
956 FL.Done b -> Done 0 b
961 else return $ Error "takeWhile1: predicate failed on first element"
969 extract (Left' _) = return $ Error "takeWhile1: end of input"
970 extract (Right' s) = fmap (Done 0) (fextract s)
972-- | Drain the input as long as the predicate succeeds, running the effects and
973-- discarding the results.
975-- This is also called @skipWhile@ in some parsing libraries.
977-- >>> dropWhile p = Parser.takeWhile p Fold.drain
979{-# INLINE dropWhile #-}
980dropWhile :: Monad m => (a -> Bool) -> Parser a m ()
981dropWhile p = takeWhile p FL.drain
983-------------------------------------------------------------------------------
985-------------------------------------------------------------------------------
987{-# ANN type FramedEscState Fuse #-}
988data FramedEscState s =
989 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
991-- XXX We can remove Maybe from esc
992{-# INLINE takeFramedByGeneric #-}
993takeFramedByGeneric :: Monad m =>
994 Maybe (a -> Bool) -- is escape char?
995 -> Maybe (a -> Bool) -- is frame begin?
996 -> Maybe (a -> Bool) -- is frame end?
999takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
1001 Parser step initial extract
1009 FL.Partial s -> IPartial (FrameEscInit s)
1011 error "takeFramedByGeneric: fold done without input"
1013 {-# INLINE process #-}
1018 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1019 FL.Done b -> Done 0 b
1021 {-# INLINE processNoEsc #-}
1022 processNoEsc s a n =
1027 -- takeFramedBy case
1031 then Done 0 <$> fextract s
1032 else process s a (n - 1)
1034 let n1 = if isBegin a then n + 1 else n
1036 Nothing -> -- takeEndBy case
1038 then Done 0 <$> fextract s
1040 Nothing -> -- takeStartBy case
1044 then Done 0 <$> fextract s
1047 error $ "takeFramedByGeneric: "
1048 ++ "Both begin and end frame predicate missing"
1050 {-# INLINE processCheckEsc #-}
1051 processCheckEsc s a n =
1055 then return $ Partial 0 $ FrameEscEsc s n
1056 else processNoEsc s a n
1057 Nothing -> processNoEsc s a n
1059 step (FrameEscInit s) a =
1063 then return $ Partial 0 (FrameEscGo s 0)
1064 else return $ Error "takeFramedByGeneric: missing frame start"
1069 then Done 0 <$> fextract s
1070 else processCheckEsc s a 0
1072 error "Both begin and end frame predicate missing"
1073 step (FrameEscGo s n) a = processCheckEsc s a n
1074 step (FrameEscEsc s n) a = process s a n
1076 err = return . Error
1078 extract (FrameEscInit _) =
1079 err "takeFramedByGeneric: empty token"
1080 extract (FrameEscGo s _) =
1084 Nothing -> fmap (Done 0) $ fextract s
1085 Just _ -> err "takeFramedByGeneric: missing frame end"
1086 Nothing -> err "takeFramedByGeneric: missing closing frame"
1087 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1089data BlockParseState s =
1091 | BlockUnquoted !Int !s
1092 | BlockQuoted !Int !s
1093 | BlockQuotedEsc !Int !s
1095-- Blocks can be of different types e.g. {} or (). We only parse from the
1096-- perspective of the outermost block type. The nesting of that block are
1097-- checked. Any other block types nested inside it are opaque to us and can be
1098-- parsed when the contents of the block are parsed.
1100-- XXX Put a limit on nest level to keep the API safe.
1102-- | Parse a block enclosed within open, close brackets. Block contents may be
1103-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1104-- within quotes if escaped. A block can have a nested block inside it.
1106-- Quote begin and end chars are the same. Block brackets and quote chars must
1107-- not overlap. Block start and end brackets must be different for nesting
1108-- blocks within blocks.
1110-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1111-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1112-- Right "msg: \"hello world\""
1114{-# INLINE blockWithQuotes #-}
1115blockWithQuotes :: (Monad m, Eq a) =>
1116 (a -> Bool) -- ^ escape char
1117 -> (a -> Bool) -- ^ quote char, to quote inside brackets
1118 -> a -- ^ Block opening bracket
1119 -> a -- ^ Block closing bracket
1122blockWithQuotes isEsc isQuote bopen bclose
1123 (Fold fstep finitial fextract) =
1124 Parser step initial extract
1132 FL.Partial s -> IPartial (BlockInit s)
1134 error "blockWithQuotes: fold finished without input"
1136 {-# INLINE process #-}
1137 process s a nextState = do
1141 FL.Partial s1 -> Continue 0 (nextState s1)
1142 FL.Done b -> Done 0 b
1144 step (BlockInit s) a =
1147 then Continue 0 $ BlockUnquoted 1 s
1148 else Error "blockWithQuotes: missing block start"
1149 step (BlockUnquoted level s) a
1150 | a == bopen = process s a (BlockUnquoted (level + 1))
1153 then fmap (Done 0) (fextract s)
1154 else process s a (BlockUnquoted (level - 1))
1155 | isQuote a = process s a (BlockQuoted level)
1156 | otherwise = process s a (BlockUnquoted level)
1157 step (BlockQuoted level s) a
1158 | isEsc a = process s a (BlockQuotedEsc level)
1161 then process s a (BlockUnquoted level)
1162 else process s a (BlockQuoted level)
1163 step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1165 err = return . Error
1167 extract (BlockInit s) = fmap (Done 0) $ fextract s
1168 extract (BlockUnquoted level _) =
1169 err $ "blockWithQuotes: finished at block nest level " ++ show level
1170 extract (BlockQuoted level _) =
1171 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1172 ++ "at block nest level " ++ show level
1173 extract (BlockQuotedEsc level _) =
1174 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1175 ++ "after an escape char, at block nest level " ++ show level
1177-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1178-- the supplied predicate. The separator is also taken with the token.
1180-- This can be combined with other parsers to implement other interesting
1181-- parsers as follows:
1183-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)
1184-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)
1186-- >>> takeEndBy = Parser.takeEndByEsc (const False)
1188-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting
1189-- parser in the takeEndBy parser can decide whether to fail or not if the
1190-- stream does not end with separator.
1194{-# INLINE takeEndBy #-}
1195takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
1196-- takeEndBy = takeEndByEsc (const False)
1197takeEndBy cond (Parser pstep pinitial pextract) =
1199 Parser step initial pextract
1209 else extractStep pextract res
1211-- | Like 'takeEndBy' but the separator elements can be escaped using an
1212-- escape char determined by the first predicate. The escape characters are
1216{-# INLINE takeEndByEsc #-}
1217takeEndByEsc :: Monad m =>
1218 (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
1219takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
1221 Parser step initial extract
1225 initial = first Left' <$> pinitial
1227 step (Left' s) a = do
1229 then return $ Partial 0 $ Right' s
1233 then return $ first Left' res
1234 else fmap (first Left') $ extractStep pextract res
1236 step (Right' s) a = do
1238 return $ first Left' res
1240 extract (Left' s) = fmap (first Left') $ pextract s
1241 extract (Right' _) =
1242 return $ Error "takeEndByEsc: trailing escape"
1244-- | Like 'takeEndBy' but the separator is dropped.
1246-- See also "Streamly.Data.Fold.takeEndBy_".
1250{-# INLINE takeEndBy_ #-}
1251takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b
1254 takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)
1256takeEndBy_ cond (Parser pstep pinitial pextract) =
1258 Parser step pinitial pextract
1267-- | Take either the separator or the token. Separator is a Left value and
1268-- token is Right value.
1271{-# INLINE takeEitherSepBy #-}
1272takeEitherSepBy :: -- Monad m =>
1273 (a -> Bool) -> Fold m (Either a b) c -> Parser a m c
1274takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond
1276-- | Parse a token that starts with an element chosen by the predicate. The
1277-- parser fails if the input does not start with the selected element.
1279-- * Stops - when the predicate succeeds in non-leading position.
1280-- * Fails - when the predicate fails in the leading position.
1282-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)
1286-- >>> p = Parser.takeStartBy (== ',') Fold.toList
1287-- >>> leadingComma = Stream.parse p . Stream.fromList
1288-- >>> leadingComma "a,b"
1289-- Left (ParseError "takeStartBy: missing frame start")
1291-- >>> leadingComma ",,"
1293-- >>> leadingComma ",a,b"
1295-- >>> leadingComma ""
1300{-# INLINE takeStartBy #-}
1301takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1302takeStartBy cond (Fold fstep finitial fextract) =
1304 Parser step initial extract
1312 FL.Partial s -> IPartial (Left' s)
1313 FL.Done _ -> IError "takeStartBy: fold done without input"
1315 {-# INLINE process #-}
1320 FL.Partial s1 -> Partial 0 (Right' s1)
1321 FL.Done b -> Done 0 b
1326 else return $ Error "takeStartBy: missing frame start"
1330 else Done 1 <$> fextract s
1332 extract (Left' s) = fmap (Done 0) $ fextract s
1333 extract (Right' s) = fmap (Done 0) $ fextract s
1335-- | Like 'takeStartBy' but drops the separator.
1337-- >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing
1339{-# INLINE takeStartBy_ #-}
1340takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1341takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing
1343-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a
1344-- begin and end predicate, and an escape character. The frame begin and end
1345-- characters lose their special meaning if preceded by the escape character.
1347-- Nested frames are allowed if begin and end markers are different, nested
1348-- frames must be balanced unless escaped, nested frame markers are emitted as
1353-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList
1354-- >>> Stream.parse p $ Stream.fromList "{hello}"
1356-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"
1357-- Right "hello {world}"
1358-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
1359-- Right "hello {world"
1360-- >>> Stream.parse p $ Stream.fromList "{hello {world}"
1361-- Left (ParseError "takeFramedByEsc_: missing frame end")
1364{-# INLINE takeFramedByEsc_ #-}
1365takeFramedByEsc_ :: Monad m =>
1366 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1367-- takeFramedByEsc_ isEsc isEnd p =
1368-- takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)
1369takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =
1371 Parser step initial extract
1379 FL.Partial s -> IPartial (FrameEscInit s)
1381 error "takeFramedByEsc_: fold done without input"
1383 {-# INLINE process #-}
1388 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1389 FL.Done b -> Done 0 b
1391 step (FrameEscInit s) a =
1393 then return $ Partial 0 (FrameEscGo s 0)
1394 else return $ Error "takeFramedByEsc_: missing frame start"
1395 step (FrameEscGo s n) a =
1397 then return $ Partial 0 $ FrameEscEsc s n
1401 let n1 = if isBegin a then n + 1 else n
1405 then Done 0 <$> fextract s
1406 else process s a (n - 1)
1407 step (FrameEscEsc s n) a = process s a n
1409 err = return . Error
1411 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1412 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1413 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1415data FramedState s = FrameInit !s | FrameGo !s Int
1417-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an
1420-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)
1422{-# INLINE takeFramedBy_ #-}
1423takeFramedBy_ :: Monad m =>
1424 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1425-- takeFramedBy_ isBegin isEnd =
1426-- takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)
1427takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
1429 Parser step initial extract
1437 FL.Partial s -> IPartial (FrameInit s)
1439 error "takeFramedBy_: fold done without input"
1441 {-# INLINE process #-}
1446 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1447 FL.Done b -> Done 0 b
1449 step (FrameInit s) a =
1451 then return $ Continue 0 (FrameGo s 0)
1452 else return $ Error "takeFramedBy_: missing frame start"
1453 step (FrameGo s n) a
1455 let n1 = if isBegin a then n + 1 else n
1457 | n == 0 = Done 0 <$> fextract s
1458 | otherwise = process s a (n - 1)
1460 err = return . Error
1462 extract (FrameInit _) = err "takeFramedBy_: empty token"
1463 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1465-------------------------------------------------------------------------------
1466-- Grouping and words
1467-------------------------------------------------------------------------------
1469data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1471-- Note we can also get words using something like:
1472-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)
1474-- But that won't be as efficient and ergonomic.
1476-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
1477-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
1478-- @["a","b"]@. In other words, its like parsing words from whitespace
1481-- * Stops - when it finds a word separator after a non-word element
1484-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)
1487-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)
1490{-# INLINE wordBy #-}
1491wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1492wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
1496 {-# INLINE worder #-}
1501 FL.Partial s1 -> Partial 0 $ WBWord s1
1502 FL.Done b -> Done 0 b
1508 FL.Partial s -> IPartial $ WBLeft s
1509 FL.Done b -> IDone b
1512 if not (predicate a)
1514 else return $ Partial 0 $ WBLeft s
1516 if not (predicate a)
1520 return $ Partial 0 $ WBRight b
1521 step (WBRight b) a =
1523 $ if not (predicate a)
1525 else Partial 0 $ WBRight b
1527 extract (WBLeft s) = fmap (Done 0) $ fextract s
1528 extract (WBWord s) = fmap (Done 0) $ fextract s
1529 extract (WBRight b) = return (Done 0 b)
1531data WordFramedState s b =
1532 WordFramedSkipPre !s
1533 | WordFramedWord !s !Int
1534 | WordFramedEsc !s !Int
1535 | WordFramedSkipPost !b
1537-- | Like 'wordBy' but treats anything inside a pair of quotes as a single
1538-- word, the quotes can be escaped by an escape character. Recursive quotes
1539-- are possible if quote begin and end characters are different, quotes must be
1540-- balanced. Outermost quotes are stripped.
1542-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList
1543-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"
1545-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"
1547-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"
1549-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"
1552-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList
1553-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""
1556{-# INLINE wordFramedBy #-}
1557wordFramedBy :: Monad m =>
1558 (a -> Bool) -- ^ Matches escape elem?
1559 -> (a -> Bool) -- ^ Matches left quote?
1560 -> (a -> Bool) -- ^ matches right quote?
1561 -> (a -> Bool) -- ^ matches word separator?
1564wordFramedBy isEsc isBegin isEnd isSep
1565 (Fold fstep finitial fextract) =
1566 Parser step initial extract
1574 FL.Partial s -> IPartial (WordFramedSkipPre s)
1576 error "wordFramedBy: fold done without input"
1578 {-# INLINE process #-}
1583 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1584 FL.Done b -> Done 0 b
1586 step (WordFramedSkipPre s) a
1587 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1588 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1589 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1591 return $ Error "wordFramedBy: missing frame start"
1592 | otherwise = process s a 0
1593 step (WordFramedWord s n) a
1594 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1595 | n == 0 && isSep a = do
1597 return $ Partial 0 $ WordFramedSkipPost b
1599 -- We need to use different order for checking begin and end for
1600 -- the n == 0 and n == 1 case so that when the begin and end
1601 -- character is the same we treat the one after begin as end.
1604 -- Need to check isBegin first
1606 then return $ Continue 0 $ WordFramedWord s 1
1608 then return $ Error "wordFramedBy: missing frame start"
1611 -- Need to check isEnd first
1615 then return $ Continue 0 $ WordFramedWord s 0
1616 else process s a (n - 1)
1618 then process s a (n + 1)
1620 step (WordFramedEsc s n) a = process s a n
1621 step (WordFramedSkipPost b) a =
1625 else Partial 0 $ WordFramedSkipPost b
1627 err = return . Error
1629 extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s
1630 extract (WordFramedWord s n) =
1632 then fmap (Done 0) $ fextract s
1633 else err "wordFramedBy: missing frame end"
1634 extract (WordFramedEsc _ _) =
1635 err "wordFramedBy: trailing escape"
1636 extract (WordFramedSkipPost b) = return (Done 0 b)
1638data WordQuotedState s b a =
1639 WordQuotedSkipPre !s
1640 | WordUnquotedWord !s
1641 | WordQuotedWord !s !Int !a !a
1642 | WordUnquotedEsc !s
1643 | WordQuotedEsc !s !Int !a !a
1644 | WordQuotedSkipPost !b
1646-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
1647-- word separators within specified quotes or brackets are ignored. Quotes and
1648-- escape characters can be processed. If the end quote is different from the
1649-- start quote it is called a bracket. The following quoting rules apply:
1651-- * In an unquoted string a character may be preceded by an escape character.
1652-- The escape character is removed and the character following it is treated
1653-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
1655-- * Any part of the word can be placed within quotes. Inside quotes all
1656-- characters are treated literally with no special meaning. Quoting character
1657-- itself cannot be used within quotes unless escape processing within quotes
1658-- is applied to allow it.
1659-- * Optionally escape processing for quoted part can be specified. Escape
1660-- character has no special meaning inside quotes unless it is followed by a
1661-- character that has a escape translation specified, in that case the escape
1662-- character is removed, and the specified translation is applied to the
1663-- character following it. This can be used to escape the quoting character
1664-- itself within quotes.
1665-- * There can be multiple quoting characters, when a quote starts, all other
1666-- quoting characters within that quote lose any special meaning until the
1668-- * A starting quote char without an ending char generates a parse error. An
1669-- ending bracket char without a corresponding bracket begin is ignored.
1670-- * Brackets can be nested.
1672-- We should note that unquoted and quoted escape processing are different. In
1673-- unquoted part escape character is always removed. In quoted part it is
1674-- removed only if followed by a special meaning character. This is consistent
1675-- with how shell performs escape processing.
1677-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
1678-- ((nested) brackets).
1686-- >>> '\'' -> Just x
1690-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
1691-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1692-- Right "a\"b'c\";'d\"e'f"
1694-- Note that outer quotes and backslashes from the input string are consumed by
1695-- Haskell, therefore, the actual input string passed to the parser is:
1698-- Similarly, when printing, double quotes are escaped by Haskell.
1702-- Shell like quote processing can be performed by using quote char specific
1703-- escape processing, single quotes with no escapes, and double quotes with
1706-- JSON string processing can also be achieved except the "\uXXXX" style
1707-- escaping for Unicode characters.
1709{-# INLINE wordWithQuotes #-}
1710wordWithQuotes :: (Monad m, Eq a) =>
1711 Bool -- ^ Retain the quotes and escape chars in the output
1712 -> (a -> a -> Maybe a) -- ^ quote char -> escaped char -> translated char
1713 -> a -- ^ Matches an escape elem?
1714 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1715 -> (a -> Bool) -- ^ Matches a word separator?
1718wordWithQuotes keepQuotes tr escChar toRight isSep
1719 (Fold fstep finitial fextract) =
1720 Parser step initial extract
1724 -- Can be used to generate parse error for a bracket end without a bracket
1726 isInvalid = const False
1728 isEsc = (== escChar)
1734 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1736 error "wordKeepQuotes: fold done without input"
1738 {-# INLINE processQuoted #-}
1739 processQuoted s a n ql qr = do
1743 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)
1744 FL.Done b -> Done 0 b
1746 {-# INLINE processUnquoted #-}
1747 processUnquoted s a = do
1751 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1752 FL.Done b -> Done 0 b
1754 step (WordQuotedSkipPre s) a
1755 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1756 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1761 then processQuoted s a 1 a qr
1762 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1765 return $ Error "wordKeepQuotes: invalid unquoted char"
1766 | otherwise -> processUnquoted s a
1767 step (WordUnquotedWord s) a
1768 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1771 return $ Partial 0 $ WordQuotedSkipPost b
1776 then processQuoted s a 1 a qr
1777 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1780 then return $ Error "wordKeepQuotes: invalid unquoted char"
1781 else processUnquoted s a
1782 step (WordQuotedWord s n ql qr) a
1783 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr
1785 -- XXX Will this ever occur? Will n ever be 0?
1786 | n == 0 && isSep a = do
1788 return $ Partial 0 $ WordQuotedSkipPost b
1795 then processUnquoted s a
1796 else return $ Continue 0 $ WordUnquotedWord s
1797 else processQuoted s a (n - 1) ql qr
1799 then processQuoted s a (n + 1) ql qr
1800 else processQuoted s a n ql qr
1801 step (WordUnquotedEsc s) a = processUnquoted s a
1802 step (WordQuotedEsc s n ql qr) a =
1805 res <- fstep s escChar
1807 FL.Partial s1 -> processQuoted s1 a n ql qr
1808 FL.Done b -> return $ Done 0 b
1809 Just x -> processQuoted s x n ql qr
1810 step (WordQuotedSkipPost b) a =
1814 else Partial 0 $ WordQuotedSkipPost b
1816 err = return . Error
1818 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1819 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1820 extract (WordQuotedWord s n _ _) =
1822 then fmap (Done 0) $ fextract s
1823 else err "wordWithQuotes: missing frame end"
1824 extract WordQuotedEsc {} =
1825 err "wordWithQuotes: trailing escape"
1826 extract (WordUnquotedEsc _) =
1827 err "wordWithQuotes: trailing escape"
1828 extract (WordQuotedSkipPost b) = return (Done 0 b)
1830-- | 'wordWithQuotes' without processing the quotes and escape function
1831-- supplied to escape the quote char within a quote. Can be used to parse words
1832-- keeping the quotes and escapes intact.
1834-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
1836{-# INLINE wordKeepQuotes #-}
1837wordKeepQuotes :: (Monad m, Eq a) =>
1839 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1840 -> (a -> Bool) -- ^ Matches a word separator?
1844 -- Escape the quote char itself
1845 wordWithQuotes True (\q x -> if q == x then Just x else Nothing)
1847-- See the "Quoting Rules" section in the "bash" manual page for a primer on
1848-- how quotes are used by shells.
1850-- | 'wordWithQuotes' with quote processing applied and escape function
1851-- supplied to escape the quote char within a quote. Can be ysed to parse words
1852-- and processing the quoting and escaping at the same time.
1854-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
1856{-# INLINE wordProcessQuotes #-}
1857wordProcessQuotes :: (Monad m, Eq a) =>
1859 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1860 -> (a -> Bool) -- ^ Matches a word separator?
1864 -- Escape the quote char itself
1865 wordWithQuotes False (\q x -> if q == x then Just x else Nothing)
1867{-# ANN type GroupByState Fuse #-}
1868data GroupByState a s
1870 | GroupByGrouping !a !s
1872-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
1873-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1874-- 'True' @b@ is also assigned to the same group. If @a \`cmp` c@ is 'True'
1875-- then @c@ is also assigned to the same group and so on. When the comparison
1876-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1877-- the result of the fold is the result of the parser.
1879-- * Stops - when the comparison fails.
1884-- Stream.fold Fold.toList
1885-- . Stream.parseMany (Parser.groupBy eq Fold.toList)
1889-- >>> runGroupsBy (<) []
1892-- >>> runGroupsBy (<) [1]
1895-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]
1896-- [Right [3,5,4],Right [1,2],Right [0]]
1898{-# INLINE groupBy #-}
1899groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1900groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
1904 {-# INLINE grouper #-}
1909 FL.Done b -> Done 0 b
1910 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1916 FL.Partial s -> IPartial $ GroupByInit s
1917 FL.Done b -> IDone b
1919 step (GroupByInit s) a = grouper s a a
1920 step (GroupByGrouping a0 s) a =
1923 else Done 1 <$> fextract s
1925 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1926 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1928-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
1929-- successive elements in the input stream. Assuming the input stream
1930-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser
1931-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1932-- 'True' @b@ is also assigned to the same group. If @b \`cmp` c@ is 'True'
1933-- then @c@ is also assigned to the same group and so on. When the comparison
1934-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1935-- the result of the fold is the result of the parser.
1937-- * Stops - when the comparison fails.
1941-- runGroupsByRolling eq =
1942-- Stream.fold Fold.toList
1943-- . Stream.parseMany (Parser.groupByRolling eq Fold.toList)
1947-- >>> runGroupsByRolling (<) []
1950-- >>> runGroupsByRolling (<) [1]
1953-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]
1954-- [Right [3,5],Right [4],Right [1,2],Right [0]]
1958{-# INLINE groupByRolling #-}
1959groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1960groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
1964 {-# INLINE grouper #-}
1969 FL.Done b -> Done 0 b
1970 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1976 FL.Partial s -> IPartial $ GroupByInit s
1977 FL.Done b -> IDone b
1979 step (GroupByInit s) a = grouper s a
1980 step (GroupByGrouping a0 s) a =
1983 else Done 1 <$> fextract s
1985 extract (GroupByInit s) = fmap (Done 0) $ fextract s
1986 extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s
1988{-# ANN type GroupByStatePair Fuse #-}
1989data GroupByStatePair a s1 s2
1990 = GroupByInitPair !s1 !s2
1991 | GroupByGroupingPair !a !s1 !s2
1992 | GroupByGroupingPairL !a !s1 !s2
1993 | GroupByGroupingPairR !a !s1 !s2
1995-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
1996-- the first fold as long as the predicate holds 'True', if the predicate is
1997-- 'False' collects using the second fold as long as it remains 'False'.
1998-- Returns 'Left' for the first case and 'Right' for the second case.
2000-- For example, if we want to detect sorted sequences in a stream, both
2001-- ascending and descending cases we can use 'groupByRollingEither (<=)
2002-- Fold.toList Fold.toList'.
2005{-# INLINE groupByRollingEither #-}
2006groupByRollingEither :: Monad m =>
2007 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)
2010 (Fold fstep1 finitial1 fextract1)
2011 (Fold fstep2 finitial2 fextract2) = Parser step initial extract
2015 {-# INLINE grouper #-}
2016 grouper s1 s2 a = do
2017 return $ Continue 0 (GroupByGroupingPair a s1 s2)
2019 {-# INLINE grouperL2 #-}
2020 grouperL2 s1 s2 a = do
2024 FL.Done b -> Done 0 (Left b)
2025 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
2027 {-# INLINE grouperL #-}
2028 grouperL s1 s2 a0 a = do
2031 FL.Done b -> return $ Done 0 (Left b)
2032 FL.Partial s11 -> grouperL2 s11 s2 a
2034 {-# INLINE grouperR2 #-}
2035 grouperR2 s1 s2 a = do
2039 FL.Done b -> Done 0 (Right b)
2040 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
2042 {-# INLINE grouperR #-}
2043 grouperR s1 s2 a0 a = do
2046 FL.Done b -> return $ Done 0 (Right b)
2047 FL.Partial s21 -> grouperR2 s1 s21 a
2056 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
2057 FL.Done b -> IDone (Right b)
2058 FL.Done b -> IDone (Left b)
2060 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
2062 step (GroupByGroupingPair a0 s1 s2) a =
2064 then grouperL s1 s2 a0 a
2065 else grouperR s1 s2 a0 a
2067 step (GroupByGroupingPairL a0 s1 s2) a =
2069 then grouperL2 s1 s2 a
2070 else Done 1 . Left <$> fextract1 s1
2072 step (GroupByGroupingPairR a0 s1 s2) a =
2074 then grouperR2 s1 s2 a
2075 else Done 1 . Right <$> fextract2 s2
2077 extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1
2078 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1
2079 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2
2080 extract (GroupByGroupingPair a s1 _) = do
2083 FL.Done b -> return $ Done 0 (Left b)
2084 FL.Partial s11 -> Done 0 . Left <$> fextract1 s11
2086-- XXX use an Unfold instead of a list?
2087-- XXX custom combinators for matching list, array and stream?
2088-- XXX rename to listBy?
2090-- | Match the given sequence of elements using the given comparison function.
2091-- Returns the original sequence if successful.
2095-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs
2099-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"
2102-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
2103-- Left (ParseError "streamEqBy: mismtach occurred")
2105{-# INLINE listEqBy #-}
2106listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
2107listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs
2109listEqBy cmp str = Parser step initial extract
2113 -- XXX Should return IDone in initial for [] case
2114 initial = return $ IPartial str
2116 step [] _ = return $ Done 0 str
2121 else Error "listEqBy: failed, yet to match the last element"
2127 $ "listEqBy: failed, yet to match "
2128 ++ show (length xs + 1) ++ " elements"
2133 $ "listEqBy: end of input, yet to match "
2134 ++ show (length xs) ++ " elements"
2137{-# INLINE streamEqByInternal #-}
2138streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2139streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract
2144 r <- sstep defState state
2146 D.Yield x s -> return $ IPartial (Just' x, s)
2147 D.Stop -> return $ IDone ()
2148 -- Need Skip/Continue in initial to loop right here
2149 D.Skip s -> return $ IPartial (Nothing', s)
2151 step (Just' x, st) a =
2154 r <- sstep defState st
2157 D.Yield x1 s -> Continue 0 (Just' x1, s)
2159 D.Skip s -> Continue 1 (Nothing', s)
2160 else return $ Error "streamEqBy: mismtach occurred"
2161 step (Nothing', st) a = do
2162 r <- sstep defState st
2167 then Continue 0 (Nothing', s)
2168 else Error "streamEqBy: mismatch occurred"
2170 D.Skip s -> Continue 1 (Nothing', s)
2172 extract _ = return $ Error "streamEqBy: end of input"
2174-- | Like 'listEqBy' but uses a stream instead of a list and does not return
2177{-# INLINE streamEqBy #-}
2178streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2179-- XXX Somehow composing this with "*>" is much faster on the microbenchmark.
2180-- Need to investigate why.
2181streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()
2184-- | Match the input sequence with the supplied list and return it if
2187-- >>> listEq = Parser.listEqBy (==)
2189{-# INLINE listEq #-}
2190listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]
2191listEq = listEqBy (==)
2193-- | Match if the input stream is a subsequence of the argument stream i.e. all
2194-- the elements of the input stream occur, in order, in the argument stream.
2195-- The elements do not have to occur consecutively. A sequence is considered a
2196-- subsequence of itself.
2197{-# INLINE subsequenceBy #-}
2198subsequenceBy :: -- Monad m =>
2199 (a -> a -> Bool) -> Stream m a -> Parser a m ()
2200subsequenceBy = undefined
2203-- Should go in Data.Parser.Regex in streamly package so that it can depend on
2205{-# INLINE regexPosix #-}
2206regexPosix :: -- Monad m =>
2207 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2208regexPosix = undefined
2210{-# INLINE regexPCRE #-}
2211regexPCRE :: -- Monad m =>
2212 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2213regexPCRE = undefined
2216-------------------------------------------------------------------------------
2217-- Transformations on input
2218-------------------------------------------------------------------------------
2220-- Initial needs a "Continue" constructor to implement scans on parsers. As a
2221-- parser can always return a Continue in initial when we feed the fold's
2222-- initial result to it. We can work this around for postscan by introducing an
2223-- initial state and calling "initial" only on the first input.
2225-- | Stateful scan on the input of a parser using a Fold.
2229{-# INLINE postscan #-}
2230postscan :: -- Monad m =>
2231 Fold m a b -> Parser b m c -> Parser a m c
2234{-# INLINE zipWithM #-}
2235zipWithM :: Monad m =>
2236 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x
2237zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =
2238 Parser step initial extract
2246 r <- sstep defState state
2248 D.Yield x s -> return $ IPartial (Just' x, s, fs)
2252 -- Need Skip/Continue in initial to loop right here
2253 D.Skip s -> return $ IPartial (Nothing', s, fs)
2254 FL.Done x -> return $ IDone x
2256 step (Just' a, st, fs) b = do
2260 FL.Partial fs1 -> do
2261 r <- sstep defState st
2263 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
2267 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
2268 FL.Done x -> return $ Done 0 x
2269 step (Nothing', st, fs) b = do
2270 r <- sstep defState st
2277 return $ Continue 0 (Nothing', s, fs1)
2278 FL.Done x -> return $ Done 0 x
2282 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
2284 extract _ = return $ Error "zipWithM: end of input"
2286-- | Zip the input of a fold with a stream.
2291zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x
2292zip = zipWithM (curry return)
2294-- | Pair each element of a fold input with its index, starting from index 0.
2297{-# INLINE indexed #-}
2298indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b
2299indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
2301-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
2302-- function using a fold indexing function that attaches an index to each input
2303-- element and a filtering function that filters using @(index, element) ->
2304-- Bool) as predicate.
2309-- filterWithIndex = makeIndexFilter indexed filter
2310-- filterWithAbsTime = makeIndexFilter timestamped filter
2311-- filterWithRelTime = makeIndexFilter timeIndexed filter
2315{-# INLINE makeIndexFilter #-}
2317 (Fold m (s, a) b -> Parser a m b)
2318 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
2319 -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)
2320makeIndexFilter f comb g = f . comb g . FL.lmap snd
2322-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
2323-- then every element at strides of @stride@.
2326{-# INLINE sampleFromthen #-}
2327sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
2328sampleFromthen offset size =
2329 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
2331--------------------------------------------------------------------------------
2333--------------------------------------------------------------------------------
2335-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
2336-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
2340-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
2342-- > span_ (< 1) [1,2,3]
2345-- > span_ (< 2) [1,2,3]
2348-- > span_ (< 4) [1,2,3]
2355span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2356span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
2358-- | Break the input stream into two groups, the first group takes the input as
2359-- long as the predicate applied to the first element of the stream and next
2360-- input element holds 'True', the second group takes the rest of the input.
2364{-# INLINE spanBy #-}
2367 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2368spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
2370-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
2371-- predicate is applied to the previous and the next input elements.
2374{-# INLINE spanByRolling #-}
2377 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2378spanByRolling eq f1 f2 =
2379 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
2381-------------------------------------------------------------------------------
2383-------------------------------------------------------------------------------
2385-- | Takes at-most @n@ input elements.
2387-- * Stops - when the collecting parser stops.
2388-- * Fails - when the collecting parser fails.
2390-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2393-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2394-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")
2398takeP :: Monad m => Int -> Parser a m b -> Parser a m b
2399takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
2408 then return $ IPartial $ Tuple' 0 s
2410 IDone b -> return $ IDone b
2411 IError e -> return $ IError e
2413 step (Tuple' cnt r) a = do
2421 then return $ Partial 0 $ Tuple' cnt1 s
2425 Done n b -> Done n b
2426 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2427 Error err -> Error err
2428 Partial _ _ -> error "takeP: Partial in extract"
2433 then return $ Continue 0 $ Tuple' cnt1 s
2437 Done n b -> Done n b
2438 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2439 Error err -> Error err
2440 Partial _ _ -> error "takeP: Partial in extract"
2442 let taken = cnt1 - n
2444 return $ Partial n $ Tuple' taken s
2446 let taken = cnt1 - n
2448 return $ Continue n $ Tuple' taken s
2449 Done n b -> return $ Done n b
2450 Error str -> return $ Error str
2452 extract (Tuple' cnt r) = do
2455 Done n b -> Done n b
2456 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
2457 Error err -> Error err
2458 Partial _ _ -> error "takeP: Partial in extract"
2460 -- XXX Need to make the Initial type Step to remove this
2465 Error err -> IError err
2466 _ -> error "Bug: takeP invalid state in initial"
2468-- | Run a parser without consuming the input.
2470{-# INLINE lookAhead #-}
2471lookAhead :: Monad m => Parser a m b -> Parser a m b
2472lookAhead (Parser step1 initial1 _) = Parser step initial extract
2478 return $ case res of
2479 IPartial s -> IPartial (Tuple'Fused 0 s)
2481 IError e -> IError e
2483 step (Tuple'Fused cnt st) a = do
2488 Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2489 Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2490 Done _ b -> Done cnt1 b
2491 Error err -> Error err
2493 -- XXX returning an error let's us backtrack. To implement it in a way so
2494 -- that it terminates on eof without an error then we need a way to
2495 -- backtrack on eof, that will require extract to return 'Step' type.
2496 extract (Tuple'Fused n _) =
2499 $ "lookAhead: end of input after consuming "
2500 ++ show n ++ " elements"
2502-------------------------------------------------------------------------------
2504-------------------------------------------------------------------------------
2506-- To deinterleave we can chain two parsers one behind the other. The input is
2507-- given to the first parser and the input definitively rejected by the first
2508-- parser is given to the second parser.
2510-- We can either have the parsers themselves buffer the input or use the shared
2511-- global buffer to hold it until none of the parsers need it. When the first
2512-- parser returns Skip (i.e. rewind) we let the second parser consume the
2513-- rejected input and when it is done we move the cursor forward to the first
2514-- parser again. This will require a "move forward" command as well.
2516-- To implement grep we can use three parsers, one to find the pattern, one
2517-- to store the context behind the pattern and one to store the context in
2518-- front of the pattern. When a match occurs we need to emit the accumulator of
2519-- all the three parsers. One parser can count the line numbers to provide the
2522{-# ANN type DeintercalateAllState Fuse #-}
2523data DeintercalateAllState fs sp ss =
2524 DeintercalateAllInitL !fs
2525 | DeintercalateAllL !fs !sp
2526 | DeintercalateAllInitR !fs
2527 | DeintercalateAllR !fs !ss
2529-- XXX rename this to intercalate
2531-- Having deintercalateAll for accepting or rejecting entire input could be
2532-- useful. For example, in case of JSON parsing we get an entire block of
2533-- key-value pairs which we need to verify. This version may be simpler, more
2534-- efficient. We could implement this as a stream operation like parseMany.
2536-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
2537-- example, in case of csv parsing as we are feeding a line to a fold we can
2540-- | Like 'deintercalate' but the entire input must satisfy the pattern
2541-- otherwise the parser fails. This is many times faster than deintercalate.
2543-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2544-- >>> p2 = Parser.satisfy (== '+')
2545-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
2546-- >>> Stream.parse p $ Stream.fromList ""
2548-- >>> Stream.parse p $ Stream.fromList "1"
2550-- >>> Stream.parse p $ Stream.fromList "1+"
2551-- Left (ParseError "takeWhile1: end of input")
2552-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2553-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2555{-# INLINE deintercalateAll #-}
2556deintercalateAll :: Monad m =>
2559 -> Fold m (Either x y) z
2562 (Parser stepL initialL extractL)
2563 (Parser stepR initialR _)
2564 (Fold fstep finitial fextract) = Parser step initial extract
2569 error $ "deintercalate: " ++ p ++ " parser cannot "
2570 ++ status ++ " without input"
2575 FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2576 FL.Done c -> return $ IDone c
2578 {-# INLINE processL #-}
2579 processL foldAction n nextState = do
2582 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2583 FL.Done c -> return $ Done n c
2585 {-# INLINE runStepL #-}
2586 runStepL fs sL a = do
2589 Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2590 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2592 processL (fstep fs (Left b)) n DeintercalateAllInitR
2593 Error err -> return $ Error err
2595 {-# INLINE processR #-}
2596 processR foldAction n = do
2599 FL.Partial fs1 -> do
2602 IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
2603 IDone _ -> errMsg "left" "succeed"
2604 IError _ -> errMsg "left" "fail"
2605 FL.Done c -> return $ Done n c
2607 {-# INLINE runStepR #-}
2608 runStepR fs sR a = do
2611 Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2612 Continue n s -> return $ Continue n (DeintercalateAllR fs s)
2613 Done n b -> processR (fstep fs (Right b)) n
2614 Error err -> return $ Error err
2616 step (DeintercalateAllInitL fs) a = do
2619 IPartial s -> runStepL fs s a
2620 IDone _ -> errMsg "left" "succeed"
2621 IError _ -> errMsg "left" "fail"
2622 step (DeintercalateAllL fs sL) a = runStepL fs sL a
2623 step (DeintercalateAllInitR fs) a = do
2626 IPartial s -> runStepR fs s a
2627 IDone _ -> errMsg "right" "succeed"
2628 IError _ -> errMsg "right" "fail"
2629 step (DeintercalateAllR fs sR) a = runStepR fs sR a
2631 {-# INLINE extractResult #-}
2632 extractResult n fs r = do
2635 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2636 FL.Done c -> return (Done n c)
2637 extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs
2638 extract (DeintercalateAllL fs sL) = do
2641 Done n b -> extractResult n fs (Left b)
2642 Error err -> return $ Error err
2643 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2644 Partial _ _ -> error "Partial in extract"
2645 extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs
2646 extract (DeintercalateAllR _ _) =
2647 return $ Error "deintercalateAll: input ended at 'Right' value"
2649{-# ANN type DeintercalateState Fuse #-}
2650data DeintercalateState b fs sp ss =
2651 DeintercalateInitL !fs
2652 | DeintercalateL !Int !fs !sp
2653 | DeintercalateInitR !fs
2654 | DeintercalateR !Int !fs !ss
2655 | DeintercalateRL !Int !b !fs !sp
2657-- XXX Add tests that the next character that we take after running a parser is
2658-- correct. Especially for the parsers that maintain a count. In the stream
2659-- finished case (extract) as well as not finished case.
2661-- | Apply two parsers alternately to an input stream. The input stream is
2662-- considered an interleaving of two patterns. The two parsers represent the
2663-- two patterns. Parsing starts at the first parser and stops at the first
2664-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2665-- input or single parse of the first parser is accepted.
2667-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2668-- >>> p2 = Parser.satisfy (== '+')
2669-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2670-- >>> Stream.parse p $ Stream.fromList ""
2672-- >>> Stream.parse p $ Stream.fromList "1"
2674-- >>> Stream.parse p $ Stream.fromList "1+"
2676-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2677-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2679{-# INLINE deintercalate #-}
2680deintercalate :: Monad m =>
2683 -> Fold m (Either x y) z
2686 (Parser stepL initialL extractL)
2687 (Parser stepR initialR _)
2688 (Fold fstep finitial fextract) = Parser step initial extract
2693 error $ "deintercalate: " ++ p ++ " parser cannot "
2694 ++ status ++ " without input"
2699 FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2700 FL.Done c -> return $ IDone c
2702 {-# INLINE processL #-}
2703 processL foldAction n nextState = do
2706 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2707 FL.Done c -> return $ Done n c
2709 {-# INLINE runStepL #-}
2710 runStepL cnt fs sL a = do
2714 Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2715 Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2717 processL (fstep fs (Left b)) n DeintercalateInitR
2720 return $ Done cnt1 xs
2722 {-# INLINE processR #-}
2723 processR cnt b fs n = do
2726 IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2727 IDone _ -> errMsg "left" "succeed"
2728 IError _ -> errMsg "left" "fail"
2730 {-# INLINE runStepR #-}
2731 runStepR cnt fs sR a = do
2735 Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2736 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2737 Done n b -> processR (cnt1 - n) b fs n
2740 return $ Done cnt1 xs
2742 step (DeintercalateInitL fs) a = do
2745 IPartial s -> runStepL 0 fs s a
2746 IDone _ -> errMsg "left" "succeed"
2747 IError _ -> errMsg "left" "fail"
2748 step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2749 step (DeintercalateInitR fs) a = do
2752 IPartial s -> runStepR 0 fs s a
2753 IDone _ -> errMsg "right" "succeed"
2754 IError _ -> errMsg "right" "fail"
2755 step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2756 step (DeintercalateRL cnt bR fs sL) a = do
2760 Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2761 Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2763 res <- fstep fs (Right bR)
2765 FL.Partial fs1 -> do
2766 fres <- fstep fs1 (Left bL)
2769 return $ Partial n (DeintercalateInitR fs2)
2770 FL.Done c -> return $ Done n c
2771 -- XXX We could have the fold accept pairs of (bR, bL)
2772 FL.Done _ -> error "Fold terminated consuming partial input"
2775 return $ Done cnt1 xs
2777 {-# INLINE extractResult #-}
2778 extractResult n fs r = do
2781 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2782 FL.Done c -> return (Done n c)
2784 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs
2785 extract (DeintercalateL cnt fs sL) = do
2788 Done n b -> extractResult n fs (Left b)
2789 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2790 Partial _ _ -> error "Partial in extract"
2793 return $ Done cnt xs
2794 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs
2795 extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs
2796 extract (DeintercalateRL cnt bR fs sL) = do
2800 res <- fstep fs (Right bR)
2802 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2803 FL.Done _ -> error "Fold terminated consuming partial input"
2804 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2805 Partial _ _ -> error "Partial in extract"
2808 return $ Done cnt xs
2810{-# ANN type Deintercalate1State Fuse #-}
2811data Deintercalate1State b fs sp ss =
2812 Deintercalate1InitL !Int !fs !sp
2813 | Deintercalate1InitR !fs
2814 | Deintercalate1R !Int !fs !ss
2815 | Deintercalate1RL !Int !b !fs !sp
2817-- | Apply two parsers alternately to an input stream. The input stream is
2818-- considered an interleaving of two patterns. The two parsers represent the
2819-- two patterns. Parsing starts at the first parser and stops at the first
2820-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2821-- input or single parse of the first parser is accepted.
2823-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2824-- >>> p2 = Parser.satisfy (== '+')
2825-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2826-- >>> Stream.parse p $ Stream.fromList ""
2827-- Left (ParseError "takeWhile1: end of input")
2828-- >>> Stream.parse p $ Stream.fromList "1"
2830-- >>> Stream.parse p $ Stream.fromList "1+"
2832-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2833-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2835{-# INLINE deintercalate1 #-}
2836deintercalate1 :: Monad m =>
2839 -> Fold m (Either x y) z
2842 (Parser stepL initialL extractL)
2843 (Parser stepR initialR _)
2844 (Fold fstep finitial fextract) = Parser step initial extract
2849 error $ "deintercalate: " ++ p ++ " parser cannot "
2850 ++ status ++ " without input"
2858 IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2859 IDone _ -> errMsg "left" "succeed"
2860 IError _ -> errMsg "left" "fail"
2861 FL.Done c -> return $ IDone c
2863 {-# INLINE processL #-}
2864 processL foldAction n nextState = do
2867 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2868 FL.Done c -> return $ Done n c
2870 {-# INLINE runStepInitL #-}
2871 runStepInitL cnt fs sL a = do
2875 Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2876 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2878 processL (fstep fs (Left b)) n Deintercalate1InitR
2879 Error err -> return $ Error err
2881 {-# INLINE processR #-}
2882 processR cnt b fs n = do
2885 IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2886 IDone _ -> errMsg "left" "succeed"
2887 IError _ -> errMsg "left" "fail"
2889 {-# INLINE runStepR #-}
2890 runStepR cnt fs sR a = do
2894 Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2895 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2896 Done n b -> processR (cnt1 - n) b fs n
2899 return $ Done cnt1 xs
2901 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2902 step (Deintercalate1InitR fs) a = do
2905 IPartial s -> runStepR 0 fs s a
2906 IDone _ -> errMsg "right" "succeed"
2907 IError _ -> errMsg "right" "fail"
2908 step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2909 step (Deintercalate1RL cnt bR fs sL) a = do
2913 Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2914 Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2916 res <- fstep fs (Right bR)
2918 FL.Partial fs1 -> do
2919 fres <- fstep fs1 (Left bL)
2922 return $ Partial n (Deintercalate1InitR fs2)
2923 FL.Done c -> return $ Done n c
2924 -- XXX We could have the fold accept pairs of (bR, bL)
2925 FL.Done _ -> error "Fold terminated consuming partial input"
2928 return $ Done cnt1 xs
2930 {-# INLINE extractResult #-}
2931 extractResult n fs r = do
2934 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2935 FL.Done c -> return (Done n c)
2937 extract (Deintercalate1InitL cnt fs sL) = do
2940 Done n b -> extractResult n fs (Left b)
2941 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2942 Partial _ _ -> error "Partial in extract"
2943 Error err -> return $ Error err
2944 extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2945 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2946 extract (Deintercalate1RL cnt bR fs sL) = do
2950 res <- fstep fs (Right bR)
2952 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2953 FL.Done _ -> error "Fold terminated consuming partial input"
2954 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2955 Partial _ _ -> error "Partial in extract"
2958 return $ Done cnt xs
2960{-# ANN type SepByState Fuse #-}
2961data SepByState fs sp ss =
2963 | SepByL !Int !fs !sp
2965 | SepByR !Int !fs !ss
2967-- | Apply two parsers alternately to an input stream. Parsing starts at the
2968-- first parser and stops at the first parser. The output of the first parser
2969-- is emiited and the output of the second parser is discarded. It can be used
2970-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
2971-- of the first parser is accepted.
2975-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
2976-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)
2980-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2981-- >>> p2 = Parser.satisfy (== '+')
2982-- >>> p = Parser.sepBy p1 p2 Fold.toList
2983-- >>> Stream.parse p $ Stream.fromList ""
2985-- >>> Stream.parse p $ Stream.fromList "1"
2987-- >>> Stream.parse p $ Stream.fromList "1+"
2989-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2990-- Right ["1","2","3"]
2994 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
2995-- This has similar performance as the custom impl below.
2996-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
2998 (Parser stepL initialL extractL)
2999 (Parser stepR initialR _)
3000 (Fold fstep finitial fextract) = Parser step initial extract
3005 error $ "sepBy: " ++ p ++ " parser cannot "
3006 ++ status ++ " without input"
3011 FL.Partial fs -> return $ IPartial $ SepByInitL fs
3012 FL.Done c -> return $ IDone c
3014 {-# INLINE processL #-}
3015 processL foldAction n nextState = do
3018 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3019 FL.Done c -> return $ Done n c
3021 {-# INLINE runStepL #-}
3022 runStepL cnt fs sL a = do
3026 Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3027 Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3029 processL (fstep fs b) n SepByInitR
3032 return $ Done cnt1 xs
3034 {-# INLINE processR #-}
3035 processR cnt fs n = do
3038 IPartial ps -> return $ Continue n (SepByL cnt fs ps)
3039 IDone _ -> errMsg "left" "succeed"
3040 IError _ -> errMsg "left" "fail"
3042 {-# INLINE runStepR #-}
3043 runStepR cnt fs sR a = do
3047 Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3048 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3049 Done n _ -> processR (cnt1 - n) fs n
3052 return $ Done cnt1 xs
3054 step (SepByInitL fs) a = do
3057 IPartial s -> runStepL 0 fs s a
3058 IDone _ -> errMsg "left" "succeed"
3059 IError _ -> errMsg "left" "fail"
3060 step (SepByL cnt fs sL) a = runStepL cnt fs sL a
3061 step (SepByInitR fs) a = do
3064 IPartial s -> runStepR 0 fs s a
3065 IDone _ -> errMsg "right" "succeed"
3066 IError _ -> errMsg "right" "fail"
3067 step (SepByR cnt fs sR) a = runStepR cnt fs sR a
3069 {-# INLINE extractResult #-}
3070 extractResult n fs r = do
3073 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3074 FL.Done c -> return (Done n c)
3076 extract (SepByInitL fs) = fmap (Done 0) $ fextract fs
3077 extract (SepByL cnt fs sL) = do
3080 Done n b -> extractResult n fs b
3081 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
3082 Partial _ _ -> error "Partial in extract"
3085 return $ Done cnt xs
3086 extract (SepByInitR fs) = fmap (Done 0) $ fextract fs
3087 extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs
3089-- | Non-backtracking version of sepBy. Several times faster.
3090{-# INLINE sepByAll #-}
3091sepByAll :: Monad m =>
3092 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3093sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)
3095-- XXX This can be implemented using refold, parse one and then continue
3096-- collecting the rest in that.
3098{-# ANN type SepBy1State Fuse #-}
3099data SepBy1State fs sp ss =
3100 SepBy1InitL !Int !fs sp
3101 | SepBy1L !Int !fs !sp
3103 | SepBy1R !Int !fs !ss
3106{-# INLINE sepBy1 #-}
3108 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3109sepBy1 p sep sink = do
3111 f <- fromEffect $ FL.reduce sink
3112 f1 <- fromEffect $ FL.snoc f x
3116-- | Like 'sepBy' but requires at least one successful parse.
3120-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
3124-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3125-- >>> p2 = Parser.satisfy (== '+')
3126-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
3127-- >>> Stream.parse p $ Stream.fromList ""
3128-- Left (ParseError "takeWhile1: end of input")
3129-- >>> Stream.parse p $ Stream.fromList "1"
3131-- >>> Stream.parse p $ Stream.fromList "1+"
3133-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3134-- Right ["1","2","3"]
3136{-# INLINE sepBy1 #-}
3138 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3140 (Parser stepL initialL extractL)
3141 (Parser stepR initialR _)
3142 (Fold fstep finitial fextract) = Parser step initial extract
3147 error $ "sepBy: " ++ p ++ " parser cannot "
3148 ++ status ++ " without input"
3156 IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
3157 IDone _ -> errMsg "left" "succeed"
3158 IError _ -> errMsg "left" "fail"
3159 FL.Done c -> return $ IDone c
3161 {-# INLINE processL #-}
3162 processL foldAction n nextState = do
3165 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3166 FL.Done c -> return $ Done n c
3168 {-# INLINE runStepInitL #-}
3169 runStepInitL cnt fs sL a = do
3173 Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3174 Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3176 processL (fstep fs b) n SepBy1InitR
3177 Error err -> return $ Error err
3179 {-# INLINE runStepL #-}
3180 runStepL cnt fs sL a = do
3184 Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3185 Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3187 processL (fstep fs b) n SepBy1InitR
3190 return $ Done cnt1 xs
3192 {-# INLINE processR #-}
3193 processR cnt fs n = do
3196 IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3197 IDone _ -> errMsg "left" "succeed"
3198 IError _ -> errMsg "left" "fail"
3200 {-# INLINE runStepR #-}
3201 runStepR cnt fs sR a = do
3205 Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3206 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3207 Done n _ -> processR (cnt1 - n) fs n
3210 return $ Done cnt1 xs
3212 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3213 step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3214 step (SepBy1InitR fs) a = do
3217 IPartial s -> runStepR 0 fs s a
3218 IDone _ -> errMsg "right" "succeed"
3219 IError _ -> errMsg "right" "fail"
3220 step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3222 {-# INLINE extractResult #-}
3223 extractResult n fs r = do
3226 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3227 FL.Done c -> return (Done n c)
3229 extract (SepBy1InitL cnt fs sL) = do
3232 Done n b -> extractResult n fs b
3233 Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3234 Partial _ _ -> error "Partial in extract"
3235 Error err -> return $ Error err
3236 extract (SepBy1L cnt fs sL) = do
3239 Done n b -> extractResult n fs b
3240 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3241 Partial _ _ -> error "Partial in extract"
3244 return $ Done cnt xs
3245 extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs
3246 extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs
3248-------------------------------------------------------------------------------
3249-- Interleaving a collection of parsers
3250-------------------------------------------------------------------------------
3252-- | Apply a collection of parsers to an input stream in a round robin fashion.
3253-- Each parser is applied until it stops and then we repeat starting with the
3254-- the first parser again.
3258{-# INLINE roundRobin #-}
3259roundRobin :: -- (Foldable t, Monad m) =>
3260 t (Parser a m b) -> Fold m b c -> Parser a m c
3261roundRobin _ps _f = undefined
3263-------------------------------------------------------------------------------
3264-- Sequential Collection
3265-------------------------------------------------------------------------------
3267-- | @sequence f p@ collects sequential parses of parsers in a
3268-- serial stream @p@ using the fold @f@. Fails if the input ends or any
3269-- of the parsers fail.
3273{-# INLINE sequence #-}
3274sequence :: Monad m =>
3275 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c
3276sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =
3277 Parser step initial extract
3284 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
3285 FL.Done c -> return $ IDone c
3287 -- state does not contain any parser
3288 -- yield a new parser from the stream
3289 step (Nothing', ss, fs) _ = do
3290 sres <- sstep defState ss
3292 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
3296 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
3298 -- state holds a parser that may or may not have been
3299 -- initialized. pinit holds the initial parser state
3300 -- or modified parser state respectively
3301 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
3309 Just' $ Parser pstep (return $ IPartial ps2) pextr
3310 in return $ Partial n (newP, ss, fs)
3313 Just' $ Parser pstep (return $ IPartial ps2) pextr
3314 in return $ Continue n (newP, ss, fs)
3319 return $ Partial n (Nothing', ss, fs1)
3320 FL.Done c -> return $ Done n c
3321 Error msg -> return $ Error msg
3326 return $ Partial 1 (Nothing', ss, fs1)
3327 FL.Done c -> return $ Done 1 c
3328 IError err -> return $ Error err
3330 extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs
3331 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
3340 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3341 FL.Done c -> return (Done n c)
3342 Error err -> return $ Error err
3343 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
3344 Partial _ _ -> error "Partial in extract"
3348 FL.Partial fs1 -> fmap (Done 0) $ fextract fs1
3349 FL.Done c -> return (Done 0 c)
3350 IError err -> return $ Error err
3352-------------------------------------------------------------------------------
3353-- Alternative Collection
3354-------------------------------------------------------------------------------
3357-- | @choice parsers@ applies the @parsers@ in order and returns the first
3360-- This is same as 'asum' but more efficient.
3364{-# INLINE choice #-}
3365choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b
3366choice = foldl1 shortest
3369-------------------------------------------------------------------------------
3370-- Sequential Repetition
3371-------------------------------------------------------------------------------
3373-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the
3374-- results. Parsing stops or fails if the collecting parser stops or fails.
3379manyP :: -- MonadCatch m =>
3380 Parser a m b -> Parser b m c -> Parser a m c
3381manyP _p _f = undefined
3383-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
3384-- input stream and push the parse results to a downstream fold.
3386-- Stops: when the downstream fold stops or the parser fails.
3387-- Fails: never, produces zero or more results.
3389-- >>> many = Parser.countBetween 0 maxBound
3391-- Compare with 'Control.Applicative.many'.
3394many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3396-- many = countBetween 0 maxBound
3398-- Note: many1 would perhaps be a better name for this and consistent with
3399-- other names like takeWhile1. But we retain the name "some" for
3402-- | Collect one or more parses. Apply the supplied parser repeatedly on the
3403-- input stream and push the parse results to a downstream fold.
3405-- Stops: when the downstream fold stops or the parser fails.
3406-- Fails: if it stops without producing a single result.
3408-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)
3409-- >>> some = Parser.countBetween 1 maxBound
3411-- Compare with 'Control.Applicative.some'.
3414some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3416-- some p f = manyP p (takeGE 1 f)
3417-- some = countBetween 1 maxBound
3419-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
3420-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
3421-- the input ends or the parser fails before @m@ results are collected.
3423-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)
3427{-# INLINE countBetween #-}
3428countBetween :: -- MonadCatch m =>
3429 Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
3430countBetween _m _n _p = undefined
3431-- countBetween m n p f = manyP p (takeBetween m n f)
3433-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
3434-- the fold @f@. Fails if the input ends or the parser fails before @n@
3435-- results are collected.
3437-- >>> count n = Parser.countBetween n n
3438-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)
3443count :: -- MonadCatch m =>
3444 Int -> Parser a m b -> Fold m b c -> Parser a m c
3445count n = countBetween n n
3446-- count n p f = manyP p (takeEQ n f)
3448-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a
3449-- 'Fold'. Parsing stops or fails if the collecting parser stops or fails.
3451-- We can implemnent parsers like the following using 'manyTillP':
3454-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p
3459{-# INLINE manyTillP #-}
3460manyTillP :: -- Monad m =>
3461 Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
3462manyTillP _p1 _p2 _f = undefined
3463 -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f
3465{-# ANN type ManyTillState Fuse #-}
3466data ManyTillState fs sr sl
3467 = ManyTillR !Int !fs !sr
3470-- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@
3471-- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is
3472-- tried again and so on. The parser stops when @test@ succeeds. The output of
3473-- @test@ is discarded and the output of @chunking@ is accumulated by the
3474-- supplied fold. The parser fails if @chunking@ fails.
3476-- Stops when the fold @f@ stops.
3478{-# INLINE manyTill #-}
3480 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3481manyTill (Parser stepL initialL extractL)
3482 (Parser stepR initialR _)
3483 (Fold fstep finitial fextract) =
3484 Parser step initial extract
3488 -- Caution: Mutual recursion
3490 scrutL fs p c d e = do
3493 IPartial sl -> return $ c (ManyTillL fs sl)
3497 FL.Partial fs1 -> scrutR fs1 p c d e
3498 FL.Done fb -> return $ d fb
3499 IError err -> return $ e err
3501 scrutR fs p c d e = do
3504 IPartial sr -> return $ p (ManyTillR 0 fs sr)
3505 IDone _ -> d <$> fextract fs
3506 IError _ -> scrutL fs p c d e
3511 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
3512 FL.Done b -> return $ IDone b
3514 step (ManyTillR cnt fs st) a = do
3517 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
3519 assertM(cnt + 1 - n >= 0)
3520 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
3528 return $ Continue (cnt + 1) (ManyTillL fs sl)
3540 FL.Done fb -> return $ Done cnt1 fb
3541 IError err -> return $ Error err
3542 step (ManyTillL fs st) a = do
3545 Partial n s -> return $ Partial n (ManyTillL fs s)
3546 Continue n s -> return $ Continue n (ManyTillL fs s)
3551 scrutR s (Partial n) (Continue n) (Done n) Error
3552 FL.Done b1 -> return $ Done n b1
3553 Error err -> return $ Error err
3555 extract (ManyTillL fs sR) = do
3561 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3562 FL.Done c -> return (Done n c)
3563 Error err -> return $ Error err
3564 Continue n s -> return $ Continue n (ManyTillL fs s)
3565 Partial _ _ -> error "Partial in extract"
3566 extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs
3568-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
3569-- collects the output in the supplied fold. If the the parser @collect@ fails,
3570-- parser @recover@ is run until it stops and then we start repeating the
3571-- parser @collect@ again. The parser fails if the recovery parser fails.
3573-- For example, this can be used to find a key frame in a video stream after an
3578{-# INLINE manyThen #-}
3579manyThen :: -- (Foldable t, Monad m) =>
3580 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3581manyThen _parser _recover _f = undefined
3583-------------------------------------------------------------------------------
3584-- Repeated Alternatives
3585-------------------------------------------------------------------------------
3587-- | Keep trying a parser up to a maximum of @n@ failures. When the parser
3588-- fails the input consumed till now is dropped and the new instance is tried
3589-- on the fresh input.
3593{-# INLINE retryMaxTotal #-}
3594retryMaxTotal :: -- (Monad m) =>
3595 Int -> Parser a m b -> Fold m b c -> Parser a m c
3596retryMaxTotal _n _p _f = undefined
3598-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.
3602{-# INLINE retryMaxSuccessive #-}
3603retryMaxSuccessive :: -- (Monad m) =>
3604 Int -> Parser a m b -> Fold m b c -> Parser a m c
3605retryMaxSuccessive _n _p _f = undefined
3607-- | Keep trying a parser until it succeeds. When the parser fails the input
3608-- consumed till now is dropped and the new instance is tried on the fresh
3614retry :: -- (Monad m) =>
3615 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