95ebe09 · streamly · git.iko.soy

178 -- Use two folds, run a primary parser, its rejected values go to the

179 -- secondary parser.

180 , deintercalate

181+ , deintercalateAll

181 -- , deintercalatePrefix

182 -- , deintercalatePrefix

182 -- , deintercalateSuffix

183 -- , deintercalateSuffix

183

184

2520-- all the three parsers. One parser can count the line numbers to provide the

2521-- all the three parsers. One parser can count the line numbers to provide the

2521-- line number info.

2522-- line number info.

2522

2523

2523−data DeintercalateState fs sp ss =

2524+data DeintercalateAllState fs sp ss =

2524− DeintercalateInitL !fs

2525+ DeintercalateAllInitL !fs

2525− | DeintercalateL !fs !sp

2526+ | DeintercalateAllL !fs !sp

2526− | DeintercalateInitR !fs

2527+ | DeintercalateAllInitR !fs

2527− | DeintercalateR !fs !ss

2528+ | DeintercalateAllR !fs !ss

2528

2529

2529-- XXX rename this to intercalate

2530-- 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.

2538

2531

2539−-- | Apply two parsers alternately to an input stream. The input stream is

2532+-- Having deintercalateAll for accepting or rejecting entire input could be

2540−-- considered an interleaving of two patterns. The two parsers represent the

2533+-- useful. For example, in case of JSON parsing we get an entire block of

2541−-- two patterns. Parsing starts at the first parser and stops at the first

2534+-- key-value pairs which we need to verify. This version may be simpler, more

2542−-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty

2535+-- efficient. We could implement this as a stream operation like parseMany.

2543−-- input or single parse of the first parser is accepted.

2536+

2537+-- | Like 'deintercalate' but the entire input must satisfy the pattern

2538+-- otherwise the parser fails.

2544--

2539--

2545-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList

2540-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList

2546-- >>> p2 = Parser.satisfy (== '+')

2541-- >>> p2 = Parser.satisfy (== '+')

2547−-- >>> p = Parser.deintercalate p1 p2 Fold.toList

2542+-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList

2548-- >>> Stream.parse p $ Stream.fromList ""

2543-- >>> Stream.parse p $ Stream.fromList ""

2549-- Right []

2544-- Right []

2550-- >>> Stream.parse p $ Stream.fromList "1"

2545-- >>> Stream.parse p $ Stream.fromList "1"

2551-- Right [Left "1"]

2546-- Right [Left "1"]

2547+-- >>> Stream.parse p $ Stream.fromList "1+"

2548+-- Left (ParseError "takeWhile1: end of input")

2552-- >>> Stream.parse p $ Stream.fromList "1+2+3"

2549-- >>> Stream.parse p $ Stream.fromList "1+2+3"

2553-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]

2550-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]

2554--

2551--

2555−{-# INLINE deintercalate #-}

2552+{-# INLINE deintercalateAll #-}

2556−deintercalate :: Monad m =>

2553+deintercalateAll :: Monad m =>

2557 Parser a m x

2554 Parser a m x

2558 -> Parser a m y

2555 -> Parser a m y

2559 -> Fold m (Either x y) z

2556 -> Fold m (Either x y) z

2560 -> Parser a m z

2557 -> Parser a m z

2561−deintercalate

2558+deintercalateAll

2562 (Parser stepL initialL extractL)

2559 (Parser stepL initialL extractL)

2563− (Parser stepR initialR extractR)

2560+ (Parser stepR initialR _)

2564 (Fold fstep finitial fextract) = Parser step initial extract

2561 (Fold fstep finitial fextract) = Parser step initial extract

2565

2562

2566 where

2563 where

2572 initial = do

2569 initial = do

2573 res <- finitial

2570 res <- finitial

2574 case res of

2571 case res of

2575− FL.Partial fs -> return $ IPartial $ (DeintercalateInitL fs)

2572+ FL.Partial fs -> return $ IPartial $ (DeintercalateAllInitL fs)

2576 FL.Done c -> return $ IDone c

2573 FL.Done c -> return $ IDone c

2577

2574

2578 {-# INLINE processL #-}

2575 {-# INLINE processL #-}

2586 runStepL fs sL a = do

2583 runStepL fs sL a = do

2587 r <- stepL sL a

2584 r <- stepL sL a

2588 case r of

2585 case r of

2589− Partial n s -> return $ Partial n (DeintercalateL fs s)

2586+ Partial n s -> return $ Partial n (DeintercalateAllL fs s)

2590− Continue n s -> return $ Continue n (DeintercalateL fs s)

2587+ Continue n s -> return $ Continue n (DeintercalateAllL fs s)

2591 Done n b ->

2588 Done n b ->

2592− processL (fstep fs (Left b)) n DeintercalateInitR

2589+ processL (fstep fs (Left b)) n DeintercalateAllInitR

2593 Error err -> return $ Error err

2590 Error err -> return $ Error err

2594

2591

2595 {-# INLINE processR #-}

2592 {-# INLINE processR #-}

2599 FL.Partial fs1 -> do

2596 FL.Partial fs1 -> do

2600 res <- initialL

2597 res <- initialL

2601 case res of

2598 case res of

2602− IPartial ps -> return $ Partial n (DeintercalateL fs1 ps)

2599+ IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)

2603 IDone _ -> errMsg "left" "succeed"

2600 IDone _ -> errMsg "left" "succeed"

2604 IError _ -> errMsg "left" "fail"

2601 IError _ -> errMsg "left" "fail"

2605 FL.Done c -> return $ Done n c

2602 FL.Done c -> return $ Done n c

2608 runStepR fs sR a = do

2605 runStepR fs sR a = do

2609 r <- stepR sR a

2606 r <- stepR sR a

2610 case r of

2607 case r of

2611− Partial n s -> return $ Partial n (DeintercalateR fs s)

2608+ Partial n s -> return $ Partial n (DeintercalateAllR fs s)

2612− Continue n s -> return $ Continue n (DeintercalateR fs s)

2609+ Continue n s -> return $ Continue n (DeintercalateAllR fs s)

2613 Done n b -> processR (fstep fs (Right b)) n

2610 Done n b -> processR (fstep fs (Right b)) n

2614 Error err -> return $ Error err

2611 Error err -> return $ Error err

2615

2612

2616− step (DeintercalateInitL fs) a = do

2613+ step (DeintercalateAllInitL fs) a = do

2617 res <- initialL

2614 res <- initialL

2618 case res of

2615 case res of

2619 IPartial s -> runStepL fs s a

2616 IPartial s -> runStepL fs s a

2620 IDone _ -> errMsg "left" "succeed"

2617 IDone _ -> errMsg "left" "succeed"

2621 IError _ -> errMsg "left" "fail"

2618 IError _ -> errMsg "left" "fail"

2622− step (DeintercalateL fs sL) a = runStepL fs sL a

2619+ step (DeintercalateAllL fs sL) a = runStepL fs sL a

2623− step (DeintercalateInitR fs) a = do

2620+ step (DeintercalateAllInitR fs) a = do

2624 res <- initialR

2621 res <- initialR

2625 case res of

2622 case res of

2626 IPartial s -> runStepR fs s a

2623 IPartial s -> runStepR fs s a

2627 IDone _ -> errMsg "right" "succeed"

2624 IDone _ -> errMsg "right" "succeed"

2628 IError _ -> errMsg "right" "fail"

2625 IError _ -> errMsg "right" "fail"

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

2629− step (DeintercalateR fs sR) a = runStepR fs sR a

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

2630

2768

2631 {-# INLINE extractResult #-}

2769 {-# INLINE extractResult #-}

2632 extractResult n fs r = do

2770 extractResult n fs r = do

2636 FL.Done c -> return (Done n c)

2774 FL.Done c -> return (Done n c)

2637

2775

2638 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs

2776 extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs

2639− extract (DeintercalateL fs sL) = do

2777+ extract (DeintercalateL cnt fs sL) = do

2640 r <- extractL sL

2778 r <- extractL sL

2641 case r of

2779 case r of

2642 Done n b -> extractResult n fs (Left b)

2780 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)

2645 Partial _ _ -> error "Partial in extract"

2782 Partial _ _ -> error "Partial in extract"

2783+ Error _ -> do

2784+ xs <- fextract fs

2785+ return $ Done cnt xs

2646 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs

2786 extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs

2647− extract (DeintercalateR fs sR) = do

2787+ extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs

2648− r <- extractR sR

2788+ extract (DeintercalateRL cnt bR fs sL) = do

2789+ r <- extractL sL

2649 case r of

2790 case r of

2791+ Done n bL -> do

2792+ res <- fstep fs (Right bR)

2793+ case res of

2650− Done n b -> extractResult n fs (Right b)

2794+ FL.Partial fs1 -> extractResult n fs1 (Left bL)

2651− Error err -> return $ Error err

2795+ FL.Done _ -> error "Fold terminated consuming partial input"

2652− Continue n s -> return $ Continue n (DeintercalateR fs s)

2796+ Continue n s -> return $ Continue n (DeintercalateRL cnt bR fs s)

2653 Partial _ _ -> error "Partial in extract"

2797 Partial _ _ -> error "Partial in extract"

2798+ Error _ -> do

2799+ xs <- fextract fs

2800+ return $ Done cnt xs

2654

2801

2655data SepByState fs sp ss =

2802data SepByState fs sp ss =

2656 SepByInit !fs !sp

2803 SepByInit !fs !sp