on master help sign in
Fix infinite loop in SepBy and refactor it
commit56c793103bb4eb699eba65445a1092d6c275db92 authorHarendra Kumar <harendra@composewell.com> dateTue 21 Feb 2023, 08:55 (4 years ago) parent95ebe09
1 file changed+62−47
core/src/Streamly/Internal/Data/Parser/ParserD.hs+62−47
core/src/Streamly/Internal/Data/Parser/ParserD.hs+62−47
@@ -2800,22 +2800,32 @@ deintercalate
28002800 return $ Done cnt xs
28012801
28022802data SepByState fs sp ss =
2803− SepByInit !fs !sp
2804− | SepBySeparator !fs !ss !Bool
2803+ SepByL !fs !sp
2804+ | SepByR !fs !ss
28052805
28062806-- | Run the content parser first, when it is done, the separator parser is
28072807-- run, when it is done content parser is run again and so on. If none of the
28082808-- parsers consumes an input then parser returns a failure.
28092809--
2810+-- Definitions:
2811+--
28102812-- >>> sepBy p1 p2 sink = Parser.deintercalate p1 p2 (Fold.catLefts sink)
28112813-- >>> sepBy content sep sink = Parser.sepBy1 content sep sink <|> return mempty
28122814--
2815+-- Examples:
2816+--
2817+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2818+-- >>> p2 = Parser.satisfy (== '+')
2819+-- >>> p = Parser.sepBy p1 p2 Fold.toList
2820+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2821+-- Right ["1","2","3"]
2822+--
28132823{-# INLINE sepBy #-}
28142824sepBy :: Monad m =>
28152825 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
28162826sepBy
2817− (Parser pstep pinitial pextract)
2818− (Parser sstep sinitial _)
2827+ (Parser stepL initialL extractL)
2828+ (Parser stepR initialR _)
28192829 (Fold fstep finitial fextract) = Parser step initial extract
28202830
28212831 where
@@ -2828,59 +2838,64 @@ sepBy
28282838 res <- finitial
28292839 case res of
28302840 FL.Partial fs -> do
2831− resP <- pinitial
2832− case resP of
2833− IPartial sp -> return $ IPartial $ SepByInit fs sp
2834− IDone _ -> errMsg "content" "succeed"
2835− IError _ -> errMsg "content" "fail"
2836− FL.Done b -> return $ IDone b
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"
2846+ FL.Done c -> return $ IDone c
28372847
2838− step (SepByInit fs sp) a = do
2839− r <- pstep sp a
2848+ {-# INLINE process #-}
2849+ process foldAction initAction pid n nextState = do
2850+ fres <- foldAction
2851+ 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"
2859+ FL.Done c -> return $ Done n c
2860+
2861+ step (SepByL fs sL) a = do
2862+ r <- stepL sL a
28402863 case r of
2841− Partial n s -> return $ Partial n (SepByInit fs s)
2842− Continue n s -> return $ Continue n (SepByInit fs s)
2843− Done n b -> do
2844− fres <- fstep fs b
2845− case fres of
2846− FL.Partial fs1 -> do
2847− resS <- sinitial
2848− case resS of
2849− IPartial ss ->
2850− return $ Partial n (SepBySeparator fs1 ss False)
2851− IDone _ -> errMsg "separator" "succeed"
2852− IError _ -> errMsg "separator" "fail"
2853− FL.Done c -> return $ Done n c
2864+ Partial n s -> return $ Partial n (SepByL fs s)
2865+ Continue n s -> return $ Continue n (SepByL fs s)
2866+ Done n b ->
2867+ process (fstep fs b) initialR "right" n SepByR
28542868 Error err -> return $ Error err
2855− step (SepBySeparator fs ss consumed) a = do
2856− r <- sstep ss a
2869+ step (SepByR fs sR) a = do
2870+ r <- stepR sR a
28572871 case r of
2858− Partial n s -> return $ Partial n (SepBySeparator fs s True)
2859− Continue n s -> return $ Continue n (SepBySeparator fs s True)
2860− Done n _ ->
2861− if consumed
2862− then do
2863− resP <- pinitial
2864− case resP of
2865− IPartial sp -> return $ Partial n $ SepByInit fs sp
2866− IDone _ -> errMsg "content" "succeed"
2867− IError _ -> errMsg "content" "fail"
2868− else error "sepBy: infinite loop"
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"
28692881 Error err -> return $ Error err
28702882
2871− extract (SepByInit fs sp) = do
2872− r <- pextract sp
2883+ {-# INLINE extractResult #-}
2884+ extractResult n fs r = do
2885+ res <- fstep fs r
2886+ case res of
2887+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2888+ FL.Done c -> return (Done n c)
2889+
2890+ extract (SepByL fs sL) = do
2891+ r <- extractL sL
28732892 case r of
2874− Done n b -> do
2875− res <- fstep fs b
2876− case res of
2877− FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2878− FL.Done c -> return (Done n c)
2893+ Done n b -> extractResult n fs b
28792894 Error err -> return $ Error err
2880− Continue n s -> return $ Continue n (SepByInit fs s)
2895+ Continue n s -> return $ Continue n (SepByL fs s)
28812896 Partial _ _ -> error "Partial in extract"
28822897
2883− extract (SepBySeparator fs _ _) = fmap (Done 0) $ fextract fs
2898+ extract (SepByR fs _) = fmap (Done 0) (fextract fs)
28842899
28852900-- XXX This can be implemented using refold, parse one and then continue
28862901-- collecting the rest in that.