Add `UnliftIO` support, passing through stylish-haskell.

fused-effects-exceptions.cabal

@@ -1,7 +1,7 @@
 cabal-version:       2.4
 
 name:                fused-effects-exceptions
-version:             1.1.0.1
+version:             1.1.0.2
 synopsis:            Handle exceptions thrown in IO with fused-effects.
 description:         Provides Resource and Catch effects capable of reacting to and catching GHC's dynamic exceptions.
 homepage:            https://github.com/fused-effects/fused-effects-exceptions#readme
@@ -33,10 +33,14 @@ library
   exposed-modules:
     Control.Carrier.State.IORef
     Control.Effect.Exception
+    Control.Effect.Exception.UnliftIO
+  other-modules:
+    Control.Effect.Exception.Internal
   build-depends:
       base             >= 4.7 && < 5
     , fused-effects    >= 1.1
     , transformers     >= 0.4 && < 0.6
+    , unliftio-core    >= 0.2 && < 0.3
 
 test-suite test
   import: common

src/Control/Effect/Exception.hs

@@ -1,5 +1,9 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, RankNTypes, StandaloneDeriving #-}
+{-# LANGUAGE DeriveFunctor #-}
--- | Operations from "Control.Exception" lifted into effectful contexts using 'Control.Effect.Lift.Lift'.
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+-- | Operations from "Control.Exception" and "UnliftIO.Exception" lifted into effectful contexts using 'Control.Effect.Lift.Lift'.
 --
 -- @since 1.0.0.0
 module Control.Effect.Exception
@@ -9,7 +13,7 @@ module Control.Effect.Exception
 , throwTo
 , catch
 , catches
-, Handler(..)
+, U.Handler(..)
 , catchJust
 , handle
 , handleJust
@@ -39,77 +43,69 @@ module Control.Effect.Exception
 , run
 ) where
 
-import Control.Concurrent (ThreadId)
+import           Control.Concurrent (ThreadId)
-import Control.Effect.Lift
+import qualified Control.Effect.Exception.UnliftIO as U
-import Control.Exception hiding
+import           Control.Effect.Lift
-  ( throwIO
+import           Control.Exception hiding
-  , ioError
+  ( Handler
-  , throwTo
-  , catch
-  , catches
-  , Handler
-  , catchJust
-  , handle
-  , handleJust
-  , try
-  , tryJust
-  , evaluate
-  , mask
-  , mask_
-  , uninterruptibleMask
-  , uninterruptibleMask_
-  , getMaskingState
-  , interruptible
   , allowInterrupt
   , bracket
-  , bracket_
   , bracketOnError
+  , bracket_
+  , catch
+  , catchJust
+  , catches
+  , evaluate
   , finally
+  , getMaskingState
+  , handle
+  , handleJust
+  , interruptible
+  , ioError
+  , mask
+  , mask_
   , onException
+  , throwIO
+  , throwTo
+  , try
+  , tryJust
+  , uninterruptibleMask
+  , uninterruptibleMask_
   )
 import qualified Control.Exception as Exc
-import Prelude hiding (ioError)
+import           Prelude hiding (ioError)
 
--- | See @"Control.Exception".'Exc.throwIO'@.
+-- | See @"Unlift.Exception".throwIO@.
 --
 -- @since 1.0.0.0
 throwIO :: (Exc.Exception e, Has (Lift IO) sig m) => e -> m a
-throwIO = sendM . Exc.throwIO
+throwIO = U.throwIO @IO
 
 -- | See @"Control.Exception".'Exc.ioError'@.
 --
 -- @since 1.0.0.0
 ioError :: Has (Lift IO) sig m => IOError -> m a
-ioError = sendM . Exc.ioError
+ioError = U.ioError @IO
 
 -- | See @"Control.Exception".'Exc.throwTo'@.
 --
 -- @since 1.0.0.0
 throwTo :: (Exc.Exception e, Has (Lift IO) sig m) => ThreadId -> e -> m ()
-throwTo thread = sendM . Exc.throwTo thread
+throwTo = U.throwTo @IO
 
--- | See @"Control.Exception".'Exc.catch'@.
+-- | See @"UnliftIO.Exception".catch@.
 --
 -- @since 1.0.0.0
 catch :: (Exc.Exception e, Has (Lift IO) sig m) => m a -> (e -> m a) -> m a
-catch m h = liftWith $ \ run ctx -> run (m <$ ctx) `Exc.catch` (run . (<$ ctx) . h)
+catch = U.catch @IO
 
--- | See @"Control.Exception".'Exc.catches'@.
+-- | See @"UnliftIO.Exception".catches@.
 --
 -- @since 1.0.0.0
-catches :: Has (Lift IO) sig m => m a -> [Handler m a] -> m a
+catches :: Has (Lift IO) sig m => m a -> [U.Handler m a] -> m a
-catches m hs = liftWith $ \ run ctx ->
+catches = U.catches @IO
-  Exc.catches (run (m <$ ctx)) (map (\ (Handler h) -> Exc.Handler (run . (<$ ctx) . h)) hs)
 
--- | See @"Control.Exception".'Exc.Handler'@.
+-- | See @"UnliftIO.Exception".catchJust@.
---
--- @since 1.0.0.0
-data Handler m a
-  = forall e . Exc.Exception e => Handler (e -> m a)
-
-deriving instance Functor m => Functor (Handler m)
-
--- | See @"Control.Exception".'Exc.catchJust'@.
 --
 -- @since 1.0.0.0
 catchJust
@@ -118,13 +114,13 @@ catchJust
   -> m a
   -> (b -> m a)
   -> m a
-catchJust p m h = liftWith $ \ run ctx -> Exc.catchJust p (run (m <$ ctx)) (run . (<$ ctx) . h)
+catchJust = U.catchJust @IO
 
 -- | See @"Control.Exception".'Exc.handle'@.
 --
 -- @since 1.0.0.0
 handle :: (Exc.Exception e, Has (Lift IO) sig m) => (e -> m a) -> m a -> m a
-handle = flip catch
+handle = U.handle @IO
 
 -- | See @"Control.Exception".'Exc.handleJust'@.
 --
@@ -135,69 +131,67 @@ handleJust
   -> (b -> m a)
   -> m a
   -> m a
-handleJust p = flip (catchJust p)
+handleJust = U.handleJust @IO
 
 -- | See @"Control.Exception".'Exc.try'@.
 --
 -- @since 1.0.0.0
 try :: (Exc.Exception e, Has (Lift IO) sig m) => m a -> m (Either e a)
-try m = (Right <$> m) `catch` (pure . Left)
+try = U.try @IO
 
 -- | See @"Control.Exception".'Exc.tryJust'@.
 --
 -- @since 1.0.0.0
 tryJust :: (Exc.Exception e, Has (Lift IO) sig m) => (e -> Maybe b) -> m a -> m (Either b a)
-tryJust p m = catchJust p (Right <$> m) (pure . Left)
+tryJust = U.tryJust @IO
 
--- | See @"Control.Exception".'Exc.evaluate'@.
+-- | See @"UnliftIO.Exception".evaluate@.
 --
 -- @since 1.0.0.0
 evaluate :: Has (Lift IO) sig m => a -> m a
-evaluate = sendM . Exc.evaluate
+evaluate = U.evaluate @IO
 
--- | See @"Control.Exception".'Exc.mask'@.
+-- | See @"UnliftIO.Exception".mask@.
 --
 -- @since 1.0.0.0
 mask :: Has (Lift IO) sig m => ((forall a . m a -> m a) -> m b) -> m b
-mask with = liftWith $ \ run ctx -> Exc.mask $ \ restore ->
+mask = U.mask @IO
-  run (with (\ m -> liftWith $ \ run' ctx' -> restore (run' (m <$ ctx'))) <$ ctx)
 
 -- | See @"Control.Exception".'Exc.mask_'@.
 --
 -- @since 1.0.0.0
 mask_ :: Has (Lift IO) sig m => m a -> m a
-mask_ m = mask (\_ -> m)
+mask_ = U.mask_ @IO
 
--- | See @"Control.Exception".'Exc.uninterruptibleMask'@.
+-- | See @"UnliftIO.Exception".uninterruptibleMask@.
 --
 -- @since 1.0.0.0
 uninterruptibleMask :: Has (Lift IO) sig m => ((forall a . m a -> m a) -> m b) -> m b
-uninterruptibleMask with = liftWith $ \ run ctx -> Exc.uninterruptibleMask $ \ restore ->
+uninterruptibleMask = U.uninterruptibleMask @IO
-  run (with (\ m -> liftWith $ \ run' ctx' -> restore (run' (m <$ ctx'))) <$ ctx)
 
 -- | See @"Control.Exception".'Exc.uninterruptibleMask_'@.
 --
 -- @since 1.0.0.0
 uninterruptibleMask_ :: Has (Lift IO) sig m => m a -> m a
-uninterruptibleMask_ m = uninterruptibleMask (\_ -> m)
+uninterruptibleMask_ = U.uninterruptibleMask_ @IO
 
 -- | See @"Control.Exception".'Exc.getMaskingState'@.
 --
 -- @since 1.0.0.0
 getMaskingState :: Has (Lift IO) sig m => m Exc.MaskingState
-getMaskingState = sendM Exc.getMaskingState
+getMaskingState = U.getMaskingState @IO
 
 -- | See @"Control.Exception".'Exc.interruptible'@.
 --
 -- @since 1.0.0.0
 interruptible :: Has (Lift IO) sig m => m a -> m a
-interruptible m = liftWith $ \ run ctx -> Exc.interruptible (run (m <$ ctx))
+interruptible = U.interruptible @IO
 
 -- | See @"Control.Exception".'Exc.allowInterrupt'@.
 --
 -- @since 1.0.0.0
 allowInterrupt :: Has (Lift IO) sig m => m ()
-allowInterrupt = sendM Exc.allowInterrupt
+allowInterrupt = U.allowInterrupt @IO
 
 -- | See @"Control.Exception".'Exc.bracket'@.
 --
@@ -208,10 +202,7 @@ bracket
   -> (a -> m b)
   -> (a -> m c)
   -> m c
-bracket acquire release m = mask $ \ restore -> do
+bracket = U.bracket @IO
-  a <- acquire
-  r <- restore (m a) `onException` release a
-  r <$ release a
 
 -- | See @"Control.Exception".'Exc.bracket_'@.
 --
@@ -222,7 +213,7 @@ bracket_
   -> m b
   -> m c
   -> m c
-bracket_ before after thing = bracket before (const after) (const thing)
+bracket_ = U.bracket_ @IO
 
 -- | See @"Control.Exception".'Exc.bracketOnError'@.
 --
@@ -233,9 +224,7 @@ bracketOnError
   -> (a -> m b)
   -> (a -> m c)
   -> m c
-bracketOnError acquire release m = mask $ \ restore -> do
+bracketOnError = U.bracketOnError @IO
-  a <- acquire
-  restore (m a) `onException` release a
 
 -- | See @"Control.Exception".'Exc.finally'@.
 --
@@ -245,10 +234,10 @@ finally
   => m a
   -> m b
   -> m a
-finally m sequel = mask $ \ restore -> (restore m `onException` sequel) <* sequel
+finally = U.finally @IO
 
 -- | See @"Control.Exception".'Exc.onException'@.
 --
 -- @since 1.0.0.0
 onException :: Has (Lift IO) sig m => m a -> m b -> m a
-onException io what = io `catch` \e -> what >> throwIO (e :: Exc.SomeException)
+onException = U.onException @IO

src/Control/Effect/Exception/Internal.hs

@@ -0,0 +1,132 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+
+-- | Operations from "UnliftIO.Exception" lifted into effectful contexts using 'Control.Effect.Lift.Lift'.
+--
+-- These methods are shamelessly copied from the @unliftio@ module in an effort to keep dependencies small.
+-- @unliftio-core@ is assumed fair game though considering it's included in core @fused-effects@ package.
+--
+-- @since <version>
+module Control.Effect.Exception.Internal
+( -- * Throwing
+  throwIO
+  -- * Catching (with recovery)
+, catch
+, catchJust
+, Handler (..)
+, catches
+  -- * Evaluation
+, evaluate
+  -- * Masking
+, mask
+, uninterruptibleMask
+  -- * Reexports
+, Exception (..)
+, Typeable
+, SomeException (..)
+, SomeAsyncException (..)
+, IOException
+) where
+
+import           Control.Exception (Exception(..), IOException, SomeAsyncException(..), SomeException(..))
+import qualified Control.Exception as EUnsafe
+import           Control.Monad.IO.Unlift
+import           Data.Typeable (Typeable, cast)
+
+-- | Catch a synchronous (but not asynchronous) exception and recover from it.
+--
+-- This is parameterized on the exception type. To catch all synchronous exceptions,
+-- use 'catchAny'.
+catch
+  :: (MonadUnliftIO m, Exception e)
+  => m a -- ^ action
+  -> (e -> m a) -- ^ handler
+  -> m a
+catch f g = withRunInIO $ \run -> run f `EUnsafe.catch` \e ->
+  if isSyncException e
+    then run (g e)
+    -- intentionally rethrowing an async exception synchronously,
+    -- since we want to preserve async behavior
+    else EUnsafe.throwIO e
+
+-- | 'catchJust' is like 'catch' but it takes an extra argument which
+-- is an exception predicate, a function which selects which type of
+-- exceptions we're interested in.
+catchJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a
+catchJust f a b = a `catch` \e -> maybe (liftIO (throwIO e)) b $ f e
+
+-- | A helper data type for usage with 'catches' and similar functions.
+data Handler m a = forall e . Exception e => Handler (e -> m a)
+
+-- | Internal.
+catchesHandler :: MonadIO m => [Handler m a] -> SomeException -> m a
+catchesHandler handlers e = foldr tryHandler (liftIO (EUnsafe.throwIO e)) handlers
+    where tryHandler (Handler handler) res
+              = case fromException e of
+                Just e' -> handler e'
+                Nothing -> res
+
+-- | Similar to 'catch', but provides multiple different handler functions.
+--
+-- For more information on motivation, see @base@'s 'EUnsafe.catches'. Note that,
+-- unlike that function, this function will not catch asynchronous exceptions.
+catches :: MonadUnliftIO m => m a -> [Handler m a] -> m a
+catches io handlers = io `catch` catchesHandler handlers
+
+-- | Lifted version of 'EUnsafe.evaluate'.
+evaluate :: MonadIO m => a -> m a
+evaluate = liftIO . EUnsafe.evaluate
+
+-- | Synchronously throw the given exception.
+--
+-- Note that, if you provide an exception value which is of an asynchronous
+-- type, it will be wrapped up in 'SyncExceptionWrapper'. See 'toSyncException'.
+throwIO :: (MonadIO m, Exception e) => e -> m a
+throwIO = liftIO . EUnsafe.throwIO . toSyncException
+
+-- | Wrap up an asynchronous exception to be treated as a synchronous
+-- exception.
+--
+-- This is intended to be created via 'toSyncException'.
+data SyncExceptionWrapper = forall e. Exception e => SyncExceptionWrapper e
+    deriving Typeable
+
+instance Show SyncExceptionWrapper where
+    show (SyncExceptionWrapper e) = show e
+
+instance Exception SyncExceptionWrapper where
+#if MIN_VERSION_base(4,8,0)
+    displayException (SyncExceptionWrapper e) = displayException e
+#endif
+
+-- | Convert an exception into a synchronous exception.
+--
+-- For synchronous exceptions, this is the same as 'toException'.
+-- For asynchronous exceptions, this will wrap up the exception with
+-- 'SyncExceptionWrapper'.
+toSyncException :: Exception e => e -> SomeException
+toSyncException e =
+    case fromException se of
+        Just (SomeAsyncException _) -> toException (SyncExceptionWrapper e)
+        Nothing                     -> se
+  where
+    se = toException e
+
+-- | Check if the given exception is synchronous.
+isSyncException :: Exception e => e -> Bool
+isSyncException e =
+    case fromException (toException e) of
+        Just (SomeAsyncException _) -> False
+        Nothing                     -> True
+
+-- | Unlifted version of 'EUnsafe.mask'.
+mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b
+mask f = withRunInIO $ \run -> EUnsafe.mask $ \unmask ->
+  run $ f $ liftIO . unmask . run
+
+-- | Unlifted version of 'EUnsafe.uninterruptibleMask'.
+uninterruptibleMask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b
+uninterruptibleMask f = withRunInIO $ \run -> EUnsafe.uninterruptibleMask $ \unmask ->
+  run $ f $ liftIO . unmask . run

src/Control/Effect/Exception/UnliftIO.hs

@@ -0,0 +1,345 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+-- | Operations from "Control.Exception" and "UnliftIO.Exception" lifted into effectful contexts using 'Control.Effect.Lift.Lift'.
+--
+-- @since 1.1.0.2
+module Control.Effect.Exception.UnliftIO
+( -- * Lifted "Control.Exception" operations
+  throwIO
+, ioError
+, throwTo
+, catch
+, catches
+, Handler(..)
+, catchJust
+, handle
+, handleJust
+, try
+, tryJust
+, evaluate
+, mask
+, mask_
+, uninterruptibleMask
+, uninterruptibleMask_
+, getMaskingState
+, interruptible
+, allowInterrupt
+, bracket
+, bracket_
+, bracketOnError
+, finally
+, onException
+, module Control.Exception
+  -- * Lift effect
+, Lift(..)
+, sendM
+, liftWith
+  -- * Re-exports
+, Algebra
+, Has
+, run
+) where
+
+import           Control.Concurrent (ThreadId)
+import qualified Control.Effect.Exception.Internal as Exc
+import           Control.Effect.Lift
+import           Control.Exception hiding
+  ( Handler
+  , allowInterrupt
+  , bracket
+  , bracketOnError
+  , bracket_
+  , catch
+  , catchJust
+  , catches
+  , evaluate
+  , finally
+  , getMaskingState
+  , handle
+  , handleJust
+  , interruptible
+  , ioError
+  , mask
+  , mask_
+  , onException
+  , throwIO
+  , throwTo
+  , try
+  , tryJust
+  , uninterruptibleMask
+  , uninterruptibleMask_
+  )
+import qualified Control.Exception as EUnsafe
+import           Control.Monad.IO.Unlift (MonadIO, MonadUnliftIO, liftIO, withRunInIO)
+import           Prelude hiding (ioError)
+
+-- | See @"Unlift.Exception".throwIO@.
+--
+-- @since 1.1.0.2
+throwIO
+  :: forall n e sig m a
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => e
+  -> m a
+throwIO = sendM @n . Exc.throwIO
+
+-- | See @"Control.Exception".'Exc.ioError'@.
+--
+-- @since 1.1.0.2
+ioError
+  :: forall n sig m a
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => IOError
+  -> m a
+ioError = sendM @n . liftIO . EUnsafe.ioError
+
+-- | See @"Control.Exception".'Exc.throwTo'@.
+--
+-- @since 1.1.0.2
+throwTo
+  :: forall n e sig m a
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => ThreadId
+  -> e
+  -> m ()
+throwTo thread = sendM @n . liftIO . EUnsafe.throwTo thread
+
+-- | See @"UnliftIO.Exception".catch@.
+--
+-- @since 1.1.0.2
+catch
+  :: forall n e sig m a
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => m a
+  -> (e -> m a)
+  -> m a
+catch m h = liftWith @n $
+  \run ctx -> run (m <$ ctx) `Exc.catch` (run . (<$ ctx) . h)
+
+-- | See @"UnliftIO.Exception".catches@.
+--
+-- @since 1.1.0.2
+catches
+  :: forall n sig m a
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> [Handler m a]
+  -> m a
+catches m hs = liftWith @n $
+  \ run ctx -> Exc.catches
+    (run (m <$ ctx))
+    (map (\ (Handler h) -> Exc.Handler (run . (<$ ctx) . h)) hs)
+
+-- | See @"Control.Exception".'Exc.Handler'@.
+--
+-- @since <version>
+data Handler m a
+  = forall e . Exc.Exception e => Handler (e -> m a)
+
+deriving instance Functor m => Functor (Handler m)
+
+-- | See @"UnliftIO.Exception".catchJust@.
+--
+-- @since 1.1.0.2
+catchJust
+  :: forall n e sig m a b
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => (e -> Maybe b)
+  -> m a
+  -> (b -> m a)
+  -> m a
+catchJust p m h = liftWith @n $
+  \ run ctx -> Exc.catchJust p (run (m <$ ctx)) (run . (<$ ctx) . h)
+
+-- | See @"Control.Exception".'Exc.handle'@.
+--
+-- @since 1.1.0.2
+handle
+  :: forall n e sig m a
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => (e -> m a)
+  -> m a
+  -> m a
+handle = flip $ catch @n
+
+-- | See @"Control.Exception".'Exc.handleJust'@.
+--
+-- @since 1.1.0.2
+handleJust
+  :: forall n e sig m a b
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => (e -> Maybe b)
+  -> (b -> m a)
+  -> m a
+  -> m a
+handleJust p = flip (catchJust @n p)
+
+-- | See @"Control.Exception".'Exc.try'@.
+--
+-- @since 1.1.0.2
+try
+  :: forall n e sig m a b
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => m a
+  -> m (Either e a)
+try m = catch @n (Right <$> m) (pure . Left)
+
+-- | See @"Control.Exception".'Exc.tryJust'@.
+--
+-- @since 1.1.0.2
+tryJust
+  :: forall n e sig m a b
+   . (MonadUnliftIO n, Exc.Exception e, Has (Lift n) sig m)
+  => (e -> Maybe b)
+  -> m a
+  -> m (Either b a)
+tryJust p m = catchJust @n p (Right <$> m) (pure . Left)
+
+-- | See @"UnliftIO.Exception".evaluate@.
+--
+-- @since 1.1.0.2
+evaluate :: forall n sig m a. (MonadUnliftIO n, Has (Lift n) sig m) => a -> m a
+evaluate = sendM @n . Exc.evaluate
+
+-- | See @"UnliftIO.Exception".mask@.
+--
+-- @since 1.1.0.2
+mask
+  :: forall n sig m a b
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => ((forall a . m a -> m a) -> m b)
+  -> m b
+mask with = liftWith @n $ \ run ctx -> Exc.mask $ \ restore ->
+  run (with (\ m -> liftWith $ \ run' ctx' -> restore (run' (m <$ ctx'))) <$ ctx)
+
+-- | See @"Control.Exception".'Exc.mask_'@.
+--
+-- @since 1.1.0.2
+mask_
+  :: forall n sig m a
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> m a
+mask_ m = mask @n (const m)
+
+-- | See @"UnliftIO.Exception".uninterruptibleMask@.
+--
+-- @since 1.1.0.2
+uninterruptibleMask
+  :: forall n sig m a b
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => ((forall a . m a -> m a) -> m b)
+  -> m b
+uninterruptibleMask with = liftWith @n $
+  \ run ctx -> Exc.uninterruptibleMask $ \ restore ->
+    run (with (\ m -> liftWith $
+      \ run' ctx' -> restore (run' (m <$ ctx'))) <$ ctx)
+
+-- | See @"Control.Exception".'Exc.uninterruptibleMask_'@.
+--
+-- @since 1.1.0.2
+uninterruptibleMask_
+  :: forall n sig m a
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> m a
+uninterruptibleMask_ m = uninterruptibleMask @n (const m)
+
+-- | See @"Control.Exception".'Exc.getMaskingState'@.
+--
+-- @since 1.1.0.2
+getMaskingState
+  :: forall n sig m
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m EUnsafe.MaskingState
+getMaskingState = sendM @n (liftIO EUnsafe.getMaskingState)
+
+-- | See @"Control.Exception".'Exc.interruptible'@.
+--
+-- @since 1.1.0.2
+interruptible
+  :: forall n sig m a
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> m a
+interruptible m = liftWith @n $ \ run ctx -> withRunInIO $ \runInIO ->
+  EUnsafe.interruptible (runInIO $ run (m <$ ctx))
+
+-- | See @"Control.Exception".'Exc.allowInterrupt'@.
+--
+-- @since 1.1.0.2
+allowInterrupt
+  :: forall n sig m a
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m ()
+allowInterrupt = sendM @n (liftIO EUnsafe.allowInterrupt)
+
+-- | See @"Control.Exception".'Exc.bracket'@.
+--
+-- @since 1.1.0.2
+bracket
+  :: forall n sig m a b c
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> (a -> m b)
+  -> (a -> m c)
+  -> m c
+bracket acquire release m = mask @n $ \ restore -> do
+  a <- acquire
+  r <- onException @n (restore $ m a) (release a)
+  r <$ release a
+
+-- | See @"Control.Exception".'Exc.bracket_'@.
+--
+-- @since 1.1.0.2
+bracket_
+  :: forall n sig m a b c
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> m b
+  -> m c
+  -> m c
+bracket_ before after thing = bracket @n before (const after) (const thing)
+
+-- | See @"Control.Exception".'Exc.bracketOnError'@.
+--
+-- @since 1.1.0.2
+bracketOnError
+  :: forall n sig m a b c
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> (a -> m b)
+  -> (a -> m c)
+  -> m c
+bracketOnError acquire release m = mask @n $ \ restore -> do
+  a <- acquire
+  onException @n (restore $ m a) (release a)
+
+-- | See @"Control.Exception".'Exc.finally'@.
+--
+-- @since 1.1.0.2
+finally
+  :: forall n sig m a b
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> m b
+  -> m a
+finally m sequel = mask @n $
+  \ restore -> onException @n (restore m) sequel <* sequel
+
+-- | See @"Control.Exception".'Exc.onException'@.
+--
+-- @since 1.1.0.2
+onException
+  :: forall n sig m a b
+   . (MonadUnliftIO n, Has (Lift n) sig m)
+  => m a
+  -> m b
+  -> m a
+onException io what = catch @n io $
+  \e -> what >> throwIO @n @Exc.SomeException e

test/Main.hs

@@ -1,16 +1,17 @@
-{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Prelude hiding (ioError)
+import           Prelude hiding (ioError)
 
-import qualified Control.Carrier.State.IORef  as IOState
-import qualified Control.Carrier.State.Strict as State
 import           Control.Carrier.Lift (runM)
+import qualified Control.Carrier.State.IORef as IOState
+import qualified Control.Carrier.State.Strict as State
 import           Control.Effect.Exception
 import           Control.Effect.State
-import qualified Test.Tasty                   as Tasty
+import qualified Test.Tasty as Tasty
-import qualified Test.Tasty.HUnit             as HUnit
+import qualified Test.Tasty.HUnit as HUnit
 
 problematic :: (Has (Lift IO) sig m, Has (State Char) sig m) => m ()
 problematic =