Create a NonFailing parsers module

core/src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs

@@ -70,7 +70,7 @@ import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
 import qualified Streamly.Internal.Data.Array.Unboxed as Array
 import qualified Streamly.Internal.Data.Fold as Fold
 import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
-import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD
+import qualified Streamly.Internal.Data.Parser.ParserD.NonFailing as ParserD
 import qualified Streamly.Internal.Data.Parser as Parser
 
 import Prelude hiding (concatMap, take)

core/src/Streamly/Internal/Data/Parser/ParserD.hs

@@ -214,6 +214,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
 import Prelude hiding
        (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
        , zip, filter)
+import Streamly.Internal.Data.Parser.ParserD.NonFailing
 import Streamly.Internal.Data.Parser.ParserD.Tee
 import Streamly.Internal.Data.Parser.ParserD.Type
 
@@ -273,30 +274,7 @@ toFold (Parser pstep pinitial pextract) = Fold step initial pextract
 -------------------------------------------------------------------------------
 -- Upgrade folds to parses
 -------------------------------------------------------------------------------
---
--- | See 'Streamly.Internal.Data.Parser.fromFold'.
---
--- /Pre-release/
---
-{-# INLINE fromFold #-}
-fromFold :: Monad m => Fold m a b -> Parser m a b
-fromFold (Fold fstep finitial fextract) = Parser step initial fextract
-
-    where
-
-    initial = do
-        res <- finitial
-        return
-            $ case res of
-                  FL.Partial s1 -> IPartial s1
-                  FL.Done b -> IDone b
-
-    step s a = do
-        res <- fstep s a
-        return
-            $ case res of
-                  FL.Partial s1 -> Partial 0 s1
-                  FL.Done b -> Done 0 b
+-- XXX fromMaybeFold
 
 -- | Convert Maybe returning folds to error returning parsers.
 --
@@ -368,18 +346,6 @@ eof = Parser step initial return
 
     step () _ = return $ Error "eof: not at end of input"
 
--- | See 'Streamly.Internal.Data.Parser.next'.
---
--- /Pre-release/
---
-{-# INLINE next #-}
-next :: Monad m => Parser m a (Maybe a)
-next = Parser step initial extract
-  where
-  initial = pure $ IPartial ()
-  step _ a = pure $ Done 0 (Just a)
-  extract _ = pure Nothing
-
 -- | See 'Streamly.Internal.Data.Parser.either'.
 --
 -- /Pre-release/
@@ -653,33 +619,6 @@ takeWhileP predicate (Parser pstep pinitial pextract) =
         then pstep s a
         else Done 1 <$> pextract s
 
--- | See 'Streamly.Internal.Data.Parser.takeWhile'.
---
--- /Pre-release/
---
-{-# INLINE takeWhile #-}
-takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
-takeWhile predicate (Fold fstep finitial fextract) =
-    Parser step initial fextract
-
-    where
-
-    initial = do
-        res <- finitial
-        return $ case res of
-            FL.Partial s -> IPartial s
-            FL.Done b -> IDone b
-
-    step s a =
-        if predicate a
-        then do
-            fres <- fstep s a
-            return
-                $ case fres of
-                      FL.Partial s1 -> Partial 0 s1
-                      FL.Done b -> Done 0 b
-        else Done 1 <$> fextract s
-
 -- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
 --
 -- /Pre-release/
@@ -1036,52 +975,6 @@ takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =
 -- Grouping and words
 -------------------------------------------------------------------------------
 
-data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
-
--- | See 'Streamly.Internal.Data.Parser.wordBy'.
---
---
-{-# INLINE wordBy #-}
-wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
-wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract
-
-    where
-
-    {-# INLINE worder #-}
-    worder s a = do
-        res <- fstep s a
-        return
-            $ case res of
-                  FL.Partial s1 -> Partial 0 $ WBWord s1
-                  FL.Done b -> Done 0 b
-
-    initial = do
-        res <- finitial
-        return
-            $ case res of
-                  FL.Partial s -> IPartial $ WBLeft s
-                  FL.Done b -> IDone b
-
-    step (WBLeft s) a =
-        if not (predicate a)
-        then worder s a
-        else return $ Partial 0 $ WBLeft s
-    step (WBWord s) a =
-        if not (predicate a)
-        then worder s a
-        else do
-            b <- fextract s
-            return $ Partial 0 $ WBRight b
-    step (WBRight b) a =
-        return
-            $ if not (predicate a)
-              then Done 1 b
-              else Partial 0 $ WBRight b
-
-    extract (WBLeft s) = fextract s
-    extract (WBWord s) = fextract s
-    extract (WBRight b) = return b
-
 data WordFramedState s b =
       WordFramedSkipPre !s
     | WordFramedWord !s !Int
@@ -1282,163 +1175,6 @@ wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
         err "wordQuotedBy: trailing escape"
     extract (WordQuotedSkipPost b) = return b
 
-{-# ANN type GroupByState Fuse #-}
-data GroupByState a s
-    = GroupByInit !s
-    | GroupByGrouping !a !s
-
--- | See 'Streamly.Internal.Data.Parser.groupBy'.
---
-{-# INLINE groupBy #-}
-groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
-groupBy eq (Fold fstep finitial fextract) = Parser step initial extract
-
-    where
-
-    {-# INLINE grouper #-}
-    grouper s a0 a = do
-        res <- fstep s a
-        return
-            $ case res of
-                  FL.Done b -> Done 0 b
-                  FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)
-
-    initial = do
-        res <- finitial
-        return
-            $ case res of
-                  FL.Partial s -> IPartial $ GroupByInit s
-                  FL.Done b -> IDone b
-
-    step (GroupByInit s) a = grouper s a a
-    step (GroupByGrouping a0 s) a =
-        if eq a0 a
-        then grouper s a0 a
-        else Done 1 <$> fextract s
-
-    extract (GroupByInit s) = fextract s
-    extract (GroupByGrouping _ s) = fextract s
-
--- | See 'Streamly.Internal.Data.Parser.groupByRolling'.
---
-{-# INLINE groupByRolling #-}
-groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
-groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract
-
-    where
-
-    {-# INLINE grouper #-}
-    grouper s a = do
-        res <- fstep s a
-        return
-            $ case res of
-                  FL.Done b -> Done 0 b
-                  FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)
-
-    initial = do
-        res <- finitial
-        return
-            $ case res of
-                  FL.Partial s -> IPartial $ GroupByInit s
-                  FL.Done b -> IDone b
-
-    step (GroupByInit s) a = grouper s a
-    step (GroupByGrouping a0 s) a =
-        if eq a0 a
-        then grouper s a
-        else Done 1 <$> fextract s
-
-    extract (GroupByInit s) = fextract s
-    extract (GroupByGrouping _ s) = fextract s
-
-{-# ANN type GroupByStatePair Fuse #-}
-data GroupByStatePair a s1 s2
-    = GroupByInitPair !s1 !s2
-    | GroupByGroupingPair !a !s1 !s2
-    | GroupByGroupingPairL !a !s1 !s2
-    | GroupByGroupingPairR !a !s1 !s2
-
-{-# INLINE groupByRollingEither #-}
-groupByRollingEither :: MonadCatch m =>
-    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)
-groupByRollingEither
-    eq
-    (Fold fstep1 finitial1 fextract1)
-    (Fold fstep2 finitial2 fextract2) = Parser step initial extract
-
-    where
-
-    {-# INLINE grouper #-}
-    grouper s1 s2 a = do
-        return $ Continue 0 (GroupByGroupingPair a s1 s2)
-
-    {-# INLINE grouperL2 #-}
-    grouperL2 s1 s2 a = do
-        res <- fstep1 s1 a
-        return
-            $ case res of
-                FL.Done b -> Done 0 (Left b)
-                FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)
-
-    {-# INLINE grouperL #-}
-    grouperL s1 s2 a0 a = do
-        res <- fstep1 s1 a0
-        case res of
-            FL.Done b -> return $ Done 0 (Left b)
-            FL.Partial s11 -> grouperL2 s11 s2 a
-
-    {-# INLINE grouperR2 #-}
-    grouperR2 s1 s2 a = do
-        res <- fstep2 s2 a
-        return
-            $ case res of
-                FL.Done b -> Done 0 (Right b)
-                FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)
-
-    {-# INLINE grouperR #-}
-    grouperR s1 s2 a0 a = do
-        res <- fstep2 s2 a0
-        case res of
-            FL.Done b -> return $ Done 0 (Right b)
-            FL.Partial s21 -> grouperR2 s1 s21 a
-
-    initial = do
-        res1 <- finitial1
-        res2 <- finitial2
-        return
-            $ case res1 of
-                FL.Partial s1 ->
-                    case res2 of
-                        FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2
-                        FL.Done b -> IDone (Right b)
-                FL.Done b -> IDone (Left b)
-
-    step (GroupByInitPair s1 s2) a = grouper s1 s2 a
-
-    step (GroupByGroupingPair a0 s1 s2) a =
-        if not (eq a0 a)
-        then grouperL s1 s2 a0 a
-        else grouperR s1 s2 a0 a
-
-    step (GroupByGroupingPairL a0 s1 s2) a =
-        if not (eq a0 a)
-        then grouperL2 s1 s2 a
-        else Done 1 . Left <$> fextract1 s1
-
-    step (GroupByGroupingPairR a0 s1 s2) a =
-        if eq a0 a
-        then grouperR2 s1 s2 a
-        else Done 1 . Right <$> fextract2 s2
-
-    extract (GroupByInitPair s1 _) = Left <$> fextract1 s1
-    extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1
-    extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2
-    extract (GroupByGroupingPair a s1 _) = do
-                res <- fstep1 s1 a
-                case res of
-                    FL.Done b -> return $ Left b
-                    FL.Partial s11 -> Left <$> fextract1 s11
-
 -- XXX use an Unfold instead of a list?
 -- XXX custom combinators for matching list, array and stream?
 -- XXX rename to listBy?
@@ -1533,6 +1269,8 @@ postscan :: -- Monad m =>
     Fold m a b -> Parser m b c -> Parser m a c
 postscan = undefined
 
+-- XXX More variants of this are possible based on how do we end the fold, when
+-- the stream ends, when the fold ends, or when any ends.
 {-# INLINE zipWithM #-}
 zipWithM :: MonadThrow m =>
     (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser m b x
@@ -1630,56 +1368,6 @@ sampleFromthen :: MonadThrow m => Int -> Int -> Fold m a b -> Parser m a b
 sampleFromthen offset size =
     makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)
 
---------------------------------------------------------------------------------
---- Spanning
---------------------------------------------------------------------------------
-
--- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
--- input as long as the predicate @p@ is 'True'.  @f2@ consumes the rest of the
--- input.
---
--- @
--- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
---
--- > span_ (< 1) [1,2,3]
--- ([],[1,2,3])
---
--- > span_ (< 2) [1,2,3]
--- ([1],[2,3])
---
--- > span_ (< 4) [1,2,3]
--- ([1,2,3],[])
---
--- @
---
--- /Pre-release/
-{-# INLINE span #-}
-span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
-span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)
-
--- | Break the input stream into two groups, the first group takes the input as
--- long as the predicate applied to the first element of the stream and next
--- input element holds 'True', the second group takes the rest of the input.
---
--- /Pre-release/
---
-{-# INLINE spanBy #-}
-spanBy ::
-       Monad m
-    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
-spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)
-
--- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
--- predicate is applied to the previous and the next input elements.
---
--- /Pre-release/
-{-# INLINE spanByRolling #-}
-spanByRolling ::
-       Monad m
-    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
-spanByRolling eq f1 f2 =
-    noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)
-
 -------------------------------------------------------------------------------
 -- nested parsers
 -------------------------------------------------------------------------------