@@ -48,6 +48,7 @@ module Streamly.Internal.Data.Parser.Types
50 , Parser (..)
50 , Parser (..)
@@ -127,50 +128,57 @@ data SeqParseState sl f sr =
128-- XXX implement interleaved variant, parse using the first parser and then
129-- XXX implement interleaved variant, parse using the first parser and then
129-- using the second parser alternately.
130-- using the second parser alternately.
132+-- | Apply two parsers sequentially to an input stream. The input is provided
133+-- to the first parser, when it is done the remaining input is provided to the
134+-- second parser. If both the parsers succeed there outputs are combined using
135+-- the supplied function. The operation fails if any of the parsers fail.
131−-- | Apply two parsing folds sequentially to an input. The input is provided to
137+-- This undoes an "append" of two streams, it splits the streams.
132−-- the first parser, if the parser fails then whole composition fails. If the
133−-- parser succeeds, the remaining input is supplied to the second parser. If
134−-- the second parser succeeds the composed parser succeeds otherwise it fails.
136−-- This is the opposite of the "append" operation on streams.
139+{-# INLINE splitWith #-}
141+ => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
142+splitWith func (Parser stepL initialL extractL)
143+ (Parser stepR initialR extractR) =
144+ Parser step initial extract
148+ initial = SeqParseL <$> initialL
150+ -- Note: For the composed parse to terminate, the left parser has to be
151+ -- a terminating parser returning a Stop at some point.
152+ step (SeqParseL st) a = do
155+ Yield _ s -> return $ Skip 0 (SeqParseL s)
156+ Skip n s -> return $ Skip n (SeqParseL s)
160+ Left err -> return $ Stop n (SeqParseLErr err)
161+ Right x -> Skip n <$> (SeqParseR (func x) <$> initialR)
163+ step (SeqParseR f st) a = do
166+ Yield n s -> Yield n (SeqParseR f s)
167+ Skip n s -> Skip n (SeqParseR f s)
168+ Stop n s -> Stop n (SeqParseR f s)
170+ step (SeqParseLErr _) _ = error "step called in SeqParseLErr"
172+ -- XXX bimap to add "<*>: Right parse failed" to the error message
173+ extract (SeqParseR f s) = fmap (fmap f) (extractR s)
174+ extract (SeqParseL _) = return $ Left "<*>: Incomplete left parse"
175+ extract (SeqParseLErr err) =
176+ return $ Left $ "<*>: Left parse failed\n" ++ err
178+-- | 'Applicative' form of 'splitWith'.
138instance Monad m => Applicative (Parser m a) where
179instance Monad m => Applicative (Parser m a) where
139 {-# INLINE pure #-}
180 {-# INLINE pure #-}
140 pure = wrap
181 pure = wrap
142 {-# INLINE (<*>) #-}
183 {-# INLINE (<*>) #-}
143− (Parser stepL initialL extractL) <*> (Parser stepR initialR extractR) =
184+ (<*>) = splitWith id
144− Parser step initial extract
148− initial = SeqParseL <$> initialL
150− -- Note: For the composed parse to terminate, the left parser has to be
151− -- a terminating parser returning a Halt at some point.
152− step (SeqParseL st) a = do
155− Yield n s -> return $ Yield n (SeqParseL s)
156− Skip n s -> return $ Skip n (SeqParseL s)
160− Left err -> return $ Stop n (SeqParseLErr err)
161− Right f -> Skip n <$> (SeqParseR f <$> initialR)
163− step (SeqParseR f st) a = do
166− Yield n s -> Yield n (SeqParseR f s)
167− Skip n s -> Skip n (SeqParseR f s)
168− Stop n s -> Stop n (SeqParseR f s)
170− step (SeqParseLErr _) _ = error "step called in SeqParseLErr"
172− -- XXX bimap to add "<*>: Right parse failed" to the error message
173− extract (SeqParseR f s) = fmap (fmap f) (extractR s)
174− extract (SeqParseL _) = return $ Left "<*>: Incomplete left parse"
175− extract (SeqParseLErr err) =
176− return $ Left $ "<*>: Left parse failed\n" ++ err