From 357749b8692455d797022b4f99d907f36fdcfa86 Mon Sep 17 00:00:00 2001
From: mauke <lukasmai.403@gmail.com>
Date: Wed, 28 Jun 2023 10:31:46 +0200
Subject: [PATCH 1/2] define MonadThrow and MonadCatch instances for Stream

These are equivalent to the code in the existing MonadError instance.
---
 src/Streaming/Internal.hs | 14 ++++++++++++++
 streaming.cabal           |  1 +
 2 files changed, 15 insertions(+)

diff --git a/src/Streaming/Internal.hs b/src/Streaming/Internal.hs
index d62325c..fad4e81 100644
--- a/src/Streaming/Internal.hs
+++ b/src/Streaming/Internal.hs
@@ -86,6 +86,7 @@ module Streaming.Internal (
 import Control.Applicative
 import Control.Concurrent (threadDelay)
 import Control.Monad
+import Control.Monad.Catch (MonadThrow (..), MonadCatch (..))
 import Control.Monad.Error.Class
 import Control.Monad.Fail as Fail
 import Control.Monad.Morph
@@ -381,6 +382,19 @@ instance (Functor f, MonadState s m) => MonadState s (Stream f m) where
   {-# INLINE state #-}
 #endif
 
+instance (Functor f, MonadThrow m) => MonadThrow (Stream f m) where
+  throwM = lift . throwM
+  {-# INLINE throwM #-}
+
+instance (Functor f, MonadCatch m) => MonadCatch (Stream f m) where
+  catch str f = loop str
+    where
+    loop x = case x of
+      Return r -> Return r
+      Effect m -> Effect $ fmap loop m `catch` (return . f)
+      Step   g -> Step (fmap loop g)
+  {-# INLINABLE catch #-}
+
 instance (Functor f, MonadError e m) => MonadError e (Stream f m) where
   throwError = lift . throwError
   {-# INLINE throwError #-}
diff --git a/streaming.cabal b/streaming.cabal
index 085fbf5..efcb9cb 100644
--- a/streaming.cabal
+++ b/streaming.cabal
@@ -212,6 +212,7 @@ library
     , transformers-base < 0.5
     , ghc-prim
     , containers
+    , exceptions >=0.6
 
   if !impl(ghc >= 8.0)
     build-depends:

From 26b117e213a20ba41228052142905e958725b132 Mon Sep 17 00:00:00 2001
From: mauke <lukasmai.403@gmail.com>
Date: Wed, 19 Jul 2023 09:01:56 +0200
Subject: [PATCH 2/2] add some documentation to MonadThrow/MonadCatch instances

---
 src/Streaming/Internal.hs | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

diff --git a/src/Streaming/Internal.hs b/src/Streaming/Internal.hs
index fad4e81..0fb4a8a 100644
--- a/src/Streaming/Internal.hs
+++ b/src/Streaming/Internal.hs
@@ -382,10 +382,40 @@ instance (Functor f, MonadState s m) => MonadState s (Stream f m) where
   {-# INLINE state #-}
 #endif
 
+-- | The 'throwM' method can be used to throw an exception in the underlying
+-- @m@ monad. That is, @throwM e@ in a 'Stream' simply lifts the
+-- @throwM@ method from the @MonadThrow m@ instance into the stream.
+--
+-- @
+-- throwM = 'lift' . 'throwM'
+-- @
 instance (Functor f, MonadThrow m) => MonadThrow (Stream f m) where
   throwM = lift . throwM
   {-# INLINE throwM #-}
 
+-- | Normally, an exception thrown from an action embedded in a stream aborts
+-- the whole stream. The 'catch' method lets you handle such exceptions by
+-- returning an alternative continuation of the stream instead.
+--
+-- For example, the 'Control.Monad.Catch.try' function, which is defined as
+--
+-- > try x = catch (fmap Right x) (pure . Left)
+--
+-- can be interpreted as follows when applied to a 'Stream': @try stream@
+-- either returns @stream@ (with the stream result wrapped in 'Right') if no
+-- exception occurs, or otherwise returns the exception-free prefix of @stream@
+-- (i.e. all the elements that could be produced without throwing an exception)
+-- followed by a stream result containing the exception (wrapped in 'Left').
+--
+-- Similarly,
+--
+-- > catch (S.map Right stream) (S.yield . Left)
+-- >   :: MonadCatch m =>
+-- >      Stream (Of a) m () -> Stream (Of (Either SomeException a)) m ()
+--
+-- is a stream that yields all the elements of @stream@ wrapped in 'Right',
+-- followed by one (optional) 'Left' element containing the
+-- 'Control.Monad.Catch.SomeException' that was thrown, if any.
 instance (Functor f, MonadCatch m) => MonadCatch (Stream f m) where
   catch str f = loop str
     where