Add withCatch.

fused-effects-exceptions.cabal

@@ -1,5 +1,5 @@
 name:                fused-effects-exceptions
-version:             0.1.0.0
+version:             0.1.1.0
 synopsis:            Handle exceptions thrown in IO with fused-effects.
 description:         Provides an effect that enables catching exceptions thrown from impure computations such as 'IO'.
 homepage:            https://github.com/patrickt/fused-effects-exceptions#readme
@@ -13,6 +13,8 @@ build-type:          Simple
 cabal-version:       >=1.10
 extra-source-files:  README.md
 
+tested-with:         GHC == 8.6.4
+
 library
   hs-source-dirs:      src
   default-language:    Haskell2010
@@ -20,3 +22,8 @@ library
   build-depends:       base >= 4.7 && < 5
                      , fused-effects >= 0.3 && <1
                      , safe-exceptions >= 0.1 && <1
+                     , unliftio-core >= 0.1.2 && <1
+
+source-repository head
+  type:     git
+  location: https://github.com/fused-effects/fused-effects-exceptions

src/Control/Effect/Catch.hs

@@ -4,7 +4,7 @@
 -- | An effect that enables catching exceptions thrown from
 -- impure computations such as 'IO'.
 --
--- Use of the 'Error' effect from 'Control.Effect.Error' may lead to
+-- Use of the 'Control.Effect.Error' effect from @Control.Effect.Error@ may lead to
 -- simpler code, as well as avoiding the dynamically-typed nature of
 -- 'Control.Exception'. This is best used when integrating with third-party
 -- libraries that operate in 'IO'. If you are using 'catch' for resource
@@ -23,6 +23,7 @@ import           Control.Effect.Sum
 import qualified Control.Exception as Exc
 import           Control.Exception.Safe (isSyncException)
 import           Control.Monad.IO.Class
+import           Control.Monad.IO.Unlift
 
 data Catch m k
   = forall output e . Exc.Exception e => CatchIO (m output) (e -> m output) (output -> k)
@@ -39,7 +40,7 @@ instance Effect Catch where
 -- | Like 'Control.Effect.Error.catchError', but delegating to
 -- 'Control.Exception.catch' under the hood, which allows catching
 -- errors that might occur when lifting 'IO' computations.
--- Unhandled errors are rethrown. Use 'SomeException' if you want
+-- Unhandled errors are rethrown. Use 'Exc.SomeException' if you want
 -- to catch all errors.
 catch :: (Member Catch sig, Carrier sig m, Exc.Exception e)
       => m a
@@ -60,12 +61,17 @@ catchSync f g = f `catch` \e ->
       -- since we want to preserve async behavior
       else liftIO (Exc.throw e)
 
--- | Evaulate a 'Catch' effect.
+-- | Evaluate a 'Catch' effect.
 runCatch :: (forall x . m x -> IO x)
          -> CatchC m a
          -> m a
 runCatch handler = runReader (Handler handler) . runCatchC
 
+-- | Evaluate a 'Catch' effect, using 'MonadUnliftIO' to infer a correct
+-- unlifting function.
+withCatch :: MonadUnliftIO m => CatchC m a -> m a
+withCatch c = withRunInIO (\f -> runHandler (Handler f) c)
+
 newtype Handler m = Handler (forall x . m x -> IO x)
 
 runHandler :: Handler m -> CatchC m a -> IO a
@@ -74,6 +80,10 @@ runHandler h@(Handler handler) = handler . runReader h . runCatchC
 newtype CatchC m a = CatchC { runCatchC :: ReaderC (Handler m) m a }
   deriving (Functor, Applicative, Monad, MonadIO)
 
+instance MonadUnliftIO m => MonadUnliftIO (CatchC m) where
+  askUnliftIO = CatchC . ReaderC $ \(Handler h) ->
+    withUnliftIO $ \u -> pure (UnliftIO $ \r -> unliftIO u (runCatch h r))
+
 instance (Carrier sig m, MonadIO m) => Carrier (Catch :+: sig) (CatchC m) where
   eff (L (CatchIO act cleanup k)) = do
     handler <- CatchC ask