Skip to content

Commit

Permalink
define MonadThrow and MonadCatch instances for Stream
Browse files Browse the repository at this point in the history
These are equivalent to the code in the existing MonadError instance.
  • Loading branch information
mauke committed Jul 4, 2023
1 parent 608c4cf commit 357749b
Show file tree
Hide file tree
Showing 2 changed files with 15 additions and 0 deletions.
14 changes: 14 additions & 0 deletions src/Streaming/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 #-}
Expand Down
1 change: 1 addition & 0 deletions streaming.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -212,6 +212,7 @@ library
, transformers-base < 0.5
, ghc-prim
, containers
, exceptions >=0.6

if !impl(ghc >= 8.0)
build-depends:
Expand Down

0 comments on commit 357749b

Please sign in to comment.