@@ -178,6 +178,7 @@ module Streamly.Internal.Data.Parser.ParserD
178178 -- Use two folds, run a primary parser, its rejected values go to the
179179 -- secondary parser.
180180 , deintercalate
181+ , deintercalateAll
181182 -- , deintercalatePrefix
182183 -- , deintercalateSuffix
183184
@@ -2520,47 +2521,43 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract
25202521-- all the three parsers. One parser can count the line numbers to provide the
25212522-- line number info.
25222523
2523−data DeintercalateState fs sp ss =
2524− DeintercalateInitL !fs
2525− | DeintercalateL !fs !sp
2526− | DeintercalateInitR !fs
2527− | DeintercalateR !fs !ss
2524+data DeintercalateAllState fs sp ss =
2525+ DeintercalateAllInitL !fs
2526+ | DeintercalateAllL !fs !sp
2527+ | DeintercalateAllInitR !fs
2528+ | DeintercalateAllR !fs !ss
25282529
25292530-- XXX rename this to intercalate
2530−-- XXX Need three versions of this:
2531−--
2532−-- * intercalate -- Stop at the first parser (default?)
2533−-- * intercalateSuffix/Snd -- Stop at the second parser
2534−-- * intercalateAny -- Stop at any parser
2535−--
2536−-- Make the naming such that the names of intercalate etc in stream module are
2537−-- duals of these.
25382531
2539−-- | Apply two parsers alternately to an input stream. The input stream is
2540−-- considered an interleaving of two patterns. The two parsers represent the
2541−-- two patterns. Parsing starts at the first parser and stops at the first
2542−-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2543−-- input or single parse of the first parser is accepted.
2532+-- Having deintercalateAll for accepting or rejecting entire input could be
2533+-- useful. For example, in case of JSON parsing we get an entire block of
2534+-- key-value pairs which we need to verify. This version may be simpler, more
2535+-- efficient. We could implement this as a stream operation like parseMany.
2536+
2537+-- | Like 'deintercalate' but the entire input must satisfy the pattern
2538+-- otherwise the parser fails.
25442539--
25452540-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
25462541-- >>> p2 = Parser.satisfy (== '+')
2547−-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2542+-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
25482543-- >>> Stream.parse p $ Stream.fromList ""
25492544-- Right []
25502545-- >>> Stream.parse p $ Stream.fromList "1"
25512546-- Right [Left "1"]
2547+-- >>> Stream.parse p $ Stream.fromList "1+"
2548+-- Left (ParseError "takeWhile1: end of input")
25522549-- >>> Stream.parse p $ Stream.fromList "1+2+3"
25532550-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
25542551--
2555−{-# INLINE deintercalate #-}
2556−deintercalate :: Monad m =>
2552+{-# INLINE deintercalateAll #-}
2553+deintercalateAll :: Monad m =>
25572554 Parser a m x
25582555 -> Parser a m y
25592556 -> Fold m (Either x y) z
25602557 -> Parser a m z
2561−deintercalate
2558+deintercalateAll
25622559 (Parser stepL initialL extractL)
2563− (Parser stepR initialR extractR)
2560+ (Parser stepR initialR _)
25642561 (Fold fstep finitial fextract) = Parser step initial extract
25652562
25662563 where
@@ -2572,7 +2569,7 @@ deintercalate
25722569 initial = do
25732570 res <- finitial
25742571 case res of
2575− FL.Partial fs -> return $ IPartial $ (DeintercalateInitL fs)
2572+ FL.Partial fs -> return $ IPartial $ (DeintercalateAllInitL fs)
25762573 FL.Done c -> return $ IDone c
25772574
25782575 {-# INLINE processL #-}
@@ -2586,10 +2583,10 @@ deintercalate
25862583 runStepL fs sL a = do
25872584 r <- stepL sL a
25882585 case r of
2589− Partial n s -> return $ Partial n (DeintercalateL fs s)
2590− Continue n s -> return $ Continue n (DeintercalateL fs s)
2586+ Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2587+ Continue n s -> return $ Continue n (DeintercalateAllL fs s)
25912588 Done n b ->
2592− processL (fstep fs (Left b)) n DeintercalateInitR
2589+ processL (fstep fs (Left b)) n DeintercalateAllInitR
25932590 Error err -> return $ Error err
25942591
25952592 {-# INLINE processR #-}
@@ -2599,7 +2596,7 @@ deintercalate
25992596 FL.Partial fs1 -> do
26002597 res <- initialL
26012598 case res of
2602− IPartial ps -> return $ Partial n (DeintercalateL fs1 ps)
2599+ IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
26032600 IDone _ -> errMsg "left" "succeed"
26042601 IError _ -> errMsg "left" "fail"
26052602 FL.Done c -> return $ Done n c
@@ -2608,25 +2605,166 @@ deintercalate
26082605 runStepR fs sR a = do
26092606 r <- stepR sR a
26102607 case r of
2611− Partial n s -> return $ Partial n (DeintercalateR fs s)
2612− Continue n s -> return $ Continue n (DeintercalateR fs s)
2608+ Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2609+ Continue n s -> return $ Continue n (DeintercalateAllR fs s)
26132610 Done n b -> processR (fstep fs (Right b)) n
26142611 Error err -> return $ Error err
26152612
2616− step (DeintercalateInitL fs) a = do
2613+ step (DeintercalateAllInitL fs) a = do
26172614 res <- initialL
26182615 case res of
26192616 IPartial s -> runStepL fs s a
26202617 IDone _ -> errMsg "left" "succeed"
26212618 IError _ -> errMsg "left" "fail"
2622− step (DeintercalateL fs sL) a = runStepL fs sL a
2623− step (DeintercalateInitR fs) a = do
2619+ step (DeintercalateAllL fs sL) a = runStepL fs sL a
2620+ step (DeintercalateAllInitR fs) a = do
26242621 res <- initialR
26252622 case res of
26262623 IPartial s -> runStepR fs s a
26272624 IDone _ -> errMsg "right" "succeed"
26282625 IError _ -> errMsg "right" "fail"
2629− step (DeintercalateR fs sR) a = runStepR fs sR a
2626+ step (DeintercalateAllR fs sR) a = runStepR fs sR a
2627+
2628+ {-# INLINE extractResult #-}
2629+ extractResult n fs r = do
2630+ res <- fstep fs r
2631+ case res of
2632+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2633+ FL.Done c -> return (Done n c)
2634+ extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs
2635+ extract (DeintercalateAllL fs sL) = do
2636+ r <- extractL sL
2637+ case r of
2638+ Done n b -> extractResult n fs (Left b)
2639+ Error err -> return $ Error err
2640+ Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2641+ Partial _ _ -> error "Partial in extract"
2642+ extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs
2643+ extract (DeintercalateAllR _ _) =
2644+ return $ Error "deintercalateAll: input ended at 'Right' value"
2645+
2646+data DeintercalateState b fs sp ss =
2647+ DeintercalateInitL !fs
2648+ | DeintercalateL !Int !fs !sp
2649+ | DeintercalateInitR !fs
2650+ | DeintercalateR !Int !fs !ss
2651+ | DeintercalateRL !Int !b !fs !sp
2652+
2653+-- | Apply two parsers alternately to an input stream. The input stream is
2654+-- considered an interleaving of two patterns. The two parsers represent the
2655+-- two patterns. Parsing starts at the first parser and stops at the first
2656+-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2657+-- input or single parse of the first parser is accepted.
2658+--
2659+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2660+-- >>> p2 = Parser.satisfy (== '+')
2661+-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2662+-- >>> Stream.parse p $ Stream.fromList ""
2663+-- Right []
2664+-- >>> Stream.parse p $ Stream.fromList "1"
2665+-- Right [Left "1"]
2666+-- >>> Stream.parse p $ Stream.fromList "1+"
2667+-- Right [Left "1"]
2668+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2669+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2670+--
2671+{-# INLINE deintercalate #-}
2672+deintercalate :: Monad m =>
2673+ Parser a m x
2674+ -> Parser a m y
2675+ -> Fold m (Either x y) z
2676+ -> Parser a m z
2677+deintercalate
2678+ (Parser stepL initialL extractL)
2679+ (Parser stepR initialR _)
2680+ (Fold fstep finitial fextract) = Parser step initial extract
2681+
2682+ where
2683+
2684+ errMsg p status =
2685+ error $ "deintercalate: " ++ p ++ " parser cannot "
2686+ ++ status ++ " without input"
2687+
2688+ initial = do
2689+ res <- finitial
2690+ case res of
2691+ FL.Partial fs -> return $ IPartial $ (DeintercalateInitL fs)
2692+ FL.Done c -> return $ IDone c
2693+
2694+ {-# INLINE processL #-}
2695+ processL foldAction n nextState = do
2696+ fres <- foldAction
2697+ case fres of
2698+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
2699+ FL.Done c -> return $ Done n c
2700+
2701+ {-# INLINE runStepL #-}
2702+ runStepL cnt fs sL a = do
2703+ let cnt1 = cnt + 1
2704+ r <- stepL sL a
2705+ case r of
2706+ Partial n s -> return $ Continue n (DeintercalateL cnt1 fs s)
2707+ Continue n s -> return $ Continue n (DeintercalateL cnt1 fs s)
2708+ Done n b ->
2709+ processL (fstep fs (Left b)) n DeintercalateInitR
2710+ Error _ -> do
2711+ xs <- fextract fs
2712+ return $ Done cnt1 xs
2713+
2714+ {-# INLINE processR #-}
2715+ processR cnt b fs n = do
2716+ res <- initialL
2717+ case res of
2718+ IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2719+ IDone _ -> errMsg "left" "succeed"
2720+ IError _ -> errMsg "left" "fail"
2721+
2722+ {-# INLINE runStepR #-}
2723+ runStepR cnt fs sR a = do
2724+ let cnt1 = cnt + 1
2725+ r <- stepR sR a
2726+ case r of
2727+ Partial n s -> return $ Continue n (DeintercalateR cnt1 fs s)
2728+ Continue n s -> return $ Continue n (DeintercalateR cnt1 fs s)
2729+ Done n b -> processR cnt1 b fs n
2730+ Error _ -> do
2731+ xs <- fextract fs
2732+ return $ Done cnt1 xs
2733+
2734+ step (DeintercalateInitL fs) a = do
2735+ res <- initialL
2736+ case res of
2737+ IPartial s -> runStepL 0 fs s a
2738+ IDone _ -> errMsg "left" "succeed"
2739+ IError _ -> errMsg "left" "fail"
2740+ step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2741+ step (DeintercalateInitR fs) a = do
2742+ res <- initialR
2743+ case res of
2744+ IPartial s -> runStepR 0 fs s a
2745+ IDone _ -> errMsg "right" "succeed"
2746+ IError _ -> errMsg "right" "fail"
2747+ step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2748+ step (DeintercalateRL cnt bR fs sL) a = do
2749+ let cnt1 = cnt + 1
2750+ r <- stepL sL a
2751+ case r of
2752+ Partial n s -> return $ Continue n (DeintercalateRL cnt1 bR fs s)
2753+ Continue n s -> return $ Continue n (DeintercalateRL cnt1 bR fs s)
2754+ Done n bL -> do
2755+ res <- fstep fs (Right bR)
2756+ case res of
2757+ FL.Partial fs1 -> do
2758+ fres <- fstep fs1 (Left bL)
2759+ case fres of
2760+ FL.Partial fs2 ->
2761+ return $ Partial n (DeintercalateInitR fs2)
2762+ FL.Done c -> return $ Done n c
2763+ -- XXX We could have the fold accept pairs of (bR, bL)
2764+ FL.Done _ -> error "Fold terminated consuming partial input"
2765+ Error _ -> do
2766+ xs <- fextract fs
2767+ return $ Done cnt1 xs
26302768
26312769 {-# INLINE extractResult #-}
26322770 extractResult n fs r = do
@@ -2636,21 +2774,30 @@ deintercalate
26362774 FL.Done c -> return (Done n c)
26372775
26382776 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs
2639− extract (DeintercalateL fs sL) = do
2777+ extract (DeintercalateL cnt fs sL) = do
26402778 r <- extractL sL
26412779 case r of
26422780 Done n b -> extractResult n fs (Left b)
2643− Error err -> return $ Error err
2644− Continue n s -> return $ Continue n (DeintercalateL fs s)
2781+ Continue n s -> return $ Continue n (DeintercalateL cnt fs s)
26452782 Partial _ _ -> error "Partial in extract"
2783+ Error _ -> do
2784+ xs <- fextract fs
2785+ return $ Done cnt xs
26462786 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs
2647− extract (DeintercalateR fs sR) = do
2648− r <- extractR sR
2787+ extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs
2788+ extract (DeintercalateRL cnt bR fs sL) = do
2789+ r <- extractL sL
26492790 case r of
2650− Done n b -> extractResult n fs (Right b)
2651− Error err -> return $ Error err
2652− Continue n s -> return $ Continue n (DeintercalateR fs s)
2791+ Done n bL -> do
2792+ res <- fstep fs (Right bR)
2793+ case res of
2794+ FL.Partial fs1 -> extractResult n fs1 (Left bL)
2795+ FL.Done _ -> error "Fold terminated consuming partial input"
2796+ Continue n s -> return $ Continue n (DeintercalateRL cnt bR fs s)
26532797 Partial _ _ -> error "Partial in extract"
2798+ Error _ -> do
2799+ xs <- fextract fs
2800+ return $ Done cnt xs
26542801
26552802data SepByState fs sp ss =
26562803 SepByInit !fs !sp