{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ImplicitParams #-}
-- | Unlifted "Control.Exception", with extra async exception safety
-- and more helper functions.
--
-- This module works best when your cleanup functions adhere to certain
-- expectations around exception safety and interruptible actions.
-- For more details, see [this exception safety tutorial](https://www.fpcomplete.com/haskell/tutorial/exceptions/).
module UnliftIO.Exception
  ( -- * Throwing
    throwIO
  , throwString
  , StringException (..)
  , stringException
  , throwTo
  , impureThrow
  , fromEither
  , fromEitherIO
  , fromEitherM
  , mapExceptionM

    -- * Catching (with recovery)
  , catch
  , catchIO
  , catchAny
  , catchDeep
  , catchAnyDeep
  , catchJust

  , handle
  , handleIO
  , handleAny
  , handleDeep
  , handleAnyDeep
  , handleJust

  , try
  , tryIO
  , tryAny
  , tryDeep
  , tryAnyDeep
  , tryJust
  , pureTry
  , pureTryDeep

  , ESafe.Handler (..)
  , catches
  , catchesDeep

    -- * Catching async exceptions (with recovery)
  , catchSyncOrAsync
  , handleSyncOrAsync
  , trySyncOrAsync

    -- * Cleanup (no recovery)
  , onException
  , bracket
  , bracket_
  , finally
  , withException
  , bracketOnError
  , bracketOnError_

    -- * Coercion to sync and async
    -- | In version /0.2.23.0/, these were changed with aliases to the values
    -- from "Control.Exception.Safe" in the @safe-exceptions@ package.
  , ESafe.SyncExceptionWrapper(..)
  , toSyncException
  , ESafe.AsyncExceptionWrapper(..)
  , toAsyncException
  , fromExceptionUnwrap

    -- * Check exception type
  , isSyncException
  , isAsyncException
    -- * Masking
  , mask
  , uninterruptibleMask
  , mask_
  , uninterruptibleMask_
    -- * Evaluation
  , evaluate
  , evaluateDeep
    -- * Reexports
  , Exception (..)
  , Typeable
  , SomeException (..)
  , SomeAsyncException (..)
  , IOException
  , EUnsafe.assert
  , EUnsafe.asyncExceptionToException
  , EUnsafe.asyncExceptionFromException
#if !MIN_VERSION_base(4,8,0)
  , displayException
#endif
  ) where

import Control.Concurrent (ThreadId)
import Control.Monad (liftM)
import Control.Monad.IO.Unlift
import Control.Exception (Exception (..), SomeException (..), IOException, SomeAsyncException (..))
import qualified Control.Exception as EUnsafe
import Control.DeepSeq (NFData (..), ($!!))
import Data.Typeable (Typeable, cast)
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Exception.Safe as ESafe
import Control.Exception.Safe (Handler(..))

#if MIN_VERSION_base(4,9,0)
import GHC.Stack (prettySrcLoc)
import GHC.Stack.Types (HasCallStack, CallStack, getCallStack)
#endif

-- | 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'.
--
-- @since 0.1.0.0
catch
  :: (MonadUnliftIO m, Exception e)
  => m a -- ^ action
  -> (e -> m a) -- ^ handler
  -> m a
catch :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
f e -> m a
g = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. m a -> IO a
run m a
f forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`EUnsafe.catch` \e
e ->
  if forall e. Exception e => e -> Bool
isSyncException e
e
    then forall a. m a -> IO a
run (e -> m a
g e
e)
    -- intentionally rethrowing an async exception synchronously,
    -- since we want to preserve async behavior
    else forall e a. Exception e => e -> IO a
EUnsafe.throwIO e
e

-- | 'catch' specialized to only catching 'IOException's.
--
-- @since 0.1.0.0
catchIO :: MonadUnliftIO m => m a -> (IOException -> m a) -> m a
catchIO :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (IOException -> m a) -> m a
catchIO = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | 'catch' specialized to catch all synchronous exceptions.
--
-- @since 0.1.0.0
catchAny :: MonadUnliftIO m => m a -> (SomeException -> m a) -> m a
catchAny :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
catchAny = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | Same as 'catch', but fully force evaluation of the result value
-- to find all impure exceptions.
--
-- @since 0.1.0.0
catchDeep :: (MonadUnliftIO m, Exception e, NFData a)
          => m a -> (e -> m a) -> m a
catchDeep :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep m a
m = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep)

-- | 'catchDeep' specialized to catch all synchronous exception.
--
-- @since 0.1.0.0
catchAnyDeep :: (NFData a, MonadUnliftIO m) => m a -> (SomeException -> m a) -> m a
catchAnyDeep :: forall a (m :: * -> *).
(NFData a, MonadUnliftIO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep

-- | '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.
--
-- @since 0.1.0.0
catchJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust :: forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f m a
a b -> m a
b = m a
a forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO e
e)) b -> m a
b forall a b. (a -> b) -> a -> b
$ e -> Maybe b
f e
e

-- | A variant of 'catch' that catches both synchronous and asynchronous exceptions.
--
-- WARNING: This function (and other @*SyncOrAsync@ functions) is for advanced users. Most of the
-- time, you probably want to use the non-@SyncOrAsync@ versions.
--
-- Before attempting to use this function, be familiar with the "Rules for async safe handling"
-- section in
-- [this blog post](https://www.fpcomplete.com/blog/2018/04/async-exception-handling-haskell/).
--
-- @since 0.2.17
catchSyncOrAsync :: (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a
catchSyncOrAsync :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchSyncOrAsync m a
f e -> m a
g = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. m a -> IO a
run m a
f forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`EUnsafe.catch` \e
e -> forall a. m a -> IO a
run (e -> m a
g e
e)

-- | Flipped version of 'catch'.
--
-- @since 0.1.0.0
handle :: (MonadUnliftIO m, Exception e) => (e -> m a) -> m a -> m a
handle :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | 'handle' specialized to only catching 'IOException's.
--
-- @since 0.1.0.0
handleIO :: MonadUnliftIO m => (IOException -> m a) -> m a -> m a
handleIO :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle

-- | Flipped version of 'catchAny'.
--
-- @since 0.1.0.0
handleAny :: MonadUnliftIO m => (SomeException -> m a) -> m a -> m a
handleAny :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle

-- | Flipped version of 'catchDeep'.
--
-- @since 0.1.0.0
handleDeep :: (MonadUnliftIO m, Exception e, NFData a) => (e -> m a) -> m a -> m a
handleDeep :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e, NFData a) =>
(e -> m a) -> m a -> m a
handleDeep = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep

-- | Flipped version of 'catchAnyDeep'.
--
-- @since 0.1.0.0
handleAnyDeep :: (MonadUnliftIO m, NFData a) => (SomeException -> m a) -> m a -> m a
handleAnyDeep :: forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
(SomeException -> m a) -> m a -> m a
handleAnyDeep = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *).
(NFData a, MonadUnliftIO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep

-- | Flipped 'catchJust'.
--
-- @since 0.1.0.0
handleJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust :: forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust e -> Maybe b
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f)

-- | A variant of 'handle' that catches both synchronous and asynchronous exceptions.
--
-- See 'catchSyncOrAsync'.
--
-- @since 0.2.17
handleSyncOrAsync :: (MonadUnliftIO m, Exception e) => (e -> m a) -> m a -> m a
handleSyncOrAsync :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handleSyncOrAsync = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchSyncOrAsync

-- | Run the given action and catch any synchronous exceptions as a 'Left' value.
--
-- This is parameterized on the exception type. To catch all synchronous exceptions,
-- use 'tryAny'.
--
-- @since 0.1.0.0
try :: (MonadUnliftIO m, Exception e) => m a -> m (Either e a)
try :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m a
f = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right m a
f) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | 'try' specialized to only catching 'IOException's.
--
-- @since 0.1.0.0
tryIO :: MonadUnliftIO m => m a -> m (Either IOException a)
tryIO :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try

-- | 'try' specialized to catch all synchronous exceptions.
--
-- @since 0.1.0.0
tryAny :: MonadUnliftIO m => m a -> m (Either SomeException a)
tryAny :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try

-- | Same as 'try', but fully force evaluation of the result value
-- to find all impure exceptions.
--
-- @since 0.1.0.0
tryDeep :: (MonadUnliftIO m, Exception e, NFData a) => m a -> m (Either e a)
tryDeep :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> m (Either e a)
tryDeep m a
f = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right (m a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep)) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | 'tryDeep' specialized to catch all synchronous exceptions.
--
-- @since 0.1.0.0
tryAnyDeep :: (MonadUnliftIO m, NFData a) => m a -> m (Either SomeException a)
tryAnyDeep :: forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
m a -> m (Either SomeException a)
tryAnyDeep = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e, NFData a) =>
m a -> m (Either e a)
tryDeep

-- | A variant of 'try' that takes an exception predicate to select
-- which exceptions are caught.
--
-- @since 0.1.0.0
tryJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
f m a
a = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a b. b -> Either a b
Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
a) (\e
e -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO e
e) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (e -> Maybe b
f e
e))

-- | A variant of 'try' that catches both synchronous and asynchronous exceptions.
--
-- See 'catchSyncOrAsync'.
--
-- @since 0.2.17
trySyncOrAsync :: (MonadUnliftIO m, Exception e) => m a -> m (Either e a)
trySyncOrAsync :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
trySyncOrAsync m a
f = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchSyncOrAsync (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right m a
f) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | Evaluate the value to WHNF and catch any synchronous exceptions.
--
-- The expression may still have bottom values within it; you may
-- instead want to use 'pureTryDeep'.
--
-- @since 0.2.2.0
pureTry :: a -> Either SomeException a
pureTry :: forall a. a -> Either SomeException a
pureTry a
a = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! a
a) forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | Evaluate the value to NF and catch any synchronous exceptions.
--
-- @since 0.2.2.0
pureTryDeep :: NFData a => a -> Either SomeException a
pureTryDeep :: forall a. NFData a => a -> Either SomeException a
pureTryDeep = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
m a -> m (Either SomeException a)
tryAnyDeep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Internal.
catchesHandler :: MonadIO m => [Handler m a] -> SomeException -> m a
catchesHandler :: forall (m :: * -> *) a.
MonadIO m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers SomeException
e = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *} {a}. Handler m a -> m a -> m a
tryHandler (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e)) [Handler m a]
handlers
    where tryHandler :: Handler m a -> m a -> m a
tryHandler (ESafe.Handler e -> m a
handler) m a
res
              = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                Just e
e' -> e -> m a
handler e
e'
                Maybe e
Nothing -> m a
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.
--
-- @since 0.1.0.0
catches :: MonadUnliftIO m => m a -> [Handler m a] -> m a
catches :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
catches m a
io [Handler m a]
handlers = m a
io forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` forall (m :: * -> *) a.
MonadIO m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers

-- | Same as 'catches', but fully force evaluation of the result value
-- to find all impure exceptions.
--
-- @since 0.1.0.0
catchesDeep :: (MonadUnliftIO m, NFData a) => m a -> [Handler m a] -> m a
catchesDeep :: forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
m a -> [Handler m a] -> m a
catchesDeep m a
io [Handler m a]
handlers = (m a
io forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep) forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` forall (m :: * -> *) a.
MonadIO m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers

-- | Lifted version of 'EUnsafe.evaluate'.
--
-- @since 0.1.0.0
evaluate :: MonadIO m => a -> m a
evaluate :: forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
EUnsafe.evaluate

-- | Deeply evaluate a value using 'evaluate' and 'NFData'.
--
-- @since 0.1.0.0
evaluateDeep :: (MonadIO m, NFData a) => a -> m a
evaluateDeep :: forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep = (forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate forall a b. NFData a => (a -> b) -> a -> b
$!!)

-- | Allocate and clean up a resource safely.
--
-- For more information on motivation and usage of this function, see @base@'s
-- 'EUnsafe.bracket'. This function has two differences from the one in @base@.
-- The first, and more obvious, is that it works on any @MonadUnliftIO@
-- instance, not just @IO@.
--
-- The more subtle difference is that this function will use uninterruptible
-- masking for its cleanup handler. This is a subtle distinction, but at a
-- high level, means that resource cleanup has more guarantees to complete.
-- This comes at the cost that an incorrectly written cleanup function
-- cannot be interrupted.
--
-- For more information, please see <https://github.com/fpco/safe-exceptions/issues/3>.
--
-- @since 0.1.0.0
bracket :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c
bracket :: forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before a -> m b
after a -> m c
thing = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  a
x <- forall a. m a -> IO a
run m a
before
  Either SomeException c
res1 <- forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ a -> m c
thing a
x
  case Either SomeException c
res1 of
    Left (SomeException
e1 :: SomeException) -> do
      -- explicitly ignore exceptions from after. We know that
      -- no async exceptions were thrown there, so therefore
      -- the stronger exception must come from thing
      --
      -- https://github.com/fpco/safe-exceptions/issues/2
      Either SomeException b
_ :: Either SomeException b <-
          forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
      forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
    Right c
y -> do
      b
_ <- forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
      forall (m :: * -> *) a. Monad m => a -> m a
return c
y

-- | Same as 'bracket', but does not pass the acquired resource to cleanup and use functions.
--
-- For more information, see @base@'s 'EUnsafe.bracket_'.
--
-- @since 0.1.0.0
bracket_ :: MonadUnliftIO m => m a -> m b -> m c -> m c
bracket_ :: forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ m a
before m b
after m c
thing = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before (forall a b. a -> b -> a
const m b
after) (forall a b. a -> b -> a
const m c
thing)

-- | Same as 'bracket', but only perform the cleanup if an exception is thrown.
--
-- @since 0.1.0.0
bracketOnError :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError :: forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before a -> m b
after a -> m c
thing = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  a
x <- forall a. m a -> IO a
run m a
before
  Either SomeException c
res1 <- forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ a -> m c
thing a
x
  case Either SomeException c
res1 of
    Left (SomeException
e1 :: SomeException) -> do
      -- ignore the exception, see bracket for explanation
      Either SomeException b
_ :: Either SomeException b <-
        forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
      forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
    Right c
y -> forall (m :: * -> *) a. Monad m => a -> m a
return c
y

-- | A variant of 'bracketOnError' where the return value from the first
-- computation is not required.
--
-- @since 0.1.0.0
bracketOnError_ :: MonadUnliftIO m => m a -> m b -> m c -> m c
bracketOnError_ :: forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracketOnError_ m a
before m b
after m c
thing = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before (forall a b. a -> b -> a
const m b
after) (forall a b. a -> b -> a
const m c
thing)

-- | Perform @thing@, guaranteeing that @after@ will run after, even if an exception occurs.
--
-- Same interruptible vs uninterrupible points apply as with 'bracket'. See @base@'s
-- 'EUnsafe.finally' for more information.
--
-- @since 0.1.0.0
finally
  :: MonadUnliftIO m
  => m a -- ^ thing
  -> m b -- ^ after
  -> m a
finally :: forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally m a
thing m b
after = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  Either SomeException a
res1 <- forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
thing
  case Either SomeException a
res1 of
    Left (SomeException
e1 :: SomeException) -> do
      -- see bracket for explanation
      Either SomeException b
_ :: Either SomeException b <- forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m b
after
      forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
    Right a
x -> do
      b
_ <- forall a. m a -> IO a
run m b
after
      forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Like 'onException', but provides the handler the thrown
-- exception.
--
-- @since 0.1.0.0
withException :: (MonadUnliftIO m, Exception e)
              => m a -> (e -> m b) -> m a
withException :: forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
withException m a
thing e -> m b
after = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    Either e a
res1 <- forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
thing
    case Either e a
res1 of
        Left e
e1 -> do
            -- see explanation in bracket
            Either SomeException b
_ :: Either SomeException b <- forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ e -> m b
after e
e1
            forall e a. Exception e => e -> IO a
EUnsafe.throwIO e
e1
        Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Like 'finally', but only call @after@ if an exception occurs.
--
-- @since 0.1.0.0
onException :: MonadUnliftIO m => m a -> m b -> m a
onException :: forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
onException m a
thing m b
after = forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
withException m a
thing (\(SomeException
_ :: SomeException) -> m b
after)

-- | 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'.
--
-- @since 0.1.0.0
throwIO :: (MonadIO m, Exception e) => e -> m a
throwIO :: forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
EUnsafe.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toSyncException

-- | 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'.
--
-- @since 0.1.0.0
toSyncException :: Exception e => e -> SomeException
toSyncException :: forall e. Exception e => e -> SomeException
toSyncException =
    forall e. Exception e => e -> SomeException
ESafe.toSyncException

-- | Convert an exception into an asynchronous exception.
--
-- For asynchronous exceptions, this is the same as 'toException'.
-- For synchronous exceptions, this will wrap up the exception with
-- 'AsyncExceptionWrapper'.
--
-- @since 0.1.0.0
toAsyncException :: Exception e => e -> SomeException
toAsyncException :: forall e. Exception e => e -> SomeException
toAsyncException =
    forall e. Exception e => e -> SomeException
ESafe.toAsyncException

-- | Convert from a possibly wrapped exception.
--
-- The inverse of 'toAsyncException' and 'toSyncException'. When using those
-- functions (or functions that use them, like 'throwTo' or 'throwIO'),
-- 'fromException' might not be sufficient because the exception might be
-- wrapped within 'SyncExceptionWrapper' or 'AsyncExceptionWrapper'.
--
-- @since 0.2.17
fromExceptionUnwrap :: Exception e => SomeException -> Maybe e
fromExceptionUnwrap :: forall e. Exception e => SomeException -> Maybe e
fromExceptionUnwrap SomeException
se
  | Just (ESafe.AsyncExceptionWrapper e
e) <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
  | Just (ESafe.SyncExceptionWrapper e
e) <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
  | Bool
otherwise = forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se

-- | Check if the given exception is synchronous.
--
-- @since 0.1.0.0
isSyncException :: Exception e => e -> Bool
isSyncException :: forall e. Exception e => e -> Bool
isSyncException =
    forall e. Exception e => e -> Bool
ESafe.isSyncException

-- | Check if the given exception is asynchronous.
--
-- @since 0.1.0.0
isAsyncException :: Exception e => e -> Bool
isAsyncException :: forall e. Exception e => e -> Bool
isAsyncException = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> Bool
isSyncException
{-# INLINE isAsyncException #-}

#if !MIN_VERSION_base(4,8,0)
-- | A synonym for 'show', specialized to 'Exception' instances.
--
-- Starting with base 4.8, the 'Exception' typeclass has a method
-- @displayException@, used for user-friendly display of exceptions.
-- This function provides backwards compatibility for users on base 4.7 and earlier,
-- so that anyone importing this module can simply use @displayException@.
--
-- @since 0.1.0.0
displayException :: Exception e => e -> String
displayException = show
#endif

-- | Unlifted version of 'EUnsafe.mask'.
--
-- @since 0.1.0.0
mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b
mask :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask (forall a. m a -> m a) -> m b
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask ->
  forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m b
f forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
unmask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run

-- | Unlifted version of 'EUnsafe.uninterruptibleMask'.
--
-- @since 0.1.0.0
uninterruptibleMask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (forall a. m a -> m a) -> m b
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask ->
  forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m b
f forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
unmask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run

-- | Unlifted version of 'EUnsafe.mask_'.
--
-- @since 0.1.0.0
mask_ :: MonadUnliftIO m => m a -> m a
mask_ :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m a
mask_ m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. IO a -> IO a
EUnsafe.mask_ (forall a. m a -> IO a
run m a
f)

-- | Unlifted version of 'EUnsafe.uninterruptibleMask_'.
--
-- @since 0.1.0.0
uninterruptibleMask_ :: MonadUnliftIO m => m a -> m a
uninterruptibleMask_ :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m a
uninterruptibleMask_ m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (forall a. m a -> IO a
run m a
f)

-- | A convenience function for throwing a user error. This is useful
-- for cases where it would be too high a burden to define your own
-- exception type.
--
-- This throws an exception of type 'StringException'. When GHC
-- supports it (base 4.9 and GHC 8.0 and onward), it includes a call
-- stack.
--
-- @since 0.1.0.0
#if MIN_VERSION_base(4,9,0)
throwString :: (MonadIO m, HasCallStack) => String -> m a
throwString :: forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
s = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (String -> CallStack -> StringException
StringException String
s HasCallStack
?callStack)
#else
throwString :: MonadIO m => String -> m a
throwString s = throwIO (StringException s ())
#endif

-- | Smart constructor for a 'StringException' that deals with the
-- call stack.
--
-- @since 0.1.0.0
#if MIN_VERSION_base(4,9,0)
stringException :: HasCallStack => String -> StringException
stringException :: HasCallStack => String -> StringException
stringException String
s = String -> CallStack -> StringException
StringException String
s HasCallStack
?callStack
#else
stringException :: String -> StringException
stringException s = StringException s ()
#endif

-- | Exception type thrown by 'throwString'.
--
-- Note that the second field of the data constructor depends on
-- GHC/base version. For base 4.9 and GHC 8.0 and later, the second
-- field is a call stack. Previous versions of GHC and base do not
-- support call stacks, and the field is simply unit (provided to make
-- pattern matching across GHC versions easier).
--
-- @since 0.1.0.0
#if MIN_VERSION_base(4,9,0)
data StringException = StringException String CallStack
  deriving Typeable

-- | @since 0.1.0.0
instance Show StringException where
    show :: StringException -> String
show (StringException String
s CallStack
cs) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        forall a b. (a -> b) -> a -> b
$ String
"UnliftIO.Exception.throwString called with:\n\n"
        forall a. a -> [a] -> [a]
: String
s
        forall a. a -> [a] -> [a]
: String
"\nCalled from:\n"
        forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (String, SrcLoc) -> String
go (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs)
      where
        go :: (String, SrcLoc) -> String
go (String
x, SrcLoc
y) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ String
"  "
          , String
x
          , String
" ("
          , SrcLoc -> String
prettySrcLoc SrcLoc
y
          , String
")\n"
          ]
#else
data StringException = StringException String ()
  deriving Typeable

-- | @since 0.1.0.0
instance Show StringException where
    show (StringException s _) = "UnliftIO.Exception.throwString called with:\n\n" ++ s
#endif

-- | @since 0.2.19
instance Eq StringException where
  StringException String
msg1 CallStack
_ == :: StringException -> StringException -> Bool
== StringException String
msg2 CallStack
_ = String
msg1 forall a. Eq a => a -> a -> Bool
== String
msg2

-- | @since 0.1.0.0
instance Exception StringException

-- | Throw an asynchronous exception to another thread.
--
-- Synchronously typed exceptions will be wrapped into an
-- `AsyncExceptionWrapper`, see
-- <https://github.com/fpco/safe-exceptions#determining-sync-vs-async>.
--
-- It's usually a better idea to use the "UnliftIO.Async" module, see
-- <https://github.com/fpco/safe-exceptions#quickstart>.
--
-- @since 0.1.0.0
throwTo :: (Exception e, MonadIO m) => ThreadId -> e -> m ()
throwTo :: forall e (m :: * -> *).
(Exception e, MonadIO m) =>
ThreadId -> e -> m ()
throwTo ThreadId
tid = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => ThreadId -> e -> IO ()
EUnsafe.throwTo ThreadId
tid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toAsyncException

-- | Generate a pure value which, when forced, will synchronously
-- throw the given exception.
--
-- Generally it's better to avoid using this function and instead use 'throwIO',
-- see <https://github.com/fpco/safe-exceptions#quickstart>.
--
-- @since 0.1.0.0
impureThrow :: Exception e => e -> a
impureThrow :: forall e a. Exception e => e -> a
impureThrow = forall a e. Exception e => e -> a
EUnsafe.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toSyncException

-- | Unwrap an 'Either' value, throwing its 'Left' value as a runtime
-- exception via 'throwIO' if present.
--
-- @since 0.1.0.0
fromEither :: (Exception e, MonadIO m) => Either e a -> m a
fromEither :: forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Either e a -> m a
fromEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Same as 'fromEither', but works on an 'IO'-wrapped 'Either'.
--
-- @since 0.1.0.0
fromEitherIO :: (Exception e, MonadIO m) => IO (Either e a) -> m a
fromEitherIO :: forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
IO (Either e a) -> m a
fromEitherIO = forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
m (Either e a) -> m a
fromEitherM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Same as 'fromEither', but works on an 'm'-wrapped 'Either'.
--
-- @since 0.1.0.0
fromEitherM :: (Exception e, MonadIO m) => m (Either e a) -> m a
fromEitherM :: forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
m (Either e a) -> m a
fromEitherM = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Either e a -> m a
fromEither)

-- | Same as 'Control.Exception.mapException', except works in
-- a monadic context.
--
-- @since 0.2.15
mapExceptionM :: (Exception e1, Exception e2, MonadUnliftIO m) => (e1 -> e2) -> m a -> m a
mapExceptionM :: forall e1 e2 (m :: * -> *) a.
(Exception e1, Exception e2, MonadUnliftIO m) =>
(e1 -> e2) -> m a -> m a
mapExceptionM e1 -> e2
f = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f)