@@ -2847,7 +2847,7 @@ sepBy
28472847 initial = do
28482848 res <- finitial
28492849 case res of
2850− FL.Partial fs -> return $ IPartial $ (SepByInitL fs)
2850+ FL.Partial fs -> return $ IPartial $ SepByInitL fs
28512851 FL.Done c -> return $ IDone c
28522852
28532853 {-# INLINE processL #-}
@@ -2928,12 +2928,13 @@ sepBy
29282928-- XXX This can be implemented using refold, parse one and then continue
29292929-- collecting the rest in that.
29302930
2931−-- | Parse items separated by a separator parsed by the supplied parser. At
2932−-- least one item must be present for the parser to succeed.
2933−--
2934−-- Note that this can go in infinite loop if both the parsers fail on some
2935−-- input. Detection of that would make the implementation more complex.
2936−--
2931+data SepBy1State fs sp ss =
2932+ SepBy1InitL !Int !fs sp
2933+ | SepBy1L !Int !fs !sp
2934+ | SepBy1InitR !fs
2935+ | SepBy1R !Int !fs !ss
2936+
2937+{-
29372938{-# INLINE sepBy1 #-}
29382939sepBy1 :: Monad m =>
29392940 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
@@ -2942,6 +2943,135 @@ sepBy1 p sep sink = do
29422943 f <- fromEffect $ FL.reduce sink
29432944 f1 <- fromEffect $ FL.snoc f x
29442945 many (sep >> p) f1
2946+-}
2947+
2948+-- | Like 'sepBy' but requires at least one successful parse.
2949+--
2950+-- Examples:
2951+--
2952+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2953+-- >>> p2 = Parser.satisfy (== '+')
2954+-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
2955+-- >>> Stream.parse p $ Stream.fromList ""
2956+-- Left (ParseError "takeWhile1: end of input")
2957+-- >>> Stream.parse p $ Stream.fromList "1"
2958+-- Right ["1"]
2959+-- >>> Stream.parse p $ Stream.fromList "1+"
2960+-- Right ["1"]
2961+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2962+-- Right ["1","2","3"]
2963+--
2964+{-# INLINE sepBy1 #-}
2965+sepBy1 :: Monad m =>
2966+ Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
2967+sepBy1
2968+ (Parser stepL initialL extractL)
2969+ (Parser stepR initialR _)
2970+ (Fold fstep finitial fextract) = Parser step initial extract
2971+
2972+ where
2973+
2974+ errMsg p status =
2975+ error $ "sepBy: " ++ p ++ " parser cannot "
2976+ ++ status ++ " without input"
2977+
2978+ initial = do
2979+ res <- finitial
2980+ case res of
2981+ FL.Partial fs -> do
2982+ pres <- initialL
2983+ case pres of
2984+ IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
2985+ IDone _ -> errMsg "left" "succeed"
2986+ IError _ -> errMsg "left" "fail"
2987+ FL.Done c -> return $ IDone c
2988+
2989+ {-# INLINE processL #-}
2990+ processL foldAction n nextState = do
2991+ fres <- foldAction
2992+ case fres of
2993+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
2994+ FL.Done c -> return $ Done n c
2995+
2996+ {-# INLINE runStepInitL #-}
2997+ runStepInitL cnt fs sL a = do
2998+ let cnt1 = cnt + 1
2999+ r <- stepL sL a
3000+ case r of
3001+ Partial n s -> return $ Continue n (SepBy1InitL cnt1 fs s)
3002+ Continue n s -> return $ Continue n (SepBy1InitL cnt1 fs s)
3003+ Done n b ->
3004+ processL (fstep fs b) n SepBy1InitR
3005+ Error err -> return $ Error err
3006+
3007+ {-# INLINE runStepL #-}
3008+ runStepL cnt fs sL a = do
3009+ let cnt1 = cnt + 1
3010+ r <- stepL sL a
3011+ case r of
3012+ Partial n s -> return $ Continue n (SepBy1L cnt1 fs s)
3013+ Continue n s -> return $ Continue n (SepBy1L cnt1 fs s)
3014+ Done n b ->
3015+ processL (fstep fs b) n SepBy1InitR
3016+ Error _ -> do
3017+ xs <- fextract fs
3018+ return $ Done cnt1 xs
3019+
3020+ {-# INLINE processR #-}
3021+ processR cnt fs n = do
3022+ res <- initialL
3023+ case res of
3024+ IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3025+ IDone _ -> errMsg "left" "succeed"
3026+ IError _ -> errMsg "left" "fail"
3027+
3028+ {-# INLINE runStepR #-}
3029+ runStepR cnt fs sR a = do
3030+ let cnt1 = cnt + 1
3031+ r <- stepR sR a
3032+ case r of
3033+ Partial n s -> return $ Continue n (SepBy1R cnt1 fs s)
3034+ Continue n s -> return $ Continue n (SepBy1R cnt1 fs s)
3035+ Done n _ -> processR cnt1 fs n
3036+ Error _ -> do
3037+ xs <- fextract fs
3038+ return $ Done cnt1 xs
3039+
3040+ step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3041+ step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3042+ step (SepBy1InitR fs) a = do
3043+ res <- initialR
3044+ case res of
3045+ IPartial s -> runStepR 0 fs s a
3046+ IDone _ -> errMsg "right" "succeed"
3047+ IError _ -> errMsg "right" "fail"
3048+ step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3049+
3050+ {-# INLINE extractResult #-}
3051+ extractResult n fs r = do
3052+ res <- fstep fs r
3053+ case res of
3054+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3055+ FL.Done c -> return (Done n c)
3056+
3057+ extract (SepBy1InitL cnt fs sL) = do
3058+ r <- extractL sL
3059+ case r of
3060+ Done n b -> extractResult n fs b
3061+ Continue n s -> return $ Continue n (SepBy1InitL cnt fs s)
3062+ Partial _ _ -> error "Partial in extract"
3063+ Error err -> return $ Error err
3064+ extract (SepBy1L cnt fs sL) = do
3065+ r <- extractL sL
3066+ case r of
3067+ Done n b -> extractResult n fs b
3068+ Continue n s -> return $ Continue n (SepBy1L cnt fs s)
3069+ Partial _ _ -> error "Partial in extract"
3070+ Error _ -> do
3071+ xs <- fextract fs
3072+ return $ Done cnt xs
3073+ extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs
3074+ extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs
29453075
29463076-------------------------------------------------------------------------------
29473077-- Interleaving a collection of parsers