@@ -48,6 +48,7 @@ module Streamly.Internal.Data.Parser.Types
4848 (
4949 Step (..)
5050 , Parser (..)
51+ , splitWith
5152 )
5253where
5354
@@ -127,50 +128,57 @@ data SeqParseState sl f sr =
127128
128129-- XXX implement interleaved variant, parse using the first parser and then
129130-- using the second parser alternately.
131+
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.
130136--
131−-- | Apply two parsing folds sequentially to an input. The input is provided to
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.
135−--
136−-- This is the opposite of the "append" operation on streams.
137+-- This undoes an "append" of two streams, it splits the streams.
137138--
139+{-# INLINE splitWith #-}
140+splitWith :: Monad m
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
145+
146+ where
147+
148+ initial = SeqParseL <$> initialL
149+
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
153+ r <- stepL st a
154+ case r of
155+ Yield _ s -> return $ Skip 0 (SeqParseL s)
156+ Skip n s -> return $ Skip n (SeqParseL s)
157+ Stop n s -> do
158+ res <- extractL s
159+ case res of
160+ Left err -> return $ Stop n (SeqParseLErr err)
161+ Right x -> Skip n <$> (SeqParseR (func x) <$> initialR)
162+
163+ step (SeqParseR f st) a = do
164+ r <- stepR st a
165+ return $ case r of
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)
169+
170+ step (SeqParseLErr _) _ = error "step called in SeqParseLErr"
171+
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
177+
178+-- | 'Applicative' form of 'splitWith'.
138179instance Monad m => Applicative (Parser m a) where
139180 {-# INLINE pure #-}
140181 pure = wrap
141182
142183 {-# INLINE (<*>) #-}
143− (Parser stepL initialL extractL) <*> (Parser stepR initialR extractR) =
144− Parser step initial extract
145−
146− where
147−
148− initial = SeqParseL <$> initialL
149−
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
153− r <- stepL st a
154− case r of
155− Yield n s -> return $ Yield n (SeqParseL s)
156− Skip n s -> return $ Skip n (SeqParseL s)
157− Stop n s -> do
158− res <- extractL s
159− case res of
160− Left err -> return $ Stop n (SeqParseLErr err)
161− Right f -> Skip n <$> (SeqParseR f <$> initialR)
162−
163− step (SeqParseR f st) a = do
164− r <- stepR st a
165− return $ case r of
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)
169−
170− step (SeqParseLErr _) _ = error "step called in SeqParseLErr"
171−
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
184+ (<*>) = splitWith id