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
13 -- | To execute the code examples provided in this module in ghci, please
14 -- run the following commands first.
18 module Streamly.Internal.Data.Parser.Type
19 --, module Streamly.Internal.Data.Parser.Tee
27 -- * Downgrade to Fold
30 -- First order parsers
41 -- All of these can be expressed in terms of either
52 -- * Sequence parsers (tokenizers)
54 -- | Parsers chained in series, if one parser terminates the composition
55 -- terminates. Currently we are using folds to collect the output of the
56 -- parsers but we can use Parsers instead of folds to make the composition
57 -- more powerful. For example, we can do:
59 -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
60 -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
61 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
65 -- | Grab a sequence of input elements without inspecting them
67 -- , take -- takeBetween 0 n
68 , takeEQ -- takeBetween n n
69 , takeGE -- takeBetween n maxBound
70 -- , takeGE1 -- take1 -- takeBetween 1 n
73 -- Grab a sequence of input elements by inspecting them
86 -- ** Separated by elements
87 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
88 -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
89 -- separator parsing, also see 'intersperseQuotedBy' fold.
91 -- These can be implemented modularly with refolds, using takeWhile and
102 -- ** Grouped by element comparison
105 , groupByRollingEither
107 -- ** Framed by elements
108 -- | Also see 'intersperseQuotedBy' fold.
109 -- Framed by a one or more ocurrences of a separator around a word like
110 -- spaces or quotes. No nesting.
111 , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
116 -- Framed by separate start and end characters, potentially nested.
117 -- blockWithQuotes allows quotes inside a block. However,
118 -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and
119 -- block with escaping.
123 , takeFramedByGeneric
127 -- , prefixOf -- match any prefix of a given string
128 -- , suffixOf -- match any suffix of a given string
129 -- , infixOf -- match any substring of a given string
136 -- Second order parsers (parsers using parsers)
137 -- * Binary Combinators
139 -- ** Parallel Applicatives
143 -- , teeTill -- like manyTill but parallel
147 -- ** Parallel Alternatives
153 -- * N-ary Combinators
154 -- ** Sequential Collection
157 -- ** Sequential Repetition
160 -- , countBetweenTill
165 -- ** Interleaved Repetition
166 -- Use two folds, run a primary parser, its rejected values go to the
171 -- , deintercalatePrefix
172 -- , deintercalateSuffix
175 -- | TODO: traditional implmentations of these may be of limited use. For
176 -- example, consider parsing lines separated by @\\r\\n@. The main parser
177 -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
178 -- can apply the "sep" parser.
180 -- We can instead implement these as special cases of deintercalate.
199 -- A simple and stupid impl would be to just convert the stream to an array
200 -- and give the array reference to all consumers. The array can be grown on
201 -- demand by any consumer and truncated when nonbody needs it.
203 -- -- ** Distribute to collection
204 -- -- ** Distribute to repetition
206 -- ** Interleaved collection
213 -- -- ** Interleaved repetition
214 -- repeat one parser and when it fails run an error recovery parser
215 -- e.g. to find a key frame in the stream after an error
217 -- ** Collection of Alternatives
223 -- , fastestN -- first N successful in time
224 -- , choiceN -- first N successful in position
226 -- , choice -- first successful in position
228 -- ** Repeated Alternatives
248import Control.Monad (when)
249import Data.Bifunctor (first)
250import Fusion.Plugin.Types (Fuse(..))
251import Streamly.Internal.Data.Fold.Type (Fold(..))
252import Streamly.Internal.Data.SVar.Type (defState)
253import Streamly.Internal.Data.Either.Strict (Either'(..))
254import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
255import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
256import Streamly.Internal.Data.Stream.Type (Stream)
258import qualified Data.Foldable as Foldable
259import qualified Streamly.Internal.Data.Fold.Type as FL
260import qualified Streamly.Internal.Data.Stream.Type as D
261import qualified Streamly.Internal.Data.Stream.Generate as D
263import Streamly.Internal.Data.Parser.Type
264--import Streamly.Internal.Data.Parser.Tee -- It's empty
267 (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
268 , zip, filter, dropWhile)
270#include "DocTestDataParser.hs"
272-------------------------------------------------------------------------------
273-- Downgrade a parser to a Fold
274-------------------------------------------------------------------------------
276-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the
277-- parser fails or tries to backtrack.
279-- This can be useful in combinators that accept a Fold and we know that a
280-- Parser cannot fail or failure exception is acceptable as there is no way to
286toFold :: Monad m => Parser a m b -> Fold m a b
287toFold (Parser pstep pinitial pextract) = Fold step initial extract final
294 IPartial s -> return $ FL.Partial s
295 IDone b -> return $ FL.Done b
297 error $ "toFold: parser throws error in initial" ++ err
299 perror n = error $ "toFold: parser backtracks in Partial: " ++ show n
300 cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n
301 derror n = error $ "toFold: parser backtracks in Done: " ++ show n
302 eerror err = error $ "toFold: parser throws error: " ++ err
307 Partial 0 s -> return $ FL.Partial s
308 Continue 0 s -> return $ FL.Partial s
309 Done 0 b -> return $ FL.Done b
310 Partial n _ -> perror n
311 Continue n _ -> cerror n
313 Error err -> eerror err
315 extract = error "toFold: parser cannot be used for scanning"
321 Partial n _ -> perror n
322 Continue n _ -> cerror n
324 Error err -> eerror err
326-------------------------------------------------------------------------------
327-- Upgrade folds to parses
328-------------------------------------------------------------------------------
330-- | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the
333{-# INLINE fromFold #-}
334fromFold :: Monad m => Fold m a b -> Parser a m b
335fromFold (Fold fstep finitial _ ffinal) = Parser step initial extract
343 FL.Partial s1 -> IPartial s1
350 FL.Partial s1 -> Partial 0 s1
351 FL.Done b -> Done 0 b
353 extract = fmap (Done 0) . ffinal
355-- | Convert a Maybe returning fold to an error returning parser. The first
356-- argument is the error message that the parser would return when the fold
361{-# INLINE fromFoldMaybe #-}
362fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b
363fromFoldMaybe errMsg (Fold fstep finitial _ ffinal) =
364 Parser step initial extract
372 FL.Partial s1 -> IPartial s1
376 Nothing -> IError errMsg
382 FL.Partial s1 -> Partial 0 s1
386 Nothing -> Error errMsg
391 Just x -> return $ Done 0 x
392 Nothing -> return $ Error errMsg
394-------------------------------------------------------------------------------
396-------------------------------------------------------------------------------
398-- | Peek the head element of a stream, without consuming it. Fails if it
399-- encounters end of input.
401-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]
405-- peek = lookAhead (satisfy True)
409peek :: Monad m => Parser a m a
410peek = Parser step initial extract
414 initial = return $ IPartial ()
416 step () a = return $ Done 1 a
418 extract () = return $ Error "peek: end of input"
420-- | Succeeds if we are at the end of input, fails otherwise.
422-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]
426eof :: Monad m => Parser a m ()
427eof = Parser step initial extract
431 initial = return $ IPartial ()
433 step () _ = return $ Error "eof: not at end of input"
435 extract () = return $ Done 0 ()
437-- | Return the next element of the input. Returns 'Nothing'
438-- on end of input. Also known as 'head'.
442{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}
444next :: Monad m => Parser a m (Maybe a)
445next = Parser step initial extract
449 initial = pure $ IPartial ()
451 step () a = pure $ Done 0 (Just a)
453 extract () = pure $ Done 0 Nothing
455-- | Map an 'Either' returning function on the next element in the stream. If
456-- the function returns 'Left err', the parser fails with the error message
457-- @err@ otherwise returns the 'Right' value.
462either :: Monad m => (a -> Either String b) -> Parser a m b
463either f = Parser step initial extract
467 initial = return $ IPartial ()
472 Left err -> Error err
474 extract () = return $ Error "end of input"
476-- | Map a 'Maybe' returning function on the next element in the stream. The
477-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
480-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
481-- >>> maybe f = Parser.either (toEither . f)
483-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)
488maybe :: Monad m => (a -> Maybe b) -> Parser a m b
489-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
490maybe parserF = Parser step initial extract
494 initial = return $ IPartial ()
499 Nothing -> Error "maybe: predicate failed"
501 extract () = return $ Error "maybe: end of input"
503-- | Returns the next element if it passes the predicate, fails otherwise.
505-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]
508-- >>> toMaybe f x = if f x then Just x else Nothing
509-- >>> satisfy f = Parser.maybe (toMaybe f)
511{-# INLINE satisfy #-}
512satisfy :: Monad m => (a -> Bool) -> Parser a m a
513-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
514satisfy predicate = Parser step initial extract
518 initial = return $ IPartial ()
523 else Error "satisfy: predicate failed"
525 extract () = return $ Error "satisfy: end of input"
527-- | Consume one element from the head of the stream. Fails if it encounters
530-- >>> one = Parser.satisfy $ const True
533one :: Monad m => Parser a m a
534one = satisfy $ const True
536-- Alternate names: "only", "onlyThis".
538-- | Match a specific element.
540-- >>> oneEq x = Parser.satisfy (== x)
543oneEq :: (Monad m, Eq a) => a -> Parser a m a
544oneEq x = satisfy (== x)
546-- Alternate names: "exclude", "notThis".
548-- | Match anything other than the supplied element.
550-- >>> oneNotEq x = Parser.satisfy (/= x)
552{-# INLINE oneNotEq #-}
553oneNotEq :: (Monad m, Eq a) => a -> Parser a m a
554oneNotEq x = satisfy (/= x)
556-- | Match any one of the elements in the supplied list.
558-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)
560-- When performance matters a pattern matching predicate could be more
561-- efficient than a 'Foldable' datatype:
572-- GHC may use a binary search instead of linear search in the list.
573-- Alternatively, you can also use an array instead of list for storage and
577oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
578oneOf xs = satisfy (`Foldable.elem` xs)
580-- | See performance notes in 'oneOf'.
582-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)
585noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
586noneOf xs = satisfy (`Foldable.notElem` xs)
588-------------------------------------------------------------------------------
590-------------------------------------------------------------------------------
592-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
593{-# ANN type Tuple'Fused Fuse #-}
594data Tuple'Fused a b = Tuple'Fused !a !b deriving Show
596-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input
597-- elements and folds them using the supplied fold.
599-- Stops after @n@ elements.
600-- Fails if the stream ends before @m@ elements could be taken.
606-- takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)
607-- where prsr = Parser.takeBetween low high Fold.toList
612-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]
615-- >>> takeBetween' 2 4 [1, 2]
618-- >>> takeBetween' 2 4 [1]
619-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")
621-- >>> takeBetween' 0 0 [1, 2]
624-- >>> takeBetween' 0 1 []
627-- @takeBetween@ is the most general take operation, other take operations can
628-- be defined in terms of takeBetween. For example:
630-- >>> take n = Parser.takeBetween 0 n
631-- >>> takeEQ n = Parser.takeBetween n n
632-- >>> takeGE n = Parser.takeBetween n maxBound
636{-# INLINE takeBetween #-}
637takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
638takeBetween low high (Fold fstep finitial _ ffinal) =
640 Parser step initial (extract streamErr)
645 "takeBetween: Expecting alteast " ++ show low
646 ++ " elements, got " ++ show i
649 "takeBetween: lower bound - " ++ show low
650 ++ " is greater than higher bound - " ++ show high
652 foldErr :: Int -> String
654 "takeBetween: the collecting fold terminated after"
655 ++ " consuming" ++ show i ++ " elements"
656 ++ " minimum" ++ show low ++ " elements needed"
658 -- Exactly the same as snext except different constructors, we can possibly
659 -- deduplicate the two.
665 let s1 = Tuple'Fused i1 s
667 -- XXX ideally this should be a Continue instead
668 then return $ IPartial s1
669 else iextract foldErr s1
674 else IError (foldErr i1)
677 when (low >= 0 && high >= 0 && low > high)
680 finitial >>= inext (-1)
682 -- Keep the impl same as inext
688 let s1 = Tuple'Fused i1 s
690 then return $ Continue 0 s1
692 then return $ Partial 0 s1
693 else fmap (Done 0) (ffinal s)
698 else Error (foldErr i1)
700 step (Tuple'Fused i s) a = fstep s a >>= snext i
702 extract f (Tuple'Fused i s)
703 | i >= low && i <= high = fmap (Done 0) (ffinal s)
704 | otherwise = return $ Error (f i)
706 -- XXX Need to make Initial return type Step to deduplicate this
707 iextract f (Tuple'Fused i s)
708 | i >= low && i <= high = fmap IDone (ffinal s)
709 | otherwise = return $ IError (f i)
711-- | Stops after taking exactly @n@ input elements.
713-- * Stops - after consuming @n@ elements.
714-- * Fails - if the stream or the collecting fold ends before it can collect
715-- exactly @n@ elements.
717-- >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]
720-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
721-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")
724takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
725takeEQ n (Fold fstep finitial _ ffinal) = Parser step initial extract
734 then return $ IPartial $ Tuple'Fused 1 s
735 else fmap IDone (ffinal s)
736 FL.Done b -> return $
739 $ "takeEQ: Expecting exactly " ++ show n
740 ++ " elements, fold terminated without"
741 ++ " consuming any elements"
744 step (Tuple'Fused i1 r) a = do
750 FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s
753 $ "takeEQ: Expecting exactly " ++ show n
754 ++ " elements, fold terminated on " ++ show i1
759 FL.Partial s -> ffinal s
760 FL.Done b -> return b
762 extract (Tuple'Fused i _) =
763 -- Using the count "i" in the message below causes large performance
764 -- regression unless we use Fuse annotation on Tuple.
767 $ "takeEQ: Expecting exactly " ++ show n
768 ++ " elements, input terminated on " ++ show (i - 1)
770{-# ANN type TakeGEState Fuse #-}
775-- | Take at least @n@ input elements, but can collect more.
777-- * Stops - when the collecting fold stops.
778-- * Fails - if the stream or the collecting fold ends before producing @n@
781-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
782-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")
784-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
790takeGE :: Monad m => Int -> Fold m a b -> Parser a m b
791takeGE n (Fold fstep finitial _ ffinal) = Parser step initial extract
800 then return $ IPartial $ TakeGELT 1 s
801 else return $ IPartial $ TakeGEGE s
802 FL.Done b -> return $
805 $ "takeGE: Expecting at least " ++ show n
806 ++ " elements, fold terminated without"
807 ++ " consuming any elements"
810 step (TakeGELT i1 r) a = do
816 FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s
819 $ "takeGE: Expecting at least " ++ show n
820 ++ " elements, fold terminated on " ++ show i1
825 FL.Partial s -> Partial 0 $ TakeGEGE s
826 FL.Done b -> Done 0 b
827 step (TakeGEGE r) a = do
831 FL.Partial s -> Partial 0 $ TakeGEGE s
832 FL.Done b -> Done 0 b
834 extract (TakeGELT i _) =
837 $ "takeGE: Expecting at least " ++ show n
838 ++ " elements, input terminated on " ++ show (i - 1)
839 extract (TakeGEGE r) = fmap (Done 0) $ ffinal r
841-------------------------------------------------------------------------------
842-- Conditional splitting
843-------------------------------------------------------------------------------
845-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.
847-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the
848-- input. The combinator stops when the condition fails or if the collecting
851-- Other interesting parsers can be implemented in terms of this parser:
853-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
854-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)
856-- Stops: when the condition fails or the collecting parser stops.
857-- Fails: when the collecting parser fails.
861{-# INLINE takeWhileP #-}
862takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
863takeWhileP predicate (Parser pstep pinitial pextract) =
864 Parser step pinitial pextract
873 -- XXX need a map on count
875 Error err -> return $ Error err
876 Done n s1 -> return $ Done (n + 1) s1
877 Partial _ _ -> error "Bug: takeWhileP: Partial in extract"
878 Continue n s1 -> return $ Continue (n + 1) s1
880-- | Collect stream elements until an element fails the predicate. The element
881-- on which the predicate fails is returned back to the input stream.
883-- * Stops - when the predicate fails or the collecting fold stops.
886-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]
889-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)
891-- We can implement a @breakOn@ using 'takeWhile':
894-- breakOn p = takeWhile (not p)
897{-# INLINE takeWhile #-}
898takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
899-- takeWhile cond f = takeWhileP cond (fromFold f)
900takeWhile predicate (Fold fstep finitial _ ffinal) =
901 Parser step initial extract
908 FL.Partial s -> IPartial s
917 FL.Partial s1 -> Partial 0 s1
918 FL.Done b -> Done 0 b
919 else Done 1 <$> ffinal s
921 extract s = fmap (Done 0) (ffinal s)
924-- XXX This may not be composable because of the b argument. We can instead
925-- return a "Reparse b a m b" so that those can be composed.
926{-# INLINE takeWhile1X #-}
927takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b
928-- We can implement this using satisfy and takeWhile. We can use "satisfy
929-- p", fold the result with the refold and then use the "takeWhile p" and
930-- fold that using the refold.
931takeWhile1 acc cond f = undefined
934-- | Like 'takeWhile' but takes at least one element otherwise fails.
936-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
938{-# INLINE takeWhile1 #-}
939takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
940-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)
941takeWhile1 predicate (Fold fstep finitial _ ffinal) =
942 Parser step initial extract
949 FL.Partial s -> IPartial (Left' s)
952 $ "takeWhile1: fold terminated without consuming:"
955 {-# INLINE process #-}
960 FL.Partial s1 -> Partial 0 (Right' s1)
961 FL.Done b -> Done 0 b
966 else return $ Error "takeWhile1: predicate failed on first element"
974 extract (Left' _) = return $ Error "takeWhile1: end of input"
975 extract (Right' s) = fmap (Done 0) (ffinal s)
977-- | Drain the input as long as the predicate succeeds, running the effects and
978-- discarding the results.
980-- This is also called @skipWhile@ in some parsing libraries.
982-- >>> dropWhile p = Parser.takeWhile p Fold.drain
984{-# INLINE dropWhile #-}
985dropWhile :: Monad m => (a -> Bool) -> Parser a m ()
986dropWhile p = takeWhile p FL.drain
988-------------------------------------------------------------------------------
990-------------------------------------------------------------------------------
992{-# ANN type FramedEscState Fuse #-}
993data FramedEscState s =
994 FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int
996-- XXX We can remove Maybe from esc
997{-# INLINE takeFramedByGeneric #-}
998takeFramedByGeneric :: Monad m =>
999 Maybe (a -> Bool) -- is escape char?
1000 -> Maybe (a -> Bool) -- is frame begin?
1001 -> Maybe (a -> Bool) -- is frame end?
1004takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) =
1006 Parser step initial extract
1014 FL.Partial s -> IPartial (FrameEscInit s)
1016 error "takeFramedByGeneric: fold done without input"
1018 {-# INLINE process #-}
1023 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1024 FL.Done b -> Done 0 b
1026 {-# INLINE processNoEsc #-}
1027 processNoEsc s a n =
1032 -- takeFramedBy case
1036 then Done 0 <$> ffinal s
1037 else process s a (n - 1)
1039 let n1 = if isBegin a then n + 1 else n
1041 Nothing -> -- takeEndBy case
1043 then Done 0 <$> ffinal s
1045 Nothing -> -- takeStartBy case
1049 then Done 0 <$> ffinal s
1052 error $ "takeFramedByGeneric: "
1053 ++ "Both begin and end frame predicate missing"
1055 {-# INLINE processCheckEsc #-}
1056 processCheckEsc s a n =
1060 then return $ Partial 0 $ FrameEscEsc s n
1061 else processNoEsc s a n
1062 Nothing -> processNoEsc s a n
1064 step (FrameEscInit s) a =
1068 then return $ Partial 0 (FrameEscGo s 0)
1069 else return $ Error "takeFramedByGeneric: missing frame start"
1074 then Done 0 <$> ffinal s
1075 else processCheckEsc s a 0
1077 error "Both begin and end frame predicate missing"
1078 step (FrameEscGo s n) a = processCheckEsc s a n
1079 step (FrameEscEsc s n) a = process s a n
1081 err = return . Error
1083 extract (FrameEscInit _) =
1084 err "takeFramedByGeneric: empty token"
1085 extract (FrameEscGo s _) =
1089 Nothing -> fmap (Done 0) $ ffinal s
1090 Just _ -> err "takeFramedByGeneric: missing frame end"
1091 Nothing -> err "takeFramedByGeneric: missing closing frame"
1092 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1094data BlockParseState s =
1096 | BlockUnquoted !Int !s
1097 | BlockQuoted !Int !s
1098 | BlockQuotedEsc !Int !s
1100-- Blocks can be of different types e.g. {} or (). We only parse from the
1101-- perspective of the outermost block type. The nesting of that block are
1102-- checked. Any other block types nested inside it are opaque to us and can be
1103-- parsed when the contents of the block are parsed.
1105-- XXX Put a limit on nest level to keep the API safe.
1107-- | Parse a block enclosed within open, close brackets. Block contents may be
1108-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1109-- within quotes if escaped. A block can have a nested block inside it.
1111-- Quote begin and end chars are the same. Block brackets and quote chars must
1112-- not overlap. Block start and end brackets must be different for nesting
1113-- blocks within blocks.
1115-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1116-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1117-- Right "msg: \"hello world\""
1119{-# INLINE blockWithQuotes #-}
1120blockWithQuotes :: (Monad m, Eq a) =>
1121 (a -> Bool) -- ^ escape char
1122 -> (a -> Bool) -- ^ quote char, to quote inside brackets
1123 -> a -- ^ Block opening bracket
1124 -> a -- ^ Block closing bracket
1127blockWithQuotes isEsc isQuote bopen bclose
1128 (Fold fstep finitial _ ffinal) =
1129 Parser step initial extract
1137 FL.Partial s -> IPartial (BlockInit s)
1139 error "blockWithQuotes: fold finished without input"
1141 {-# INLINE process #-}
1142 process s a nextState = do
1146 FL.Partial s1 -> Continue 0 (nextState s1)
1147 FL.Done b -> Done 0 b
1149 step (BlockInit s) a =
1152 then Continue 0 $ BlockUnquoted 1 s
1153 else Error "blockWithQuotes: missing block start"
1154 step (BlockUnquoted level s) a
1155 | a == bopen = process s a (BlockUnquoted (level + 1))
1158 then fmap (Done 0) (ffinal s)
1159 else process s a (BlockUnquoted (level - 1))
1160 | isQuote a = process s a (BlockQuoted level)
1161 | otherwise = process s a (BlockUnquoted level)
1162 step (BlockQuoted level s) a
1163 | isEsc a = process s a (BlockQuotedEsc level)
1166 then process s a (BlockUnquoted level)
1167 else process s a (BlockQuoted level)
1168 step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1170 err = return . Error
1172 extract (BlockInit s) = fmap (Done 0) $ ffinal s
1173 extract (BlockUnquoted level _) =
1174 err $ "blockWithQuotes: finished at block nest level " ++ show level
1175 extract (BlockQuoted level _) =
1176 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1177 ++ "at block nest level " ++ show level
1178 extract (BlockQuotedEsc level _) =
1179 err $ "blockWithQuotes: finished, inside an unfinished quote, "
1180 ++ "after an escape char, at block nest level " ++ show level
1182-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1183-- the supplied predicate. The separator is also taken with the token.
1185-- This can be combined with other parsers to implement other interesting
1186-- parsers as follows:
1188-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)
1189-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)
1191-- >>> takeEndBy = Parser.takeEndByEsc (const False)
1193-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting
1194-- parser in the takeEndBy parser can decide whether to fail or not if the
1195-- stream does not end with separator.
1199{-# INLINE takeEndBy #-}
1200takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
1201-- takeEndBy = takeEndByEsc (const False)
1202takeEndBy cond (Parser pstep pinitial pextract) =
1204 Parser step initial pextract
1214 else extractStep pextract res
1216-- | Like 'takeEndBy' but the separator elements can be escaped using an
1217-- escape char determined by the first predicate. The escape characters are
1221{-# INLINE takeEndByEsc #-}
1222takeEndByEsc :: Monad m =>
1223 (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
1224takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
1226 Parser step initial extract
1230 initial = first Left' <$> pinitial
1232 step (Left' s) a = do
1234 then return $ Partial 0 $ Right' s
1238 then return $ first Left' res
1239 else fmap (first Left') $ extractStep pextract res
1241 step (Right' s) a = do
1243 return $ first Left' res
1245 extract (Left' s) = fmap (first Left') $ pextract s
1246 extract (Right' _) =
1247 return $ Error "takeEndByEsc: trailing escape"
1249-- | Like 'takeEndBy' but the separator is dropped.
1251-- See also "Streamly.Data.Fold.takeEndBy_".
1255{-# INLINE takeEndBy_ #-}
1256takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b
1259 takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)
1261takeEndBy_ cond (Parser pstep pinitial pextract) =
1263 Parser step pinitial pextract
1272-- | Take either the separator or the token. Separator is a Left value and
1273-- token is Right value.
1276{-# INLINE takeEitherSepBy #-}
1277takeEitherSepBy :: -- Monad m =>
1278 (a -> Bool) -> Fold m (Either a b) c -> Parser a m c
1279takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond
1281-- | Parse a token that starts with an element chosen by the predicate. The
1282-- parser fails if the input does not start with the selected element.
1284-- * Stops - when the predicate succeeds in non-leading position.
1285-- * Fails - when the predicate fails in the leading position.
1287-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)
1291-- >>> p = Parser.takeStartBy (== ',') Fold.toList
1292-- >>> leadingComma = Stream.parse p . Stream.fromList
1293-- >>> leadingComma "a,b"
1294-- Left (ParseError "takeStartBy: missing frame start")
1296-- >>> leadingComma ",,"
1298-- >>> leadingComma ",a,b"
1300-- >>> leadingComma ""
1305{-# INLINE takeStartBy #-}
1306takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1307takeStartBy cond (Fold fstep finitial _ ffinal) =
1309 Parser step initial extract
1317 FL.Partial s -> IPartial (Left' s)
1318 FL.Done _ -> IError "takeStartBy: fold done without input"
1320 {-# INLINE process #-}
1325 FL.Partial s1 -> Partial 0 (Right' s1)
1326 FL.Done b -> Done 0 b
1331 else return $ Error "takeStartBy: missing frame start"
1335 else Done 1 <$> ffinal s
1337 extract (Left' s) = fmap (Done 0) $ ffinal s
1338 extract (Right' s) = fmap (Done 0) $ ffinal s
1340-- | Like 'takeStartBy' but drops the separator.
1342-- >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing
1344{-# INLINE takeStartBy_ #-}
1345takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1346takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing
1348-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a
1349-- begin and end predicate, and an escape character. The frame begin and end
1350-- characters lose their special meaning if preceded by the escape character.
1352-- Nested frames are allowed if begin and end markers are different, nested
1353-- frames must be balanced unless escaped, nested frame markers are emitted as
1358-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList
1359-- >>> Stream.parse p $ Stream.fromList "{hello}"
1361-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"
1362-- Right "hello {world}"
1363-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
1364-- Right "hello {world"
1365-- >>> Stream.parse p $ Stream.fromList "{hello {world}"
1366-- Left (ParseError "takeFramedByEsc_: missing frame end")
1369{-# INLINE takeFramedByEsc_ #-}
1370takeFramedByEsc_ :: Monad m =>
1371 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1372-- takeFramedByEsc_ isEsc isEnd p =
1373-- takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)
1374takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial _ ffinal ) =
1376 Parser step initial extract
1384 FL.Partial s -> IPartial (FrameEscInit s)
1386 error "takeFramedByEsc_: fold done without input"
1388 {-# INLINE process #-}
1393 FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)
1394 FL.Done b -> Done 0 b
1396 step (FrameEscInit s) a =
1398 then return $ Partial 0 (FrameEscGo s 0)
1399 else return $ Error "takeFramedByEsc_: missing frame start"
1400 step (FrameEscGo s n) a =
1402 then return $ Partial 0 $ FrameEscEsc s n
1406 let n1 = if isBegin a then n + 1 else n
1410 then Done 0 <$> ffinal s
1411 else process s a (n - 1)
1412 step (FrameEscEsc s n) a = process s a n
1414 err = return . Error
1416 extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"
1417 extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"
1418 extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"
1420data FramedState s = FrameInit !s | FrameGo !s Int
1422-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an
1425-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)
1427{-# INLINE takeFramedBy_ #-}
1428takeFramedBy_ :: Monad m =>
1429 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
1430-- takeFramedBy_ isBegin isEnd =
1431-- takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)
1432takeFramedBy_ isBegin isEnd (Fold fstep finitial _ ffinal) =
1434 Parser step initial extract
1442 FL.Partial s -> IPartial (FrameInit s)
1444 error "takeFramedBy_: fold done without input"
1446 {-# INLINE process #-}
1451 FL.Partial s1 -> Continue 0 (FrameGo s1 n)
1452 FL.Done b -> Done 0 b
1454 step (FrameInit s) a =
1456 then return $ Continue 0 (FrameGo s 0)
1457 else return $ Error "takeFramedBy_: missing frame start"
1458 step (FrameGo s n) a
1460 let n1 = if isBegin a then n + 1 else n
1462 | n == 0 = Done 0 <$> ffinal s
1463 | otherwise = process s a (n - 1)
1465 err = return . Error
1467 extract (FrameInit _) = err "takeFramedBy_: empty token"
1468 extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"
1470-------------------------------------------------------------------------------
1471-- Grouping and words
1472-------------------------------------------------------------------------------
1474data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
1476-- Note we can also get words using something like:
1477-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)
1479-- But that won't be as efficient and ergonomic.
1481-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
1482-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
1483-- @["a","b"]@. In other words, its like parsing words from whitespace
1486-- * Stops - when it finds a word separator after a non-word element
1489-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)
1492-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)
1495{-# INLINE wordBy #-}
1496wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
1497wordBy predicate (Fold fstep finitial _ ffinal) = Parser step initial extract
1501 {-# INLINE worder #-}
1506 FL.Partial s1 -> Partial 0 $ WBWord s1
1507 FL.Done b -> Done 0 b
1513 FL.Partial s -> IPartial $ WBLeft s
1514 FL.Done b -> IDone b
1517 if not (predicate a)
1519 else return $ Partial 0 $ WBLeft s
1521 if not (predicate a)
1525 return $ Partial 0 $ WBRight b
1526 step (WBRight b) a =
1528 $ if not (predicate a)
1530 else Partial 0 $ WBRight b
1532 extract (WBLeft s) = fmap (Done 0) $ ffinal s
1533 extract (WBWord s) = fmap (Done 0) $ ffinal s
1534 extract (WBRight b) = return (Done 0 b)
1536data WordFramedState s b =
1537 WordFramedSkipPre !s
1538 | WordFramedWord !s !Int
1539 | WordFramedEsc !s !Int
1540 | WordFramedSkipPost !b
1542-- | Like 'wordBy' but treats anything inside a pair of quotes as a single
1543-- word, the quotes can be escaped by an escape character. Recursive quotes
1544-- are possible if quote begin and end characters are different, quotes must be
1545-- balanced. Outermost quotes are stripped.
1547-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList
1548-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"
1550-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"
1552-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"
1554-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"
1557-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList
1558-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""
1561{-# INLINE wordFramedBy #-}
1562wordFramedBy :: Monad m =>
1563 (a -> Bool) -- ^ Matches escape elem?
1564 -> (a -> Bool) -- ^ Matches left quote?
1565 -> (a -> Bool) -- ^ matches right quote?
1566 -> (a -> Bool) -- ^ matches word separator?
1569wordFramedBy isEsc isBegin isEnd isSep
1570 (Fold fstep finitial _ ffinal) =
1571 Parser step initial extract
1579 FL.Partial s -> IPartial (WordFramedSkipPre s)
1581 error "wordFramedBy: fold done without input"
1583 {-# INLINE process #-}
1588 FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)
1589 FL.Done b -> Done 0 b
1591 step (WordFramedSkipPre s) a
1592 | isEsc a = return $ Continue 0 $ WordFramedEsc s 0
1593 | isSep a = return $ Partial 0 $ WordFramedSkipPre s
1594 | isBegin a = return $ Continue 0 $ WordFramedWord s 1
1596 return $ Error "wordFramedBy: missing frame start"
1597 | otherwise = process s a 0
1598 step (WordFramedWord s n) a
1599 | isEsc a = return $ Continue 0 $ WordFramedEsc s n
1600 | n == 0 && isSep a = do
1602 return $ Partial 0 $ WordFramedSkipPost b
1604 -- We need to use different order for checking begin and end for
1605 -- the n == 0 and n == 1 case so that when the begin and end
1606 -- character is the same we treat the one after begin as end.
1609 -- Need to check isBegin first
1611 then return $ Continue 0 $ WordFramedWord s 1
1613 then return $ Error "wordFramedBy: missing frame start"
1616 -- Need to check isEnd first
1620 then return $ Continue 0 $ WordFramedWord s 0
1621 else process s a (n - 1)
1623 then process s a (n + 1)
1625 step (WordFramedEsc s n) a = process s a n
1626 step (WordFramedSkipPost b) a =
1630 else Partial 0 $ WordFramedSkipPost b
1632 err = return . Error
1634 extract (WordFramedSkipPre s) = fmap (Done 0) $ ffinal s
1635 extract (WordFramedWord s n) =
1637 then fmap (Done 0) $ ffinal s
1638 else err "wordFramedBy: missing frame end"
1639 extract (WordFramedEsc _ _) =
1640 err "wordFramedBy: trailing escape"
1641 extract (WordFramedSkipPost b) = return (Done 0 b)
1643data WordQuotedState s b a =
1644 WordQuotedSkipPre !s
1645 | WordUnquotedWord !s
1646 | WordQuotedWord !s !Int !a !a
1647 | WordUnquotedEsc !s
1648 | WordQuotedEsc !s !Int !a !a
1649 | WordQuotedSkipPost !b
1651-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
1652-- word separators within specified quotes or brackets are ignored. Quotes and
1653-- escape characters can be processed. If the end quote is different from the
1654-- start quote it is called a bracket. The following quoting rules apply:
1656-- * In an unquoted string a character may be preceded by an escape character.
1657-- The escape character is removed and the character following it is treated
1658-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
1660-- * Any part of the word can be placed within quotes. Inside quotes all
1661-- characters are treated literally with no special meaning. Quoting character
1662-- itself cannot be used within quotes unless escape processing within quotes
1663-- is applied to allow it.
1664-- * Optionally escape processing for quoted part can be specified. Escape
1665-- character has no special meaning inside quotes unless it is followed by a
1666-- character that has a escape translation specified, in that case the escape
1667-- character is removed, and the specified translation is applied to the
1668-- character following it. This can be used to escape the quoting character
1669-- itself within quotes.
1670-- * There can be multiple quoting characters, when a quote starts, all other
1671-- quoting characters within that quote lose any special meaning until the
1673-- * A starting quote char without an ending char generates a parse error. An
1674-- ending bracket char without a corresponding bracket begin is ignored.
1675-- * Brackets can be nested.
1677-- We should note that unquoted and quoted escape processing are different. In
1678-- unquoted part escape character is always removed. In quoted part it is
1679-- removed only if followed by a special meaning character. This is consistent
1680-- with how shell performs escape processing.
1682-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
1683-- ((nested) brackets).
1691-- >>> '\'' -> Just x
1695-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
1696-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1697-- Right "a\"b'c\";'d\"e'f"
1699-- Note that outer quotes and backslashes from the input string are consumed by
1700-- Haskell, therefore, the actual input string passed to the parser is:
1703-- Similarly, when printing, double quotes are escaped by Haskell.
1707-- Shell like quote processing can be performed by using quote char specific
1708-- escape processing, single quotes with no escapes, and double quotes with
1711-- JSON string processing can also be achieved except the "\uXXXX" style
1712-- escaping for Unicode characters.
1714{-# INLINE wordWithQuotes #-}
1715wordWithQuotes :: (Monad m, Eq a) =>
1716 Bool -- ^ Retain the quotes and escape chars in the output
1717 -> (a -> a -> Maybe a) -- ^ quote char -> escaped char -> translated char
1718 -> a -- ^ Matches an escape elem?
1719 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1720 -> (a -> Bool) -- ^ Matches a word separator?
1723wordWithQuotes keepQuotes tr escChar toRight isSep
1724 (Fold fstep finitial _ ffinal) =
1725 Parser step initial extract
1729 -- Can be used to generate parse error for a bracket end without a bracket
1731 isInvalid = const False
1733 isEsc = (== escChar)
1739 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1741 error "wordKeepQuotes: fold done without input"
1743 {-# INLINE processQuoted #-}
1744 processQuoted s a n ql qr = do
1748 FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)
1749 FL.Done b -> Done 0 b
1751 {-# INLINE processUnquoted #-}
1752 processUnquoted s a = do
1756 FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)
1757 FL.Done b -> Done 0 b
1759 step (WordQuotedSkipPre s) a
1760 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1761 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1766 then processQuoted s a 1 a qr
1767 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1770 return $ Error "wordKeepQuotes: invalid unquoted char"
1771 | otherwise -> processUnquoted s a
1772 step (WordUnquotedWord s) a
1773 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1776 return $ Partial 0 $ WordQuotedSkipPost b
1781 then processQuoted s a 1 a qr
1782 else return $ Continue 0 $ WordQuotedWord s 1 a qr
1785 then return $ Error "wordKeepQuotes: invalid unquoted char"
1786 else processUnquoted s a
1787 step (WordQuotedWord s n ql qr) a
1788 | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr
1790 -- XXX Will this ever occur? Will n ever be 0?
1791 | n == 0 && isSep a = do
1793 return $ Partial 0 $ WordQuotedSkipPost b
1800 then processUnquoted s a
1801 else return $ Continue 0 $ WordUnquotedWord s
1802 else processQuoted s a (n - 1) ql qr
1804 then processQuoted s a (n + 1) ql qr
1805 else processQuoted s a n ql qr
1806 step (WordUnquotedEsc s) a = processUnquoted s a
1807 step (WordQuotedEsc s n ql qr) a =
1810 res <- fstep s escChar
1812 FL.Partial s1 -> processQuoted s1 a n ql qr
1813 FL.Done b -> return $ Done 0 b
1814 Just x -> processQuoted s x n ql qr
1815 step (WordQuotedSkipPost b) a =
1819 else Partial 0 $ WordQuotedSkipPost b
1821 err = return . Error
1823 extract (WordQuotedSkipPre s) = fmap (Done 0) $ ffinal s
1824 extract (WordUnquotedWord s) = fmap (Done 0) $ ffinal s
1825 extract (WordQuotedWord s n _ _) =
1827 then fmap (Done 0) $ ffinal s
1828 else err "wordWithQuotes: missing frame end"
1829 extract WordQuotedEsc {} =
1830 err "wordWithQuotes: trailing escape"
1831 extract (WordUnquotedEsc _) =
1832 err "wordWithQuotes: trailing escape"
1833 extract (WordQuotedSkipPost b) = return (Done 0 b)
1835-- | 'wordWithQuotes' without processing the quotes and escape function
1836-- supplied to escape the quote char within a quote. Can be used to parse words
1837-- keeping the quotes and escapes intact.
1839-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
1841{-# INLINE wordKeepQuotes #-}
1842wordKeepQuotes :: (Monad m, Eq a) =>
1844 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1845 -> (a -> Bool) -- ^ Matches a word separator?
1849 -- Escape the quote char itself
1850 wordWithQuotes True (\q x -> if q == x then Just x else Nothing)
1852-- See the "Quoting Rules" section in the "bash" manual page for a primer on
1853-- how quotes are used by shells.
1855-- | 'wordWithQuotes' with quote processing applied and escape function
1856-- supplied to escape the quote char within a quote. Can be ysed to parse words
1857-- and processing the quoting and escaping at the same time.
1859-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
1861{-# INLINE wordProcessQuotes #-}
1862wordProcessQuotes :: (Monad m, Eq a) =>
1864 -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1865 -> (a -> Bool) -- ^ Matches a word separator?
1869 -- Escape the quote char itself
1870 wordWithQuotes False (\q x -> if q == x then Just x else Nothing)
1872{-# ANN type GroupByState Fuse #-}
1873data GroupByState a s
1875 | GroupByGrouping !a !s
1877-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
1878-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1879-- 'True' @b@ is also assigned to the same group. If @a \`cmp` c@ is 'True'
1880-- then @c@ is also assigned to the same group and so on. When the comparison
1881-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1882-- the result of the fold is the result of the parser.
1884-- * Stops - when the comparison fails.
1889-- Stream.fold Fold.toList
1890-- . Stream.parseMany (Parser.groupBy eq Fold.toList)
1894-- >>> runGroupsBy (<) []
1897-- >>> runGroupsBy (<) [1]
1900-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]
1901-- [Right [3,5,4],Right [1,2],Right [0]]
1903{-# INLINE groupBy #-}
1904groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1905groupBy eq (Fold fstep finitial _ ffinal) = Parser step initial extract
1909 {-# INLINE grouper #-}
1914 FL.Done b -> Done 0 b
1915 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
1921 FL.Partial s -> IPartial $ GroupByInit s
1922 FL.Done b -> IDone b
1924 step (GroupByInit s) a = grouper s a a
1925 step (GroupByGrouping a0 s) a =
1928 else Done 1 <$> ffinal s
1930 extract (GroupByInit s) = fmap (Done 0) $ ffinal s
1931 extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s
1933-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
1934-- successive elements in the input stream. Assuming the input stream
1935-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser
1936-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is
1937-- 'True' @b@ is also assigned to the same group. If @b \`cmp` c@ is 'True'
1938-- then @c@ is also assigned to the same group and so on. When the comparison
1939-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
1940-- the result of the fold is the result of the parser.
1942-- * Stops - when the comparison fails.
1946-- runGroupsByRolling eq =
1947-- Stream.fold Fold.toList
1948-- . Stream.parseMany (Parser.groupByRolling eq Fold.toList)
1952-- >>> runGroupsByRolling (<) []
1955-- >>> runGroupsByRolling (<) [1]
1958-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]
1959-- [Right [3,5],Right [4],Right [1,2],Right [0]]
1963{-# INLINE groupByRolling #-}
1964groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
1965groupByRolling eq (Fold fstep finitial _ ffinal) = Parser step initial extract
1969 {-# INLINE grouper #-}
1974 FL.Done b -> Done 0 b
1975 FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
1981 FL.Partial s -> IPartial $ GroupByInit s
1982 FL.Done b -> IDone b
1984 step (GroupByInit s) a = grouper s a
1985 step (GroupByGrouping a0 s) a =
1988 else Done 1 <$> ffinal s
1990 extract (GroupByInit s) = fmap (Done 0) $ ffinal s
1991 extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s
1993{-# ANN type GroupByStatePair Fuse #-}
1994data GroupByStatePair a s1 s2
1995 = GroupByInitPair !s1 !s2
1996 | GroupByGroupingPair !a !s1 !s2
1997 | GroupByGroupingPairL !a !s1 !s2
1998 | GroupByGroupingPairR !a !s1 !s2
2000-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
2001-- the first fold as long as the predicate holds 'True', if the predicate is
2002-- 'False' collects using the second fold as long as it remains 'False'.
2003-- Returns 'Left' for the first case and 'Right' for the second case.
2005-- For example, if we want to detect sorted sequences in a stream, both
2006-- ascending and descending cases we can use 'groupByRollingEither (<=)
2007-- Fold.toList Fold.toList'.
2010{-# INLINE groupByRollingEither #-}
2011groupByRollingEither :: Monad m =>
2012 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)
2015 (Fold fstep1 finitial1 _ ffinal1)
2016 (Fold fstep2 finitial2 _ ffinal2) = Parser step initial extract
2020 {-# INLINE grouper #-}
2021 grouper s1 s2 a = do
2022 return $ Continue 0 (GroupByGroupingPair a s1 s2)
2024 {-# INLINE grouperL2 #-}
2025 grouperL2 s1 s2 a = do
2029 FL.Done b -> Done 0 (Left b)
2030 FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
2032 {-# INLINE grouperL #-}
2033 grouperL s1 s2 a0 a = do
2036 FL.Done b -> return $ Done 0 (Left b)
2037 FL.Partial s11 -> grouperL2 s11 s2 a
2039 {-# INLINE grouperR2 #-}
2040 grouperR2 s1 s2 a = do
2044 FL.Done b -> Done 0 (Right b)
2045 FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
2047 {-# INLINE grouperR #-}
2048 grouperR s1 s2 a0 a = do
2051 FL.Done b -> return $ Done 0 (Right b)
2052 FL.Partial s21 -> grouperR2 s1 s21 a
2061 FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
2062 FL.Done b -> IDone (Right b)
2063 FL.Done b -> IDone (Left b)
2065 step (GroupByInitPair s1 s2) a = grouper s1 s2 a
2067 step (GroupByGroupingPair a0 s1 s2) a =
2069 then grouperL s1 s2 a0 a
2070 else grouperR s1 s2 a0 a
2072 step (GroupByGroupingPairL a0 s1 s2) a =
2074 then grouperL2 s1 s2 a
2075 else Done 1 . Left <$> ffinal1 s1
2077 step (GroupByGroupingPairR a0 s1 s2) a =
2079 then grouperR2 s1 s2 a
2080 else Done 1 . Right <$> ffinal2 s2
2082 extract (GroupByInitPair s1 _) = Done 0 . Left <$> ffinal1 s1
2083 extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> ffinal1 s1
2084 extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> ffinal2 s2
2085 extract (GroupByGroupingPair a s1 _) = do
2088 FL.Done b -> return $ Done 0 (Left b)
2089 FL.Partial s11 -> Done 0 . Left <$> ffinal1 s11
2091-- XXX use an Unfold instead of a list?
2092-- XXX custom combinators for matching list, array and stream?
2093-- XXX rename to listBy?
2095-- | Match the given sequence of elements using the given comparison function.
2096-- Returns the original sequence if successful.
2100-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs
2104-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"
2107-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
2108-- Left (ParseError "streamEqBy: mismtach occurred")
2110{-# INLINE listEqBy #-}
2111listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
2112listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs
2114listEqBy cmp str = Parser step initial extract
2118 -- XXX Should return IDone in initial for [] case
2119 initial = return $ IPartial str
2121 step [] _ = return $ Done 0 str
2126 else Error "listEqBy: failed, yet to match the last element"
2132 $ "listEqBy: failed, yet to match "
2133 ++ show (length xs + 1) ++ " elements"
2138 $ "listEqBy: end of input, yet to match "
2139 ++ show (length xs) ++ " elements"
2142{-# INLINE streamEqByInternal #-}
2143streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2144streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract
2149 r <- sstep defState state
2151 D.Yield x s -> return $ IPartial (Just' x, s)
2152 D.Stop -> return $ IDone ()
2153 -- Need Skip/Continue in initial to loop right here
2154 D.Skip s -> return $ IPartial (Nothing', s)
2156 step (Just' x, st) a =
2159 r <- sstep defState st
2162 D.Yield x1 s -> Continue 0 (Just' x1, s)
2164 D.Skip s -> Continue 1 (Nothing', s)
2165 else return $ Error "streamEqBy: mismtach occurred"
2166 step (Nothing', st) a = do
2167 r <- sstep defState st
2172 then Continue 0 (Nothing', s)
2173 else Error "streamEqBy: mismatch occurred"
2175 D.Skip s -> Continue 1 (Nothing', s)
2177 extract _ = return $ Error "streamEqBy: end of input"
2179-- | Like 'listEqBy' but uses a stream instead of a list and does not return
2182{-# INLINE streamEqBy #-}
2183streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
2184-- XXX Somehow composing this with "*>" is much faster on the microbenchmark.
2185-- Need to investigate why.
2186streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()
2189-- | Match the input sequence with the supplied list and return it if
2192-- >>> listEq = Parser.listEqBy (==)
2194{-# INLINE listEq #-}
2195listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]
2196listEq = listEqBy (==)
2198-- | Match if the input stream is a subsequence of the argument stream i.e. all
2199-- the elements of the input stream occur, in order, in the argument stream.
2200-- The elements do not have to occur consecutively. A sequence is considered a
2201-- subsequence of itself.
2202{-# INLINE subsequenceBy #-}
2203subsequenceBy :: -- Monad m =>
2204 (a -> a -> Bool) -> Stream m a -> Parser a m ()
2205subsequenceBy = undefined
2208-- Should go in Data.Parser.Regex in streamly package so that it can depend on
2210{-# INLINE regexPosix #-}
2211regexPosix :: -- Monad m =>
2212 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2213regexPosix = undefined
2215{-# INLINE regexPCRE #-}
2216regexPCRE :: -- Monad m =>
2217 Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
2218regexPCRE = undefined
2221-------------------------------------------------------------------------------
2222-- Transformations on input
2223-------------------------------------------------------------------------------
2225-- Initial needs a "Continue" constructor to implement scans on parsers. As a
2226-- parser can always return a Continue in initial when we feed the fold's
2227-- initial result to it. We can work this around for postscan by introducing an
2228-- initial state and calling "initial" only on the first input.
2230-- | Stateful scan on the input of a parser using a Fold.
2234{-# INLINE postscan #-}
2235postscan :: -- Monad m =>
2236 Fold m a b -> Parser b m c -> Parser a m c
2239{-# INLINE zipWithM #-}
2240zipWithM :: Monad m =>
2241 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x
2242zipWithM zf (D.Stream sstep state) (Fold fstep finitial _ ffinal) =
2243 Parser step initial extract
2251 r <- sstep defState state
2253 D.Yield x s -> return $ IPartial (Just' x, s, fs)
2257 -- Need Skip/Continue in initial to loop right here
2258 D.Skip s -> return $ IPartial (Nothing', s, fs)
2259 FL.Done x -> return $ IDone x
2261 step (Just' a, st, fs) b = do
2265 FL.Partial fs1 -> do
2266 r <- sstep defState st
2268 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)
2272 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)
2273 FL.Done x -> return $ Done 0 x
2274 step (Nothing', st, fs) b = do
2275 r <- sstep defState st
2282 return $ Continue 0 (Nothing', s, fs1)
2283 FL.Done x -> return $ Done 0 x
2287 D.Skip s -> return $ Continue 1 (Nothing', s, fs)
2289 extract _ = return $ Error "zipWithM: end of input"
2291-- | Zip the input of a fold with a stream.
2296zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x
2297zip = zipWithM (curry return)
2299-- | Pair each element of a fold input with its index, starting from index 0.
2302{-# INLINE indexed #-}
2303indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b
2304indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)
2306-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
2307-- function using a fold indexing function that attaches an index to each input
2308-- element and a filtering function that filters using @(index, element) ->
2309-- Bool) as predicate.
2314-- filterWithIndex = makeIndexFilter indexed filter
2315-- filterWithAbsTime = makeIndexFilter timestamped filter
2316-- filterWithRelTime = makeIndexFilter timeIndexed filter
2320{-# INLINE makeIndexFilter #-}
2322 (Fold m (s, a) b -> Parser a m b)
2323 -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
2324 -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)
2325makeIndexFilter f comb g = f . comb g . FL.lmap snd
2327-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
2328-- then every element at strides of @stride@.
2331{-# INLINE sampleFromthen #-}
2332sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
2333sampleFromthen offset size =
2334 makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
2336--------------------------------------------------------------------------------
2338--------------------------------------------------------------------------------
2340-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
2341-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
2345-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
2347-- > span_ (< 1) [1,2,3]
2350-- > span_ (< 2) [1,2,3]
2353-- > span_ (< 4) [1,2,3]
2360span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2361span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
2363-- | Break the input stream into two groups, the first group takes the input as
2364-- long as the predicate applied to the first element of the stream and next
2365-- input element holds 'True', the second group takes the rest of the input.
2369{-# INLINE spanBy #-}
2372 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2373spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
2375-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
2376-- predicate is applied to the previous and the next input elements.
2379{-# INLINE spanByRolling #-}
2382 => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
2383spanByRolling eq f1 f2 =
2384 noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
2386-------------------------------------------------------------------------------
2388-------------------------------------------------------------------------------
2390-- | Takes at-most @n@ input elements.
2392-- * Stops - when the collecting parser stops.
2393-- * Fails - when the collecting parser fails.
2395-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2398-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
2399-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")
2403takeP :: Monad m => Int -> Parser a m b -> Parser a m b
2404takeP lim (Parser pstep pinitial pextract) = Parser step initial extract
2413 then return $ IPartial $ Tuple' 0 s
2415 IDone b -> return $ IDone b
2416 IError e -> return $ IError e
2418 step (Tuple' cnt r) a = do
2426 then return $ Partial 0 $ Tuple' cnt1 s
2430 Done n b -> Done n b
2431 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2432 Error err -> Error err
2433 Partial _ _ -> error "takeP: Partial in extract"
2438 then return $ Continue 0 $ Tuple' cnt1 s
2442 Done n b -> Done n b
2443 Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)
2444 Error err -> Error err
2445 Partial _ _ -> error "takeP: Partial in extract"
2447 let taken = cnt1 - n
2449 return $ Partial n $ Tuple' taken s
2451 let taken = cnt1 - n
2453 return $ Continue n $ Tuple' taken s
2454 Done n b -> return $ Done n b
2455 Error str -> return $ Error str
2457 extract (Tuple' cnt r) = do
2460 Done n b -> Done n b
2461 Continue n s1 -> Continue n (Tuple' (cnt - n) s1)
2462 Error err -> Error err
2463 Partial _ _ -> error "takeP: Partial in extract"
2465 -- XXX Need to make the Initial type Step to remove this
2470 Error err -> IError err
2471 _ -> error "Bug: takeP invalid state in initial"
2473-- | Run a parser without consuming the input.
2475{-# INLINE lookAhead #-}
2476lookAhead :: Monad m => Parser a m b -> Parser a m b
2477lookAhead (Parser step1 initial1 _) = Parser step initial extract
2483 return $ case res of
2484 IPartial s -> IPartial (Tuple'Fused 0 s)
2486 IError e -> IError e
2488 step (Tuple'Fused cnt st) a = do
2493 Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2494 Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)
2495 Done _ b -> Done cnt1 b
2496 Error err -> Error err
2498 -- XXX returning an error let's us backtrack. To implement it in a way so
2499 -- that it terminates on eof without an error then we need a way to
2500 -- backtrack on eof, that will require extract to return 'Step' type.
2501 extract (Tuple'Fused n _) =
2504 $ "lookAhead: end of input after consuming "
2505 ++ show n ++ " elements"
2507-------------------------------------------------------------------------------
2509-------------------------------------------------------------------------------
2511-- To deinterleave we can chain two parsers one behind the other. The input is
2512-- given to the first parser and the input definitively rejected by the first
2513-- parser is given to the second parser.
2515-- We can either have the parsers themselves buffer the input or use the shared
2516-- global buffer to hold it until none of the parsers need it. When the first
2517-- parser returns Skip (i.e. rewind) we let the second parser consume the
2518-- rejected input and when it is done we move the cursor forward to the first
2519-- parser again. This will require a "move forward" command as well.
2521-- To implement grep we can use three parsers, one to find the pattern, one
2522-- to store the context behind the pattern and one to store the context in
2523-- front of the pattern. When a match occurs we need to emit the accumulator of
2524-- all the three parsers. One parser can count the line numbers to provide the
2527{-# ANN type DeintercalateAllState Fuse #-}
2528data DeintercalateAllState fs sp ss =
2529 DeintercalateAllInitL !fs
2530 | DeintercalateAllL !fs !sp
2531 | DeintercalateAllInitR !fs
2532 | DeintercalateAllR !fs !ss
2534-- XXX rename this to intercalate
2536-- Having deintercalateAll for accepting or rejecting entire input could be
2537-- useful. For example, in case of JSON parsing we get an entire block of
2538-- key-value pairs which we need to verify. This version may be simpler, more
2539-- efficient. We could implement this as a stream operation like parseMany.
2541-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
2542-- example, in case of csv parsing as we are feeding a line to a fold we can
2545-- | Like 'deintercalate' but the entire input must satisfy the pattern
2546-- otherwise the parser fails. This is many times faster than deintercalate.
2548-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2549-- >>> p2 = Parser.satisfy (== '+')
2550-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
2551-- >>> Stream.parse p $ Stream.fromList ""
2553-- >>> Stream.parse p $ Stream.fromList "1"
2555-- >>> Stream.parse p $ Stream.fromList "1+"
2556-- Left (ParseError "takeWhile1: end of input")
2557-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2558-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2560{-# INLINE deintercalateAll #-}
2561deintercalateAll :: Monad m =>
2564 -> Fold m (Either x y) z
2567 (Parser stepL initialL extractL)
2568 (Parser stepR initialR _)
2569 (Fold fstep finitial _ ffinal) = Parser step initial extract
2574 error $ "deintercalate: " ++ p ++ " parser cannot "
2575 ++ status ++ " without input"
2580 FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2581 FL.Done c -> return $ IDone c
2583 {-# INLINE processL #-}
2584 processL foldAction n nextState = do
2587 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2588 FL.Done c -> return $ Done n c
2590 {-# INLINE runStepL #-}
2591 runStepL fs sL a = do
2594 Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2595 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2597 processL (fstep fs (Left b)) n DeintercalateAllInitR
2598 Error err -> return $ Error err
2600 {-# INLINE processR #-}
2601 processR foldAction n = do
2604 FL.Partial fs1 -> do
2607 IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
2608 IDone _ -> errMsg "left" "succeed"
2609 IError _ -> errMsg "left" "fail"
2610 FL.Done c -> return $ Done n c
2612 {-# INLINE runStepR #-}
2613 runStepR fs sR a = do
2616 Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2617 Continue n s -> return $ Continue n (DeintercalateAllR fs s)
2618 Done n b -> processR (fstep fs (Right b)) n
2619 Error err -> return $ Error err
2621 step (DeintercalateAllInitL fs) a = do
2624 IPartial s -> runStepL fs s a
2625 IDone _ -> errMsg "left" "succeed"
2626 IError _ -> errMsg "left" "fail"
2627 step (DeintercalateAllL fs sL) a = runStepL fs sL a
2628 step (DeintercalateAllInitR fs) a = do
2631 IPartial s -> runStepR fs s a
2632 IDone _ -> errMsg "right" "succeed"
2633 IError _ -> errMsg "right" "fail"
2634 step (DeintercalateAllR fs sR) a = runStepR fs sR a
2636 {-# INLINE extractResult #-}
2637 extractResult n fs r = do
2640 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
2641 FL.Done c -> return (Done n c)
2642 extract (DeintercalateAllInitL fs) = fmap (Done 0) $ ffinal fs
2643 extract (DeintercalateAllL fs sL) = do
2646 Done n b -> extractResult n fs (Left b)
2647 Error err -> return $ Error err
2648 Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2649 Partial _ _ -> error "Partial in extract"
2650 extract (DeintercalateAllInitR fs) = fmap (Done 0) $ ffinal fs
2651 extract (DeintercalateAllR _ _) =
2652 return $ Error "deintercalateAll: input ended at 'Right' value"
2654{-# ANN type DeintercalateState Fuse #-}
2655data DeintercalateState b fs sp ss =
2656 DeintercalateInitL !fs
2657 | DeintercalateL !Int !fs !sp
2658 | DeintercalateInitR !fs
2659 | DeintercalateR !Int !fs !ss
2660 | DeintercalateRL !Int !b !fs !sp
2662-- XXX Add tests that the next character that we take after running a parser is
2663-- correct. Especially for the parsers that maintain a count. In the stream
2664-- finished case (extract) as well as not finished case.
2666-- | Apply two parsers alternately to an input stream. The input stream is
2667-- considered an interleaving of two patterns. The two parsers represent the
2668-- two patterns. Parsing starts at the first parser and stops at the first
2669-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2670-- input or single parse of the first parser is accepted.
2672-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2673-- >>> p2 = Parser.satisfy (== '+')
2674-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2675-- >>> Stream.parse p $ Stream.fromList ""
2677-- >>> Stream.parse p $ Stream.fromList "1"
2679-- >>> Stream.parse p $ Stream.fromList "1+"
2681-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2682-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2684{-# INLINE deintercalate #-}
2685deintercalate :: Monad m =>
2688 -> Fold m (Either x y) z
2691 (Parser stepL initialL extractL)
2692 (Parser stepR initialR _)
2693 (Fold fstep finitial _ ffinal) = Parser step initial extract
2698 error $ "deintercalate: " ++ p ++ " parser cannot "
2699 ++ status ++ " without input"
2704 FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2705 FL.Done c -> return $ IDone c
2707 {-# INLINE processL #-}
2708 processL foldAction n nextState = do
2711 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2712 FL.Done c -> return $ Done n c
2714 {-# INLINE runStepL #-}
2715 runStepL cnt fs sL a = do
2719 Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2720 Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2722 processL (fstep fs (Left b)) n DeintercalateInitR
2725 return $ Done cnt1 xs
2727 {-# INLINE processR #-}
2728 processR cnt b fs n = do
2731 IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2732 IDone _ -> errMsg "left" "succeed"
2733 IError _ -> errMsg "left" "fail"
2735 {-# INLINE runStepR #-}
2736 runStepR cnt fs sR a = do
2740 Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2741 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2742 Done n b -> processR (cnt1 - n) b fs n
2745 return $ Done cnt1 xs
2747 step (DeintercalateInitL fs) a = do
2750 IPartial s -> runStepL 0 fs s a
2751 IDone _ -> errMsg "left" "succeed"
2752 IError _ -> errMsg "left" "fail"
2753 step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2754 step (DeintercalateInitR fs) a = do
2757 IPartial s -> runStepR 0 fs s a
2758 IDone _ -> errMsg "right" "succeed"
2759 IError _ -> errMsg "right" "fail"
2760 step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2761 step (DeintercalateRL cnt bR fs sL) a = do
2765 Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2766 Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2768 res <- fstep fs (Right bR)
2770 FL.Partial fs1 -> do
2771 fres <- fstep fs1 (Left bL)
2774 return $ Partial n (DeintercalateInitR fs2)
2775 FL.Done c -> return $ Done n c
2776 -- XXX We could have the fold accept pairs of (bR, bL)
2777 FL.Done _ -> error "Fold terminated consuming partial input"
2780 return $ Done cnt1 xs
2782 {-# INLINE extractResult #-}
2783 extractResult n fs r = do
2786 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
2787 FL.Done c -> return (Done n c)
2789 extract (DeintercalateInitL fs) = fmap (Done 0) $ ffinal fs
2790 extract (DeintercalateL cnt fs sL) = do
2793 Done n b -> extractResult n fs (Left b)
2794 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2795 Partial _ _ -> error "Partial in extract"
2798 return $ Done cnt xs
2799 extract (DeintercalateInitR fs) = fmap (Done 0) $ ffinal fs
2800 extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ ffinal fs
2801 extract (DeintercalateRL cnt bR fs sL) = do
2805 res <- fstep fs (Right bR)
2807 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2808 FL.Done _ -> error "Fold terminated consuming partial input"
2809 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2810 Partial _ _ -> error "Partial in extract"
2813 return $ Done cnt xs
2815{-# ANN type Deintercalate1State Fuse #-}
2816data Deintercalate1State b fs sp ss =
2817 Deintercalate1InitL !Int !fs !sp
2818 | Deintercalate1InitR !fs
2819 | Deintercalate1R !Int !fs !ss
2820 | Deintercalate1RL !Int !b !fs !sp
2822-- | Apply two parsers alternately to an input stream. The input stream is
2823-- considered an interleaving of two patterns. The two parsers represent the
2824-- two patterns. Parsing starts at the first parser and stops at the first
2825-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2826-- input or single parse of the first parser is accepted.
2828-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2829-- >>> p2 = Parser.satisfy (== '+')
2830-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2831-- >>> Stream.parse p $ Stream.fromList ""
2832-- Left (ParseError "takeWhile1: end of input")
2833-- >>> Stream.parse p $ Stream.fromList "1"
2835-- >>> Stream.parse p $ Stream.fromList "1+"
2837-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2838-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2840{-# INLINE deintercalate1 #-}
2841deintercalate1 :: Monad m =>
2844 -> Fold m (Either x y) z
2847 (Parser stepL initialL extractL)
2848 (Parser stepR initialR _)
2849 (Fold fstep finitial _ ffinal) = Parser step initial extract
2854 error $ "deintercalate: " ++ p ++ " parser cannot "
2855 ++ status ++ " without input"
2863 IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2864 IDone _ -> errMsg "left" "succeed"
2865 IError _ -> errMsg "left" "fail"
2866 FL.Done c -> return $ IDone c
2868 {-# INLINE processL #-}
2869 processL foldAction n nextState = do
2872 FL.Partial fs1 -> return $ Partial n (nextState fs1)
2873 FL.Done c -> return $ Done n c
2875 {-# INLINE runStepInitL #-}
2876 runStepInitL cnt fs sL a = do
2880 Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2881 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2883 processL (fstep fs (Left b)) n Deintercalate1InitR
2884 Error err -> return $ Error err
2886 {-# INLINE processR #-}
2887 processR cnt b fs n = do
2890 IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2891 IDone _ -> errMsg "left" "succeed"
2892 IError _ -> errMsg "left" "fail"
2894 {-# INLINE runStepR #-}
2895 runStepR cnt fs sR a = do
2899 Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2900 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2901 Done n b -> processR (cnt1 - n) b fs n
2904 return $ Done cnt1 xs
2906 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2907 step (Deintercalate1InitR fs) a = do
2910 IPartial s -> runStepR 0 fs s a
2911 IDone _ -> errMsg "right" "succeed"
2912 IError _ -> errMsg "right" "fail"
2913 step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2914 step (Deintercalate1RL cnt bR fs sL) a = do
2918 Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2919 Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2921 res <- fstep fs (Right bR)
2923 FL.Partial fs1 -> do
2924 fres <- fstep fs1 (Left bL)
2927 return $ Partial n (Deintercalate1InitR fs2)
2928 FL.Done c -> return $ Done n c
2929 -- XXX We could have the fold accept pairs of (bR, bL)
2930 FL.Done _ -> error "Fold terminated consuming partial input"
2933 return $ Done cnt1 xs
2935 {-# INLINE extractResult #-}
2936 extractResult n fs r = do
2939 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
2940 FL.Done c -> return (Done n c)
2942 extract (Deintercalate1InitL cnt fs sL) = do
2945 Done n b -> extractResult n fs (Left b)
2946 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2947 Partial _ _ -> error "Partial in extract"
2948 Error err -> return $ Error err
2949 extract (Deintercalate1InitR fs) = fmap (Done 0) $ ffinal fs
2950 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ ffinal fs
2951 extract (Deintercalate1RL cnt bR fs sL) = do
2955 res <- fstep fs (Right bR)
2957 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2958 FL.Done _ -> error "Fold terminated consuming partial input"
2959 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2960 Partial _ _ -> error "Partial in extract"
2963 return $ Done cnt xs
2965{-# ANN type SepByState Fuse #-}
2966data SepByState fs sp ss =
2968 | SepByL !Int !fs !sp
2970 | SepByR !Int !fs !ss
2972-- | Apply two parsers alternately to an input stream. Parsing starts at the
2973-- first parser and stops at the first parser. The output of the first parser
2974-- is emiited and the output of the second parser is discarded. It can be used
2975-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
2976-- of the first parser is accepted.
2980-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
2981-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)
2985-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2986-- >>> p2 = Parser.satisfy (== '+')
2987-- >>> p = Parser.sepBy p1 p2 Fold.toList
2988-- >>> Stream.parse p $ Stream.fromList ""
2990-- >>> Stream.parse p $ Stream.fromList "1"
2992-- >>> Stream.parse p $ Stream.fromList "1+"
2994-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2995-- Right ["1","2","3"]
2999 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3000-- This has similar performance as the custom impl below.
3001-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
3003 (Parser stepL initialL extractL)
3004 (Parser stepR initialR _)
3005 (Fold fstep finitial _ ffinal) = Parser step initial extract
3010 error $ "sepBy: " ++ p ++ " parser cannot "
3011 ++ status ++ " without input"
3016 FL.Partial fs -> return $ IPartial $ SepByInitL fs
3017 FL.Done c -> return $ IDone c
3019 {-# INLINE processL #-}
3020 processL foldAction n nextState = do
3023 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3024 FL.Done c -> return $ Done n c
3026 {-# INLINE runStepL #-}
3027 runStepL cnt fs sL a = do
3031 Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3032 Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3034 processL (fstep fs b) n SepByInitR
3037 return $ Done cnt1 xs
3039 {-# INLINE processR #-}
3040 processR cnt fs n = do
3043 IPartial ps -> return $ Continue n (SepByL cnt fs ps)
3044 IDone _ -> errMsg "left" "succeed"
3045 IError _ -> errMsg "left" "fail"
3047 {-# INLINE runStepR #-}
3048 runStepR cnt fs sR a = do
3052 Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3053 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3054 Done n _ -> processR (cnt1 - n) fs n
3057 return $ Done cnt1 xs
3059 step (SepByInitL fs) a = do
3062 IPartial s -> runStepL 0 fs s a
3063 IDone _ -> errMsg "left" "succeed"
3064 IError _ -> errMsg "left" "fail"
3065 step (SepByL cnt fs sL) a = runStepL cnt fs sL a
3066 step (SepByInitR fs) a = do
3069 IPartial s -> runStepR 0 fs s a
3070 IDone _ -> errMsg "right" "succeed"
3071 IError _ -> errMsg "right" "fail"
3072 step (SepByR cnt fs sR) a = runStepR cnt fs sR a
3074 {-# INLINE extractResult #-}
3075 extractResult n fs r = do
3078 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
3079 FL.Done c -> return (Done n c)
3081 extract (SepByInitL fs) = fmap (Done 0) $ ffinal fs
3082 extract (SepByL cnt fs sL) = do
3085 Done n b -> extractResult n fs b
3086 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
3087 Partial _ _ -> error "Partial in extract"
3090 return $ Done cnt xs
3091 extract (SepByInitR fs) = fmap (Done 0) $ ffinal fs
3092 extract (SepByR cnt fs _) = fmap (Done cnt) $ ffinal fs
3094-- | Non-backtracking version of sepBy. Several times faster.
3095{-# INLINE sepByAll #-}
3096sepByAll :: Monad m =>
3097 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3098sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)
3100-- XXX This can be implemented using refold, parse one and then continue
3101-- collecting the rest in that.
3103{-# ANN type SepBy1State Fuse #-}
3104data SepBy1State fs sp ss =
3105 SepBy1InitL !Int !fs sp
3106 | SepBy1L !Int !fs !sp
3108 | SepBy1R !Int !fs !ss
3111{-# INLINE sepBy1 #-}
3113 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3114sepBy1 p sep sink = do
3116 f <- fromEffect $ FL.reduce sink
3117 f1 <- fromEffect $ FL.snoc f x
3121-- | Like 'sepBy' but requires at least one successful parse.
3125-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
3129-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3130-- >>> p2 = Parser.satisfy (== '+')
3131-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
3132-- >>> Stream.parse p $ Stream.fromList ""
3133-- Left (ParseError "takeWhile1: end of input")
3134-- >>> Stream.parse p $ Stream.fromList "1"
3136-- >>> Stream.parse p $ Stream.fromList "1+"
3138-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3139-- Right ["1","2","3"]
3141{-# INLINE sepBy1 #-}
3143 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3145 (Parser stepL initialL extractL)
3146 (Parser stepR initialR _)
3147 (Fold fstep finitial _ ffinal) = Parser step initial extract
3152 error $ "sepBy: " ++ p ++ " parser cannot "
3153 ++ status ++ " without input"
3161 IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
3162 IDone _ -> errMsg "left" "succeed"
3163 IError _ -> errMsg "left" "fail"
3164 FL.Done c -> return $ IDone c
3166 {-# INLINE processL #-}
3167 processL foldAction n nextState = do
3170 FL.Partial fs1 -> return $ Partial n (nextState fs1)
3171 FL.Done c -> return $ Done n c
3173 {-# INLINE runStepInitL #-}
3174 runStepInitL cnt fs sL a = do
3178 Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3179 Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3181 processL (fstep fs b) n SepBy1InitR
3182 Error err -> return $ Error err
3184 {-# INLINE runStepL #-}
3185 runStepL cnt fs sL a = do
3189 Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3190 Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3192 processL (fstep fs b) n SepBy1InitR
3195 return $ Done cnt1 xs
3197 {-# INLINE processR #-}
3198 processR cnt fs n = do
3201 IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3202 IDone _ -> errMsg "left" "succeed"
3203 IError _ -> errMsg "left" "fail"
3205 {-# INLINE runStepR #-}
3206 runStepR cnt fs sR a = do
3210 Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3211 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3212 Done n _ -> processR (cnt1 - n) fs n
3215 return $ Done cnt1 xs
3217 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3218 step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3219 step (SepBy1InitR fs) a = do
3222 IPartial s -> runStepR 0 fs s a
3223 IDone _ -> errMsg "right" "succeed"
3224 IError _ -> errMsg "right" "fail"
3225 step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3227 {-# INLINE extractResult #-}
3228 extractResult n fs r = do
3231 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
3232 FL.Done c -> return (Done n c)
3234 extract (SepBy1InitL cnt fs sL) = do
3237 Done n b -> extractResult n fs b
3238 Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3239 Partial _ _ -> error "Partial in extract"
3240 Error err -> return $ Error err
3241 extract (SepBy1L cnt fs sL) = do
3244 Done n b -> extractResult n fs b
3245 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3246 Partial _ _ -> error "Partial in extract"
3249 return $ Done cnt xs
3250 extract (SepBy1InitR fs) = fmap (Done 0) $ ffinal fs
3251 extract (SepBy1R cnt fs _) = fmap (Done cnt) $ ffinal fs
3253-------------------------------------------------------------------------------
3254-- Interleaving a collection of parsers
3255-------------------------------------------------------------------------------
3257-- | Apply a collection of parsers to an input stream in a round robin fashion.
3258-- Each parser is applied until it stops and then we repeat starting with the
3259-- the first parser again.
3263{-# INLINE roundRobin #-}
3264roundRobin :: -- (Foldable t, Monad m) =>
3265 t (Parser a m b) -> Fold m b c -> Parser a m c
3266roundRobin _ps _f = undefined
3268-------------------------------------------------------------------------------
3269-- Sequential Collection
3270-------------------------------------------------------------------------------
3272-- | @sequence f p@ collects sequential parses of parsers in a
3273-- serial stream @p@ using the fold @f@. Fails if the input ends or any
3274-- of the parsers fail.
3278{-# INLINE sequence #-}
3279sequence :: Monad m =>
3280 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c
3281sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) =
3282 Parser step initial extract
3289 FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)
3290 FL.Done c -> return $ IDone c
3292 -- state does not contain any parser
3293 -- yield a new parser from the stream
3294 step (Nothing', ss, fs) _ = do
3295 sres <- sstep defState ss
3297 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)
3301 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)
3303 -- state holds a parser that may or may not have been
3304 -- initialized. pinit holds the initial parser state
3305 -- or modified parser state respectively
3306 step (Just' (Parser pstep pinit pextr), ss, fs) a = do
3314 Just' $ Parser pstep (return $ IPartial ps2) pextr
3315 in return $ Partial n (newP, ss, fs)
3318 Just' $ Parser pstep (return $ IPartial ps2) pextr
3319 in return $ Continue n (newP, ss, fs)
3324 return $ Partial n (Nothing', ss, fs1)
3325 FL.Done c -> return $ Done n c
3326 Error msg -> return $ Error msg
3331 return $ Partial 1 (Nothing', ss, fs1)
3332 FL.Done c -> return $ Done 1 c
3333 IError err -> return $ Error err
3335 extract (Nothing', _, fs) = fmap (Done 0) $ ffinal fs
3336 extract (Just' (Parser pstep pinit pextr), ss, fs) = do
3345 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
3346 FL.Done c -> return (Done n c)
3347 Error err -> return $ Error err
3348 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)
3349 Partial _ _ -> error "Partial in extract"
3353 FL.Partial fs1 -> fmap (Done 0) $ ffinal fs1
3354 FL.Done c -> return (Done 0 c)
3355 IError err -> return $ Error err
3357-------------------------------------------------------------------------------
3358-- Alternative Collection
3359-------------------------------------------------------------------------------
3362-- | @choice parsers@ applies the @parsers@ in order and returns the first
3365-- This is same as 'asum' but more efficient.
3369{-# INLINE choice #-}
3370choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b
3371choice = foldl1 shortest
3374-------------------------------------------------------------------------------
3375-- Sequential Repetition
3376-------------------------------------------------------------------------------
3378-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the
3379-- results. Parsing stops or fails if the collecting parser stops or fails.
3384manyP :: -- MonadCatch m =>
3385 Parser a m b -> Parser b m c -> Parser a m c
3386manyP _p _f = undefined
3388-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
3389-- input stream and push the parse results to a downstream fold.
3391-- Stops: when the downstream fold stops or the parser fails.
3392-- Fails: never, produces zero or more results.
3394-- >>> many = Parser.countBetween 0 maxBound
3396-- Compare with 'Control.Applicative.many'.
3399many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3401-- many = countBetween 0 maxBound
3403-- Note: many1 would perhaps be a better name for this and consistent with
3404-- other names like takeWhile1. But we retain the name "some" for
3407-- | Collect one or more parses. Apply the supplied parser repeatedly on the
3408-- input stream and push the parse results to a downstream fold.
3410-- Stops: when the downstream fold stops or the parser fails.
3411-- Fails: if it stops without producing a single result.
3413-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)
3414-- >>> some = Parser.countBetween 1 maxBound
3416-- Compare with 'Control.Applicative.some'.
3419some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
3421-- some p f = manyP p (takeGE 1 f)
3422-- some = countBetween 1 maxBound
3424-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
3425-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
3426-- the input ends or the parser fails before @m@ results are collected.
3428-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)
3432{-# INLINE countBetween #-}
3433countBetween :: -- MonadCatch m =>
3434 Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
3435countBetween _m _n _p = undefined
3436-- countBetween m n p f = manyP p (takeBetween m n f)
3438-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
3439-- the fold @f@. Fails if the input ends or the parser fails before @n@
3440-- results are collected.
3442-- >>> count n = Parser.countBetween n n
3443-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)
3448count :: -- MonadCatch m =>
3449 Int -> Parser a m b -> Fold m b c -> Parser a m c
3450count n = countBetween n n
3451-- count n p f = manyP p (takeEQ n f)
3453-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a
3454-- 'Fold'. Parsing stops or fails if the collecting parser stops or fails.
3456-- We can implemnent parsers like the following using 'manyTillP':
3459-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p
3464{-# INLINE manyTillP #-}
3465manyTillP :: -- Monad m =>
3466 Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
3467manyTillP _p1 _p2 _f = undefined
3468 -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f
3470{-# ANN type ManyTillState Fuse #-}
3471data ManyTillState fs sr sl
3472 = ManyTillR !Int !fs !sr
3475-- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@
3476-- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is
3477-- tried again and so on. The parser stops when @test@ succeeds. The output of
3478-- @test@ is discarded and the output of @chunking@ is accumulated by the
3479-- supplied fold. The parser fails if @chunking@ fails.
3481-- Stops when the fold @f@ stops.
3483{-# INLINE manyTill #-}
3485 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3486manyTill (Parser stepL initialL extractL)
3487 (Parser stepR initialR _)
3488 (Fold fstep finitial _ ffinal) =
3489 Parser step initial extract
3493 -- Caution: Mutual recursion
3495 scrutL fs p c d e = do
3498 IPartial sl -> return $ c (ManyTillL fs sl)
3502 FL.Partial fs1 -> scrutR fs1 p c d e
3503 FL.Done fb -> return $ d fb
3504 IError err -> return $ e err
3506 scrutR fs p c d e = do
3509 IPartial sr -> return $ p (ManyTillR 0 fs sr)
3510 IDone _ -> d <$> ffinal fs
3511 IError _ -> scrutL fs p c d e
3516 FL.Partial fs -> scrutR fs IPartial IPartial IDone IError
3517 FL.Done b -> return $ IDone b
3519 step (ManyTillR cnt fs st) a = do
3522 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
3524 assertM(cnt + 1 - n >= 0)
3525 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
3533 return $ Continue (cnt + 1) (ManyTillL fs sl)
3545 FL.Done fb -> return $ Done cnt1 fb
3546 IError err -> return $ Error err
3547 step (ManyTillL fs st) a = do
3550 Partial n s -> return $ Partial n (ManyTillL fs s)
3551 Continue n s -> return $ Continue n (ManyTillL fs s)
3556 scrutR s (Partial n) (Continue n) (Done n) Error
3557 FL.Done b1 -> return $ Done n b1
3558 Error err -> return $ Error err
3560 extract (ManyTillL fs sR) = do
3566 FL.Partial fs1 -> fmap (Done n) $ ffinal fs1
3567 FL.Done c -> return (Done n c)
3568 Error err -> return $ Error err
3569 Continue n s -> return $ Continue n (ManyTillL fs s)
3570 Partial _ _ -> error "Partial in extract"
3571 extract (ManyTillR _ fs _) = fmap (Done 0) $ ffinal fs
3573-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
3574-- collects the output in the supplied fold. If the the parser @collect@ fails,
3575-- parser @recover@ is run until it stops and then we start repeating the
3576-- parser @collect@ again. The parser fails if the recovery parser fails.
3578-- For example, this can be used to find a key frame in a video stream after an
3583{-# INLINE manyThen #-}
3584manyThen :: -- (Foldable t, Monad m) =>
3585 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3586manyThen _parser _recover _f = undefined
3588-------------------------------------------------------------------------------
3589-- Repeated Alternatives
3590-------------------------------------------------------------------------------
3592-- | Keep trying a parser up to a maximum of @n@ failures. When the parser
3593-- fails the input consumed till now is dropped and the new instance is tried
3594-- on the fresh input.
3598{-# INLINE retryMaxTotal #-}
3599retryMaxTotal :: -- (Monad m) =>
3600 Int -> Parser a m b -> Fold m b c -> Parser a m c
3601retryMaxTotal _n _p _f = undefined
3603-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.
3607{-# INLINE retryMaxSuccessive #-}
3608retryMaxSuccessive :: -- (Monad m) =>
3609 Int -> Parser a m b -> Fold m b c -> Parser a m c
3610retryMaxSuccessive _n _p _f = undefined
3612-- | Keep trying a parser until it succeeds. When the parser fails the input
3613-- consumed till now is dropped and the new instance is tried on the fresh
3619retry :: -- (Monad m) =>
3620 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