@@ -2800,23 +2800,33 @@ deintercalate
28002800 return $ Done cnt xs
28012801
28022802data SepByState fs sp ss =
2803− SepByL !fs !sp
2804− | SepByR !fs !ss
2803+ SepByInitL !fs
2804+ | SepByL !Int !fs !sp
2805+ | SepByInitR !fs
2806+ | SepByR !Int !fs !ss
28052807
2806−-- | Run the content parser first, when it is done, the separator parser is
2807−-- run, when it is done content parser is run again and so on. If none of the
2808−-- parsers consumes an input then parser returns a failure.
2808+-- | Apply two parsers alternately to an input stream. Parsing starts at the
2809+-- first parser and stops at the first parser. The output of the first parser
2810+-- is emiited and the output of the second parser is discarded. It can be used
2811+-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
2812+-- of the first parser is accepted.
28092813--
28102814-- Definitions:
28112815--
2812−-- >>> sepBy p1 p2 sink = Parser.deintercalate p1 p2 (Fold.catLefts sink)
2813−-- >>> sepBy content sep sink = Parser.sepBy1 content sep sink <|> return mempty
2816+-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
2817+-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> return mempty
28142818--
28152819-- Examples:
28162820--
28172821-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
28182822-- >>> p2 = Parser.satisfy (== '+')
28192823-- >>> p = Parser.sepBy p1 p2 Fold.toList
2824+-- >>> Stream.parse p $ Stream.fromList ""
2825+-- Right []
2826+-- >>> Stream.parse p $ Stream.fromList "1"
2827+-- Right ["1"]
2828+-- >>> Stream.parse p $ Stream.fromList "1+"
2829+-- Right ["1"]
28202830-- >>> Stream.parse p $ Stream.fromList "1+2+3"
28212831-- Right ["1","2","3"]
28222832--
@@ -2837,48 +2847,63 @@ sepBy
28372847 initial = do
28382848 res <- finitial
28392849 case res of
2840− FL.Partial fs -> do
2841− resL <- initialL
2842− case resL of
2843− IPartial sL -> return $ IPartial $ (SepByL fs sL)
2844− IDone _ -> errMsg "left" "succeed"
2845− IError _ -> errMsg "left" "fail"
2850+ FL.Partial fs -> return $ IPartial $ (SepByInitL fs)
28462851 FL.Done c -> return $ IDone c
28472852
2848− {-# INLINE process #-}
2849− process foldAction initAction pid n nextState = do
2853+ {-# INLINE processL #-}
2854+ processL foldAction n nextState = do
28502855 fres <- foldAction
28512856 case fres of
2852− FL.Partial fs1 -> do
2853− res <- initAction
2854− case res of
2855− IPartial ps ->
2856− return $ Partial n (nextState fs1 ps)
2857− IDone _ -> errMsg pid "succeed"
2858− IError _ -> errMsg pid "fail"
2857+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
28592858 FL.Done c -> return $ Done n c
28602859
2861− step (SepByL fs sL) a = do
2860+ {-# INLINE runStepL #-}
2861+ runStepL cnt fs sL a = do
2862+ let cnt1 = cnt + 1
28622863 r <- stepL sL a
28632864 case r of
2864− Partial n s -> return $ Partial n (SepByL fs s)
2865− Continue n s -> return $ Continue n (SepByL fs s)
2865+ Partial n s -> return $ Continue n (SepByL cnt1 fs s)
2866+ Continue n s -> return $ Continue n (SepByL cnt1 fs s)
28662867 Done n b ->
2867− process (fstep fs b) initialR "right" n SepByR
2868− Error err -> return $ Error err
2869− step (SepByR fs sR) a = do
2868+ processL (fstep fs b) n SepByInitR
2869+ Error _ -> do
2870+ xs <- fextract fs
2871+ return $ Done cnt1 xs
2872+
2873+ {-# INLINE processR #-}
2874+ processR cnt fs n = do
2875+ res <- initialL
2876+ case res of
2877+ IPartial ps -> return $ Continue n (SepByL cnt fs ps)
2878+ IDone _ -> errMsg "left" "succeed"
2879+ IError _ -> errMsg "left" "fail"
2880+
2881+ {-# INLINE runStepR #-}
2882+ runStepR cnt fs sR a = do
2883+ let cnt1 = cnt + 1
28702884 r <- stepR sR a
28712885 case r of
2872− Partial n s -> return $ Partial n (SepByR fs s)
2873− Continue n s -> return $ Continue n (SepByR fs s)
2874− Done n _ -> do
2875− res <- initialL
2876− case res of
2877− IPartial ps ->
2878− return $ Partial n (SepByL fs ps)
2879− IDone _ -> errMsg "left" "succeed"
2880− IError _ -> errMsg "left" "fail"
2881− Error err -> return $ Error err
2886+ Partial n s -> return $ Continue n (SepByR cnt1 fs s)
2887+ Continue n s -> return $ Continue n (SepByR cnt1 fs s)
2888+ Done n _ -> processR cnt1 fs n
2889+ Error _ -> do
2890+ xs <- fextract fs
2891+ return $ Done cnt1 xs
2892+
2893+ step (SepByInitL fs) a = do
2894+ res <- initialL
2895+ case res of
2896+ IPartial s -> runStepL 0 fs s a
2897+ IDone _ -> errMsg "left" "succeed"
2898+ IError _ -> errMsg "left" "fail"
2899+ step (SepByL cnt fs sL) a = runStepL cnt fs sL a
2900+ step (SepByInitR fs) a = do
2901+ res <- initialR
2902+ case res of
2903+ IPartial s -> runStepR 0 fs s a
2904+ IDone _ -> errMsg "right" "succeed"
2905+ IError _ -> errMsg "right" "fail"
2906+ step (SepByR cnt fs sR) a = runStepR cnt fs sR a
28822907
28832908 {-# INLINE extractResult #-}
28842909 extractResult n fs r = do
@@ -2887,15 +2912,18 @@ sepBy
28872912 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
28882913 FL.Done c -> return (Done n c)
28892914
2890− extract (SepByL fs sL) = do
2915+ extract (SepByInitL fs) = fmap (Done 0) $ fextract fs
2916+ extract (SepByL cnt fs sL) = do
28912917 r <- extractL sL
28922918 case r of
28932919 Done n b -> extractResult n fs b
2894− Error err -> return $ Error err
2895− Continue n s -> return $ Continue n (SepByL fs s)
2920+ Continue n s -> return $ Continue n (SepByL cnt fs s)
28962921 Partial _ _ -> error "Partial in extract"
2897−
2898− extract (SepByR fs _) = fmap (Done 0) (fextract fs)
2922+ Error _ -> do
2923+ xs <- fextract fs
2924+ return $ Done cnt xs
2925+ extract (SepByInitR fs) = fmap (Done 0) $ fextract fs
2926+ extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs
28992927
29002928-- XXX This can be implemented using refold, parse one and then continue
29012929-- collecting the rest in that.