{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ImplicitParams #-}
-- | Please see the README.md file in the safe-exceptions repo for
-- information on how to use this module. Relevant links:
--
-- * https://github.com/fpco/safe-exceptions#readme
--
-- * https://www.stackage.org/package/safe-exceptions
module Control.Exception.Safe
    ( -- * Throwing
      throw
    , throwIO
    , throwM
    , throwString
    , StringException (..)
    , throwTo
    , impureThrow
      -- * Catching (with recovery)
    , catch
    , catchIO
    , catchAny
    , catchDeep
    , catchAnyDeep
    , catchAsync
    , catchJust

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

    , try
    , tryIO
    , tryAny
    , tryDeep
    , tryAnyDeep
    , tryAsync
    , tryJust

    , Handler(..)
    , catches
    , catchesDeep
    , catchesAsync

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

      -- * Coercion to sync and async
    , SyncExceptionWrapper (..)
    , toSyncException
    , AsyncExceptionWrapper (..)
    , toAsyncException

      -- * Check exception type
    , isSyncException
    , isAsyncException
      -- * Reexports
    , C.MonadThrow
    , C.MonadCatch
    , C.MonadMask (..)
    , C.mask_
    , C.uninterruptibleMask_
    , C.catchIOError
    , C.handleIOError
    -- FIXME , C.tryIOError
    , Exception (..)
    , Typeable
    , SomeException (..)
    , SomeAsyncException (..)
    , E.IOException
    , E.assert
#if !MIN_VERSION_base(4,8,0)
    , displayException
#endif
    ) where

import Control.Concurrent (ThreadId)
import Control.DeepSeq (($!!), NFData)
import Control.Exception (Exception (..), SomeException (..), SomeAsyncException (..))
import qualified Control.Exception as E
import qualified Control.Monad.Catch as C
import Control.Monad.Catch (Handler (..))
import Control.Monad (liftM, void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Typeable (Typeable, cast)

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

#if MIN_VERSION_base(4,9,0) && MIN_VERSION_exceptions(0,10,6)
import GHC.Stack (withFrozenCallStack)
#endif

-- The exceptions package that safe-exceptions is based on added HasCallStack
-- to many of its functions in 0.10.6:
--
-- https://github.com/ekmett/exceptions/pull/90
-- https://github.com/ekmett/exceptions/pull/92
--
-- We make the same change here. The following comment has been lifted
-- verbatim from exceptions:
--
-- We use the following bit of CPP to enable the use of HasCallStack
-- constraints without breaking the build for pre-8.0 GHCs, which did not
-- provide GHC.Stack. We are careful to always write constraints like this:
--
--   HAS_CALL_STACK => MonadThrow m => ...
--
-- Instead of like this:
--
--   (HAS_CALL_STACK, MonadThrow e) => ...
--
-- The latter is equivalent to (() :: Constraint, MonadThrow e) => ..., which
-- requires ConstraintKinds. More importantly, it's slightly less efficient,
-- since it requires passing an empty constraint tuple dictionary around.
--
-- Note that we do /not/ depend on the call-stack compatibility library to
-- provide HasCallStack on older GHCs. We tried this at one point, but we
-- discovered that downstream libraries failed to build because combining
-- call-stack with GeneralizedNewtypeDeriving on older GHCs would require the
-- use of ConstraintKinds/FlexibleContexts, which downstream libraries did not
-- enable. (See #91.) The CPP approach that we use now, while somewhat clunky,
-- avoids these issues by not requiring any additional language extensions for
-- downstream users.
#if MIN_VERSION_base(4,9,0) && MIN_VERSION_exceptions(0,10,6)
# define HAS_CALL_STACK HasCallStack
#else
# define HAS_CALL_STACK ()
withFrozenCallStack :: a -> a
withFrozenCallStack :: forall a. a -> a
withFrozenCallStack a
a = a
a
#endif

-- | Synchronously throw the given exception
--
-- @since 0.1.0.0
throw :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a
throw :: forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toSyncException

-- | Synonym for 'throw'
--
-- @since 0.1.0.0
throwIO :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a
throwIO :: forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw

-- | Synonym for 'throw'
--
-- @since 0.1.0.0
throwM :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a
throwM :: forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw

-- | 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.5.0
#if MIN_VERSION_base(4,9,0)
throwString :: (C.MonadThrow m, HasCallStack) => String -> m a
throwString :: forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString String
s = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> CallStack -> StringException
StringException String
s HasCallStack
?callStack)
#else
throwString :: C.MonadThrow m => String -> m a
throwString s = throwM (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.5.0
#if MIN_VERSION_base(4,9,0)
data StringException = StringException String CallStack
  deriving Typeable

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
"Control.Exception.Safe.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

instance Show StringException where
    show (StringException s _) = "Control.Exception.Safe.throwString called with:\n\n" ++ s
#endif
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 async package, 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 ()
E.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 'throw',
-- see <https://github.com/fpco/safe-exceptions#quickstart>
--
-- @since 0.1.0.0
impureThrow :: HAS_CALL_STACK => Exception e => e -> a
impureThrow :: forall e a. Exception e => e -> a
impureThrow = forall a e. Exception e => e -> a
E.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toSyncException

-- | Same as upstream 'C.catch', but will not catch asynchronous
-- exceptions
--
-- @since 0.1.0.0
catch :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a
catch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
f e -> m a
g = m a
f forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`C.catch` \e
e ->
    if forall e. Exception e => e -> Bool
isSyncException e
e
        then e -> m a
g e
e
        -- intentionally rethrowing an async exception synchronously,
        -- since we want to preserve async behavior
        else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM e
e

-- | 'C.catch' specialized to only catching 'E.IOException's
--
-- @since 0.1.3.0
catchIO :: HAS_CALL_STACK => C.MonadCatch m => m a -> (E.IOException -> m a) -> m a
catchIO :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
catchIO = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch

-- | 'catch' specialized to catch all synchronous exception
--
-- @since 0.1.0.0
catchAny :: HAS_CALL_STACK => C.MonadCatch m => m a -> (SomeException -> m a) -> m a
catchAny :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
catchAny = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch 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.1.0
catchDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, Exception e, NFData a)
          => m a -> (e -> m a) -> m a
catchDeep :: forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep

-- | Internal helper function
evaluateDeep :: (MonadIO m, NFData a) => m a -> m a
evaluateDeep :: forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep m a
action = do
    a
res <- m a
action
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO a
E.evaluate forall a b. NFData a => (a -> b) -> a -> b
$!! a
res)

-- | 'catchDeep' specialized to catch all synchronous exception
--
-- @since 0.1.1.0
catchAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => m a -> (SomeException -> m a) -> m a
catchAnyDeep :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep

-- | 'catch' without async exception safety
--
-- Generally it's better to avoid using this function since we do not want to
-- recover from async exceptions, see
-- <https://github.com/fpco/safe-exceptions#quickstart>
--
-- @since 0.1.0.0
catchAsync :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a
catchAsync :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catchAsync = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch

-- | '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.4.0
catchJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust :: forall (m :: * -> *) e b a.
(MonadCatch 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 = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a (\e
e -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e) b -> m a
b forall a b. (a -> b) -> a -> b
$ e -> Maybe b
f e
e)

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

-- | 'C.handle' specialized to only catching 'E.IOException's
--
-- @since 0.1.3.0
handleIO :: HAS_CALL_STACK => C.MonadCatch m => (E.IOException -> m a) -> m a -> m a
handleIO :: forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
C.handle


-- | Flipped version of 'catchAny'
--
-- @since 0.1.0.0
handleAny :: HAS_CALL_STACK => C.MonadCatch m => (SomeException -> m a) -> m a -> m a
handleAny :: forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
handleAny = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
catchAny)

-- | Flipped version of 'catchDeep'
--
-- @since 0.1.1.0
handleDeep :: HAS_CALL_STACK => (C.MonadCatch m, Exception e, MonadIO m, NFData a) => (e -> m a) -> m a -> m a
handleDeep :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e, MonadIO m, NFData a) =>
(e -> m a) -> m a -> m a
handleDeep = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> (e -> m a) -> m a
catchDeep)

-- | Flipped version of 'catchAnyDeep'
--
-- @since 0.1.1.0
handleAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => (SomeException -> m a) -> m a -> m a
handleAnyDeep :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
(SomeException -> m a) -> m a -> m a
handleAnyDeep = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep)

-- | Flipped version of 'catchAsync'
--
-- Generally it's better to avoid using this function since we do not want to
-- recover from async exceptions, see
-- <https://github.com/fpco/safe-exceptions#quickstart>
--
-- @since 0.1.0.0
handleAsync :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a
handleAsync :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handleAsync = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
C.handle

-- | Flipped 'catchJust'.
--
-- @since 0.1.4.0
handleJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust :: forall (m :: * -> *) e b a.
(MonadCatch 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 a. a -> a
withFrozenCallStack forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f)

-- | Same as upstream 'C.try', but will not catch asynchronous
-- exceptions
--
-- @since 0.1.0.0
try :: HAS_CALL_STACK => (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)
try :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
f = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch 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)

-- | 'C.try' specialized to only catching 'E.IOException's
--
-- @since 0.1.3.0
tryIO :: HAS_CALL_STACK => C.MonadCatch m => m a -> m (Either E.IOException a)
tryIO :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try

-- | 'try' specialized to catch all synchronous exceptions
--
-- @since 0.1.0.0
tryAny :: HAS_CALL_STACK => C.MonadCatch m => m a -> m (Either SomeException a)
tryAny :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch 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.1.0
tryDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, E.Exception e, NFData a) => m a -> m (Either e a)
tryDeep :: forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> m (Either e a)
tryDeep m a
f = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch 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 (forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep 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)

-- | 'tryDeep' specialized to catch all synchronous exceptions
--
-- @since 0.1.1.0
tryAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => m a -> m (Either SomeException a)
tryAnyDeep :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either SomeException a)
tryAnyDeep = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, MonadIO m, Exception e, NFData a) =>
m a -> m (Either e a)
tryDeep

-- | 'try' without async exception safety
--
-- Generally it's better to avoid using this function since we do not want to
-- recover from async exceptions, see
-- <https://github.com/fpco/safe-exceptions#quickstart>
--
-- @since 0.1.0.0
tryAsync :: HAS_CALL_STACK => (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)
tryAsync :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
tryAsync = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try

-- | A variant of 'try' that takes an exception predicate to select
-- which exceptions are caught.
--
-- @since 0.1.4.0
tryJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
f m a
a = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch 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. (MonadThrow m, Exception e) => e -> m a
throwM 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))

-- | Async safe version of 'E.onException'
--
-- @since 0.1.0.0
onException :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m a
onException :: forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException m a
thing m b
after = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a b.
(MonadMask m, Exception e) =>
m a -> (e -> m b) -> m a
withException m a
thing (\(SomeException
_ :: SomeException) -> m b
after)

-- Note: [withFrozenCallStack impredicativity]
--
-- We do not currently use 'withFrozenCallStack' in 'withException' or the similar
-- 'finally' due to impredicativity. That is, we would like to be consistent
-- with other functions and apply 'withFrozenCallStack' to the _handler only_ i.e.
--
--     withException thing after = withFrozenCallStack C.uninterruptibleMask $ \restore ...
--
-- Alas, that fails due to impredicativity:
--
--     • Couldn't match type: m a -> m a
--                      with: forall a1. m a1 -> m a1
--       Expected: (forall a1. m a1 -> m a1) -> m a
--         Actual: (m a -> m a) -> m a
--
-- Armed with -XImpredicativeTypes, we can define:
--
--     uninterruptibleMaskFrozen :: forall m b. C.MonadMask m => ((forall a. m a -> m a) -> m b) -> m b
--     uninterruptibleMaskFrozen = withFrozenCallStack C.uninterruptibleMask
--
-- and then
--
--     withException thing after = uninterruptibleMaskFrozen $ \restore -> do ...
--
-- But we cannot rely on -XImpredicativeTypes until GHC 9.2 is the oldest
-- supported release, and even then it is worth asking if the benefit
-- (consistency, omit handler from CallStack) is worth the cost (powerful,
-- relatively exotic extension).

-- | Like 'onException', but provides the handler the thrown
-- exception.
--
-- @since 0.1.0.0
withException :: HAS_CALL_STACK => (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a
withException :: forall (m :: * -> *) e a b.
(MonadMask m, Exception e) =>
m a -> (e -> m b) -> m a
withException m a
thing e -> m b
after = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
C.generalBracket (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall {a}. () -> ExitCase a -> m ()
cAfter (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. m a -> m a
restore m a
thing)
  where
    -- ignore the exception from after, see bracket for explanation
    cAfter :: () -> ExitCase a -> m ()
cAfter () (C.ExitCaseException SomeException
se) | Just e
ex <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se =
        forall (m :: * -> *) a. MonadMask m => m a -> m ()
ignoreExceptions forall a b. (a -> b) -> a -> b
$ e -> m b
after e
ex
    cAfter () ExitCase a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Async safe version of 'E.bracket'
--
-- @since 0.1.0.0
bracket :: forall m a b c. HAS_CALL_STACK => C.MonadMask m
        => m a -> (a -> m b) -> (a -> m c) -> m c
bracket :: forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before a -> m b
after = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketWithError m a
before (forall a b. a -> b -> a
const a -> m b
after)

-- | Async safe version of 'E.bracket_'
--
-- @since 0.1.0.0
bracket_ :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m c -> m c
bracket_ :: forall (m :: * -> *) a b c. MonadMask m => m a -> m b -> m c -> m c
bracket_ m a
before m b
after m c
thing = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a b c.
MonadMask 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)

-- See Note [withFrozenCallStack impredicativity]

-- | Async safe version of 'E.finally'
--
-- @since 0.1.0.0
finally :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m a
finally :: forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally m a
thing m b
after = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
C.generalBracket (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall {a}. () -> ExitCase a -> m ()
cAfter (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. m a -> m a
restore m a
thing)
  where
    -- ignore the exception from after, see bracket for explanation
    cAfter :: () -> ExitCase a -> m ()
cAfter () (C.ExitCaseException SomeException
se) =
        forall (m :: * -> *) a. MonadMask m => m a -> m ()
ignoreExceptions m b
after
    cAfter () ExitCase a
_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void m b
after

-- | Async safe version of 'E.bracketOnError'
--
-- @since 0.1.0.0
bracketOnError :: forall m a b c. HAS_CALL_STACK => C.MonadMask m
               => m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError :: forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before a -> m b
after a -> m c
thing = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
C.generalBracket m a
before forall {a}. a -> ExitCase a -> m ()
cAfter a -> m c
thing
  where
    -- ignore the exception from after, see bracket for explanation
    cAfter :: a -> ExitCase a -> m ()
cAfter a
x (C.ExitCaseException SomeException
se) =
        forall (m :: * -> *) a. MonadMask m => m a -> m a
C.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadMask m => m a -> m ()
ignoreExceptions forall a b. (a -> b) -> a -> b
$ a -> m b
after a
x
    cAfter a
x ExitCase a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | A variant of 'bracketOnError' where the return value from the first
-- computation is not required.
--
-- @since 0.1.0.0
bracketOnError_ :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m c -> m c
bracketOnError_ :: forall (m :: * -> *) a b c. MonadMask m => m a -> m b -> m c -> m c
bracketOnError_ m a
before m b
after m c
thing = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a b c.
MonadMask 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)

-- | Async safe version of 'E.bracket' with access to the exception in the
-- cleanup action.
--
-- @since 0.1.7.0
bracketWithError :: forall m a b c. HAS_CALL_STACK => C.MonadMask m
        => m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketWithError :: forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketWithError m a
before Maybe SomeException -> a -> m b
after a -> m c
thing = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. a -> a
withFrozenCallStack forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
C.generalBracket m a
before forall {a}. a -> ExitCase a -> m ()
cAfter a -> m c
thing
  where
    cAfter :: a -> ExitCase a -> m ()
cAfter a
x (C.ExitCaseException SomeException
se) =
        forall (m :: * -> *) a. MonadMask m => m a -> m a
C.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadMask m => m a -> m ()
ignoreExceptions forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> a -> m b
after (forall a. a -> Maybe a
Just SomeException
se) a
x
    cAfter a
x ExitCase a
_ =
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadMask m => m a -> m a
C.uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> a -> m b
after forall a. Maybe a
Nothing a
x

-- | Internal function that swallows all exceptions, used in some bracket-like
-- combinators. When it's run inside of uninterruptibleMask, we know that
-- no async exceptions can be thrown from thing, so the other exception from
-- the combinator will not be overridden.
--
-- https://github.com/fpco/safe-exceptions/issues/2
ignoreExceptions :: C.MonadMask m => m a -> m ()
ignoreExceptions :: forall (m :: * -> *) a. MonadMask m => m a -> m ()
ignoreExceptions m a
thing = forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
thing forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`C.catch` (\(SomeException
_ :: SomeException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Wrap up an asynchronous exception to be treated as a synchronous
-- exception
--
-- This is intended to be created via 'toSyncException'
--
-- @since 0.1.0.0
data SyncExceptionWrapper = forall e. Exception e => SyncExceptionWrapper e
    deriving Typeable
instance Show SyncExceptionWrapper where
    show :: SyncExceptionWrapper -> String
show (SyncExceptionWrapper e
e) = forall a. Show a => a -> String
show e
e
instance Exception SyncExceptionWrapper where
#if MIN_VERSION_base(4,8,0)
    displayException :: SyncExceptionWrapper -> String
displayException (SyncExceptionWrapper e
e) = forall e. Exception e => e -> String
displayException e
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'
--
-- @since 0.1.0.0
toSyncException :: Exception e => e -> SomeException
toSyncException :: forall e. Exception e => e -> SomeException
toSyncException e
e =
    case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
        Just (SomeAsyncException e
_) -> forall e. Exception e => e -> SomeException
toException (forall e. Exception e => e -> SyncExceptionWrapper
SyncExceptionWrapper e
e)
        Maybe SomeAsyncException
Nothing -> SomeException
se
  where
    se :: SomeException
se = forall e. Exception e => e -> SomeException
toException e
e

-- | Wrap up a synchronous exception to be treated as an asynchronous
-- exception
--
-- This is intended to be created via 'toAsyncException'
--
-- @since 0.1.0.0
data AsyncExceptionWrapper = forall e. Exception e => AsyncExceptionWrapper e
    deriving Typeable
instance Show AsyncExceptionWrapper where
    show :: AsyncExceptionWrapper -> String
show (AsyncExceptionWrapper e
e) = forall a. Show a => a -> String
show e
e
instance Exception AsyncExceptionWrapper where
    toException :: AsyncExceptionWrapper -> SomeException
toException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeAsyncException
SomeAsyncException
    fromException :: SomeException -> Maybe AsyncExceptionWrapper
fromException SomeException
se = do
        SomeAsyncException 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
#if MIN_VERSION_base(4,8,0)
    displayException :: AsyncExceptionWrapper -> String
displayException (AsyncExceptionWrapper e
e) = forall e. Exception e => e -> String
displayException e
e
#endif

-- | 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 e
e =
    case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
        Just (SomeAsyncException e
_) -> SomeException
se
        Maybe SomeAsyncException
Nothing -> forall e. Exception e => e -> SomeException
toException (forall e. Exception e => e -> AsyncExceptionWrapper
AsyncExceptionWrapper e
e)
  where
    se :: SomeException
se = forall e. Exception e => e -> SomeException
toException e
e

-- | 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 e
e =
    case forall e. Exception e => SomeException -> Maybe e
fromException (forall e. Exception e => e -> SomeException
toException e
e) of
        Just (SomeAsyncException e
_) -> Bool
False
        Maybe SomeAsyncException
Nothing -> Bool
True

-- | 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.1.0
displayException :: Exception e => e -> String
displayException = show
#endif

-- | Same as upstream 'C.catches', but will not catch asynchronous
-- exceptions
--
-- @since 0.1.2.0
catches :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a
catches :: forall (m :: * -> *) a.
(MonadCatch m, MonadThrow m) =>
m a -> [Handler m a] -> m a
catches m a
io [Handler m a]
handlers = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
io (forall (m :: * -> *) a.
MonadThrow 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.2.0
catchesDeep :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m, MonadIO m, NFData a) => m a -> [Handler m a] -> m a
catchesDeep :: forall (m :: * -> *) a.
(MonadCatch m, MonadThrow m, MonadIO m, NFData a) =>
m a -> [Handler m a] -> m a
catchesDeep m a
io [Handler m a]
handlers = forall a. a -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a. (MonadIO m, NFData a) => m a -> m a
evaluateDeep m a
io) (forall (m :: * -> *) a.
MonadThrow m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers)

-- | 'catches' without async exception safety
--
-- Generally it's better to avoid using this function since we do not want to
-- recover from async exceptions, see
-- <https://github.com/fpco/safe-exceptions#quickstart>
--
-- @since 0.1.2.0
catchesAsync :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a
catchesAsync :: forall (m :: * -> *) a.
(MonadCatch m, MonadThrow m) =>
m a -> [Handler m a] -> m a
catchesAsync m a
io [Handler m a]
handlers = m a
io forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catchAsync` forall (m :: * -> *) a.
MonadThrow m =>
[Handler m a] -> SomeException -> m a
catchesHandler [Handler m a]
handlers

catchesHandler :: HAS_CALL_STACK => (C.MonadThrow m) => [Handler m a] -> SomeException -> m a
catchesHandler :: forall (m :: * -> *) a.
MonadThrow 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 :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM SomeException
e) [Handler m a]
handlers
    where tryHandler :: Handler m a -> m a -> m a
tryHandler (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