git.iko.soy/streamly
on master help sign in
Add deintercalate1
0db979fHarendra Kumar
core/src/Streamly/Internal/Data/Parser/ParserD.hs+174
compare with master
unifiedsplit
@@ -178,6 +178,7 @@ module Streamly.Internal.Data.Parser.ParserD
178 -- Use two folds, run a primary parser, its rejected values go to the
178 -- Use two folds, run a primary parser, its rejected values go to the
179 -- secondary parser.
179 -- secondary parser.
180 , deintercalate
180 , deintercalate
181+ , deintercalate1
181 , deintercalateAll
182 , deintercalateAll
182 -- , deintercalatePrefix
183 -- , deintercalatePrefix
183 -- , deintercalateSuffix
184 -- , deintercalateSuffix
@@ -2799,6 +2800,179 @@ deintercalate
2799 xs <- fextract fs
2800 xs <- fextract fs
2800 return $ Done cnt xs
2801 return $ Done cnt xs
2801
2802
2803+data Deintercalate1State b fs sp ss =
2804+ Deintercalate1InitL !Int !fs !sp
2805+ | Deintercalate1L !Int !fs !sp
2806+ | Deintercalate1InitR !fs
2807+ | Deintercalate1R !Int !fs !ss
2808+ | Deintercalate1RL !Int !b !fs !sp
2809+
2810+-- | Apply two parsers alternately to an input stream. The input stream is
2811+-- considered an interleaving of two patterns. The two parsers represent the
2812+-- two patterns. Parsing starts at the first parser and stops at the first
2813+-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2814+-- input or single parse of the first parser is accepted.
2815+--
2816+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2817+-- >>> p2 = Parser.satisfy (== '+')
2818+-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2819+-- >>> Stream.parse p $ Stream.fromList ""
2820+-- Left (ParseError "takeWhile1: end of input")
2821+-- >>> Stream.parse p $ Stream.fromList "1"
2822+-- Right [Left "1"]
2823+-- >>> Stream.parse p $ Stream.fromList "1+"
2824+-- Right [Left "1"]
2825+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2826+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2827+--
2828+{-# INLINE deintercalate1 #-}
2829+deintercalate1 :: Monad m =>
2830+ Parser a m x
2831+ -> Parser a m y
2832+ -> Fold m (Either x y) z
2833+ -> Parser a m z
2834+deintercalate1
2835+ (Parser stepL initialL extractL)
2836+ (Parser stepR initialR _)
2837+ (Fold fstep finitial fextract) = Parser step initial extract
2838+
2839+ where
2840+
2841+ errMsg p status =
2842+ error $ "deintercalate: " ++ p ++ " parser cannot "
2843+ ++ status ++ " without input"
2844+
2845+ initial = do
2846+ res <- finitial
2847+ case res of
2848+ FL.Partial fs -> do
2849+ pres <- initialL
2850+ case pres of
2851+ IPartial s -> return $ IPartial $ (Deintercalate1InitL 0 fs s)
2852+ IDone _ -> errMsg "left" "succeed"
2853+ IError _ -> errMsg "left" "fail"
2854+ FL.Done c -> return $ IDone c
2855+
2856+ {-# INLINE processL #-}
2857+ processL foldAction n nextState = do
2858+ fres <- foldAction
2859+ case fres of
2860+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
2861+ FL.Done c -> return $ Done n c
2862+
2863+ {-# INLINE runStepInitL #-}
2864+ runStepInitL cnt fs sL a = do
2865+ let cnt1 = cnt + 1
2866+ r <- stepL sL a
2867+ case r of
2868+ Partial n s -> return $ Continue n (Deintercalate1InitL cnt1 fs s)
2869+ Continue n s -> return $ Continue n (Deintercalate1InitL cnt1 fs s)
2870+ Done n b ->
2871+ processL (fstep fs (Left b)) n Deintercalate1InitR
2872+ Error err -> return $ Error err
2873+
2874+ {-# INLINE runStepL #-}
2875+ runStepL cnt fs sL a = do
2876+ let cnt1 = cnt + 1
2877+ r <- stepL sL a
2878+ case r of
2879+ Partial n s -> return $ Continue n (Deintercalate1L cnt1 fs s)
2880+ Continue n s -> return $ Continue n (Deintercalate1L cnt1 fs s)
2881+ Done n b ->
2882+ processL (fstep fs (Left b)) n Deintercalate1InitR
2883+ Error _ -> do
2884+ xs <- fextract fs
2885+ return $ Done cnt1 xs
2886+
2887+ {-# INLINE processR #-}
2888+ processR cnt b fs n = do
2889+ res <- initialL
2890+ case res of
2891+ IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2892+ IDone _ -> errMsg "left" "succeed"
2893+ IError _ -> errMsg "left" "fail"
2894+
2895+ {-# INLINE runStepR #-}
2896+ runStepR cnt fs sR a = do
2897+ let cnt1 = cnt + 1
2898+ r <- stepR sR a
2899+ case r of
2900+ Partial n s -> return $ Continue n (Deintercalate1R cnt1 fs s)
2901+ Continue n s -> return $ Continue n (Deintercalate1R cnt1 fs s)
2902+ Done n b -> processR cnt1 b fs n
2903+ Error _ -> do
2904+ xs <- fextract fs
2905+ return $ Done cnt1 xs
2906+
2907+ step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2908+ step (Deintercalate1L cnt fs sL) a = runStepL cnt fs sL a
2909+ step (Deintercalate1InitR fs) a = do
2910+ res <- initialR
2911+ case res of
2912+ IPartial s -> runStepR 0 fs s a
2913+ IDone _ -> errMsg "right" "succeed"
2914+ IError _ -> errMsg "right" "fail"
2915+ step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2916+ step (Deintercalate1RL cnt bR fs sL) a = do
2917+ let cnt1 = cnt + 1
2918+ r <- stepL sL a
2919+ case r of
2920+ Partial n s -> return $ Continue n (Deintercalate1RL cnt1 bR fs s)
2921+ Continue n s -> return $ Continue n (Deintercalate1RL cnt1 bR fs s)
2922+ Done n bL -> do
2923+ res <- fstep fs (Right bR)
2924+ case res of
2925+ FL.Partial fs1 -> do
2926+ fres <- fstep fs1 (Left bL)
2927+ case fres of
2928+ FL.Partial fs2 ->
2929+ return $ Partial n (Deintercalate1InitR fs2)
2930+ FL.Done c -> return $ Done n c
2931+ -- XXX We could have the fold accept pairs of (bR, bL)
2932+ FL.Done _ -> error "Fold terminated consuming partial input"
2933+ Error _ -> do
2934+ xs <- fextract fs
2935+ return $ Done cnt1 xs
2936+
2937+ {-# INLINE extractResult #-}
2938+ extractResult n fs r = do
2939+ res <- fstep fs r
2940+ case res of
2941+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2942+ FL.Done c -> return (Done n c)
2943+
2944+ extract (Deintercalate1InitL cnt fs sL) = do
2945+ r <- extractL sL
2946+ case r of
2947+ Done n b -> extractResult n fs (Left b)
2948+ Continue n s -> return $ Continue n (Deintercalate1InitL cnt fs s)
2949+ Partial _ _ -> error "Partial in extract"
2950+ Error err -> return $ Error err
2951+ extract (Deintercalate1L cnt fs sL) = do
2952+ r <- extractL sL
2953+ case r of
2954+ Done n b -> extractResult n fs (Left b)
2955+ Continue n s -> return $ Continue n (Deintercalate1L cnt fs s)
2956+ Partial _ _ -> error "Partial in extract"
2957+ Error _ -> do
2958+ xs <- fextract fs
2959+ return $ Done cnt xs
2960+ extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2961+ extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2962+ extract (Deintercalate1RL cnt bR fs sL) = do
2963+ r <- extractL sL
2964+ case r of
2965+ Done n bL -> do
2966+ res <- fstep fs (Right bR)
2967+ case res of
2968+ FL.Partial fs1 -> extractResult n fs1 (Left bL)
2969+ FL.Done _ -> error "Fold terminated consuming partial input"
2970+ Continue n s -> return $ Continue n (Deintercalate1RL cnt bR fs s)
2971+ Partial _ _ -> error "Partial in extract"
2972+ Error _ -> do
2973+ xs <- fextract fs
2974+ return $ Done cnt xs
2975+
2802data SepByState fs sp ss =
2976data SepByState fs sp ss =
2803 SepByInitL !fs
2977 SepByInitL !fs
2804 | SepByL !Int !fs !sp
2978 | SepByL !Int !fs !sp