    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE TypeFamilies #-}

    -- | The purpose of this module is to allow you to capture all exceptions
    -- originating from within the enclosed computation, while still reacting
    -- to asynchronous exceptions aimed at the calling thread.
    --
    -- This way, you can be sure that the function that calls, for example,
    -- @'catchAny'@, will still respond to @'ThreadKilled'@ or @'Timeout'@
    -- events raised by another thread (with @'throwTo'@), while capturing
    -- all exceptions, synchronous or asynchronous, resulting from the
    -- execution of the enclosed computation.
    --
    -- One particular use case is to allow the safe execution of code from various
    -- libraries (which you do not control), capturing any faults that might
    -- occur, while remaining responsive to higher level events and control
    -- actions.
    --
    -- This library was originally developed by Michael Snoyman for the
    -- 'ClassyPrelude' library, and was latter 'spun-off' into a separate
    -- independent package.
    --
    -- For a more detailed explanation of the motivation behind this functions,
    -- see:
    --
    -- <https://www.fpcomplete.com/user/snoyberg/general-haskell/exceptions/catching-all-exceptions>
    --
    -- and
    --
    -- <https://groups.google.com/forum/#!topic/haskell-cafe/e9H2I-3uVJE>
    --
    module Control.Exception.Enclosed
        ( -- ** Exceptions
          catchAny
        , handleAny
        , tryAny
        , catchDeep
        , catchAnyDeep
        , handleAnyDeep
        , tryDeep
        , tryAnyDeep
        , catchIO
        , handleIO
        , tryIO
          -- ** Force types
          -- | Helper functions for situations where type inferer gets confused.
        , asIOException
        , asSomeException
        ) where

    import Prelude
    import Control.Concurrent (forkIOWithUnmask)
    import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
    import Control.Exception
    import Control.Monad (liftM)
    import Control.Monad.Base (liftBase)
    import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM)
    import Control.DeepSeq (NFData, ($!!))

    import qualified Control.Exception.Lifted

    -- | A version of 'catch' which is specialized for any exception. This
    -- simplifies usage as no explicit type signatures are necessary.
    --
    -- Note that since version 0.5.9, this function now has proper support for
    -- asynchronous exceptions, by only catching exceptions generated by the
    -- internal (enclosed) action.
    --
    -- Since 0.5.6
    catchAny :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a
    catchAny :: forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> (SomeException -> m a) -> m a
    catchAny m a
    action SomeException -> m a
    onE = m a -> m (Either SomeException a)
    forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> m (Either SomeException a)
    tryAny m a
    action m (Either SomeException a)
    -> (Either SomeException a -> m a) -> m a
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (SomeException -> m a)
    -> (a -> m a) -> Either SomeException a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> m a
    onE a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | A version of 'handle' which is specialized for any exception.  This
    -- simplifies usage as no explicit type signatures are necessary.
    --
    -- Note that since version 0.5.9, this function now has proper support for
    -- asynchronous exceptions, by only catching exceptions generated by the
    -- internal (enclosed) action.
    --
    -- Since 0.5.6
    handleAny :: MonadBaseControl IO m => (SomeException -> m a) -> m a -> m a
    handleAny :: forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny = (m a -> (SomeException -> m a) -> m a)
    -> (SomeException -> m a) -> m a -> m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip m a -> (SomeException -> m a) -> m a
    forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> (SomeException -> m a) -> m a
    catchAny

    -- | A version of 'try' which is specialized for any exception.
    -- This simplifies usage as no explicit type signatures are necessary.
    --
    -- Note that since version 0.5.9, this function now has proper support for
    -- asynchronous exceptions, by only catching exceptions generated by the
    -- internal (enclosed) action.
    --
    -- Since 0.5.6
    tryAny :: MonadBaseControl IO m => m a -> m (Either SomeException a)
    tryAny :: forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> m (Either SomeException a)
    tryAny m a
    m =
        (RunInBase m IO -> IO (Either SomeException (StM m a)))
    -> m (Either SomeException (StM m a))
    forall a. (RunInBase m IO -> IO a) -> m a
    forall (b :: * -> *) (m :: * -> *) a.
    MonadBaseControl b m =>
    (RunInBase m b -> b a) -> m a
    liftBaseWith (\RunInBase m IO
    runInIO -> IO (StM m a) -> IO (Either SomeException (StM m a))
    forall a. IO a -> IO (Either SomeException a)
    tryAnyIO (m a -> IO (StM m a)
    RunInBase m IO
    runInIO m a
    m)) m (Either SomeException (StM m a))
    -> (Either SomeException (StM m a) -> m (Either SomeException a))
    -> m (Either SomeException a)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
        (SomeException -> m (Either SomeException a))
    -> (StM m a -> m (Either SomeException a))
    -> Either SomeException (StM m a)
    -> m (Either SomeException a)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Either SomeException a -> m (Either SomeException a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either SomeException a -> m (Either SomeException a))
    -> (SomeException -> Either SomeException a)
    -> SomeException
    -> m (Either SomeException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> Either SomeException a
    forall a b. a -> Either a b
    Left) ((a -> Either SomeException a) -> m a -> m (Either SomeException a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Either SomeException a
    forall a b. b -> Either a b
    Right (m a -> m (Either SomeException a))
    -> (StM m a -> m a) -> StM m a -> m (Either SomeException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StM m a -> m a
    forall a. StM m a -> m a
    forall (b :: * -> *) (m :: * -> *) a.
    MonadBaseControl b m =>
    StM m a -> m a
    restoreM)
      where
        tryAnyIO :: IO a -> IO (Either SomeException a)
        tryAnyIO :: forall a. IO a -> IO (Either SomeException a)
    tryAnyIO IO a
    action = do
            result <- IO (MVar (Either SomeException a))
    forall a. IO (MVar a)
    newEmptyMVar
            bracket
                (forkIOWithUnmask (\forall a. IO a -> IO a
    restore -> IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO a -> IO a
    forall a. IO a -> IO a
    restore IO a
    action) IO (Either SomeException a)
    -> (Either SomeException a -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MVar (Either SomeException a) -> Either SomeException a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (Either SomeException a)
    result))
                (\ThreadId
    t -> ThreadId -> AsyncException -> IO ()
    forall e. Exception e => ThreadId -> e -> IO ()
    throwTo ThreadId
    t AsyncException
    ThreadKilled)
                (\ThreadId
    _ -> Int -> IO (Either SomeException a) -> IO (Either SomeException a)
    forall a. Int -> IO a -> IO a
    retryCount Int
    10 (MVar (Either SomeException a) -> IO (Either SomeException a)
    forall a. MVar a -> IO a
    readMVar MVar (Either SomeException a)
    result))

        -- If the action supplied by the user ends up blocking on an MVar
        -- or STM action, all threads currently blocked on such an action will
        -- receive an exception. In general, this is a good thing from the GHC
        -- RTS, but it is counter-productive for our purposes, where we know that
        -- when the user action receives such an exception, our code above will
        -- unblock and our main thread will not deadlock.
        --
        -- Workaround: we retry the readMVar action if we received a
        -- BlockedIndefinitelyOnMVar. To remain on the safe side and avoid
        -- deadlock, we cap this at an arbitrary number (10) above so that, if
        -- there's a bug in this function, the runtime system can still recover.
        --
        -- For previous discussion of this topic, see:
        -- https://github.com/simonmar/async/pull/15
        retryCount :: Int -> IO a -> IO a
        retryCount :: forall a. Int -> IO a -> IO a
    retryCount Int
    cnt0 IO a
    action =
            Int -> IO a
    loop Int
    cnt0
          where
            loop :: Int -> IO a
    loop Int
    0 = IO a
    action
            loop Int
    cnt = IO a
    action IO a -> (BlockedIndefinitelyOnMVar -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `Control.Exception.catch`
                \BlockedIndefinitelyOnMVar
    BlockedIndefinitelyOnMVar -> Int -> IO a
    loop (Int
    cnt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    -- | An extension to @catch@ which ensures that the return value is fully
    -- evaluated. See @tryAny@.
    --
    -- Since 1.0.1
    catchDeep :: (Exception e, NFData a, MonadBaseControl IO m) => m a -> (e -> m a) -> m a
    catchDeep :: forall e a (m :: * -> *).
    (Exception e, NFData a, MonadBaseControl IO m) =>
    m a -> (e -> m a) -> m a
    catchDeep m a
    action e -> m a
    onE = m a -> m (Either e a)
    forall e a (m :: * -> *).
    (Exception e, NFData a, MonadBaseControl IO m) =>
    m a -> m (Either e a)
    tryDeep m a
    action m (Either e a) -> (Either e a -> m a) -> m a
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (e -> m a) -> (a -> m a) -> Either e a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either e -> m a
    onE a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | An extension to @catchAny@ which ensures that the return value is fully
    -- evaluated. See @tryAnyDeep@.
    --
    -- Since 0.5.9
    catchAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> (SomeException -> m a) -> m a
    catchAnyDeep :: forall a (m :: * -> *).
    (NFData a, MonadBaseControl IO m) =>
    m a -> (SomeException -> m a) -> m a
    catchAnyDeep m a
    action SomeException -> m a
    onE = m a -> m (Either SomeException a)
    forall a (m :: * -> *).
    (NFData a, MonadBaseControl IO m) =>
    m a -> m (Either SomeException a)
    tryAnyDeep m a
    action m (Either SomeException a)
    -> (Either SomeException a -> m a) -> m a
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (SomeException -> m a)
    -> (a -> m a) -> Either SomeException a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> m a
    onE a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | @flip catchAnyDeep@
    --
    -- Since 0.5.6
    handleAnyDeep :: (NFData a, MonadBaseControl IO m) => (SomeException -> m a) -> m a -> m a
    handleAnyDeep :: forall a (m :: * -> *).
    (NFData a, MonadBaseControl IO m) =>
    (SomeException -> m a) -> m a -> m a
    handleAnyDeep = (m a -> (SomeException -> m a) -> m a)
    -> (SomeException -> m a) -> m a -> m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip m a -> (SomeException -> m a) -> m a
    forall a (m :: * -> *).
    (NFData a, MonadBaseControl IO m) =>
    m a -> (SomeException -> m a) -> m a
    catchAnyDeep

    -- | an extension to @try@ which ensures that the return value is fully
    -- evaluated. in other words, if you get a @right@ response here, you can be
    -- confident that using it will not result in another exception.
    --
    -- Since 1.0.1
    tryDeep :: (Exception e, NFData a, MonadBaseControl IO m)
            => m a
            -> m (Either e a)
    tryDeep :: forall e a (m :: * -> *).
    (Exception e, NFData a, MonadBaseControl IO m) =>
    m a -> m (Either e a)
    tryDeep m a
    m = m a -> m (Either e a)
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> m (Either e a)
    Control.Exception.Lifted.try (m a -> m (Either e a)) -> m a -> m (Either e a)
    forall a b. (a -> b) -> a -> b
    $ do
        x <- m a
    m
        liftBase $ evaluate $!! x

    -- | an extension to @tryany@ which ensures that the return value is fully
    -- evaluated. in other words, if you get a @right@ response here, you can be
    -- confident that using it will not result in another exception.
    --
    -- Since 0.5.9
    tryAnyDeep :: (NFData a, MonadBaseControl IO m)
               => m a
               -> m (Either SomeException a)
    tryAnyDeep :: forall a (m :: * -> *).
    (NFData a, MonadBaseControl IO m) =>
    m a -> m (Either SomeException a)
    tryAnyDeep m a
    m = m a -> m (Either SomeException a)
    forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> m (Either SomeException a)
    tryAny (m a -> m (Either SomeException a))
    -> m a -> m (Either SomeException a)
    forall a b. (a -> b) -> a -> b
    $ do
        x <- m a
    m
        liftBase $ evaluate $!! x

    -- | A version of 'catch' which is specialized for IO exceptions. This
    -- simplifies usage as no explicit type signatures are necessary.
    --
    -- Since 0.5.6
    catchIO :: MonadBaseControl IO m => m a -> (IOException -> m a) -> m a
    catchIO :: forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> (IOException -> m a) -> m a
    catchIO = m a -> (IOException -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    Control.Exception.Lifted.catch

    -- | A version of 'handle' which is specialized for IO exceptions.  This
    -- simplifies usage as no explicit type signatures are necessary.
    --
    -- Since 0.5.6
    handleIO :: MonadBaseControl IO m => (IOException -> m a) -> m a -> m a
    handleIO :: forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    (IOException -> m a) -> m a -> m a
    handleIO = (IOException -> m a) -> m a -> m a
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    (e -> m a) -> m a -> m a
    Control.Exception.Lifted.handle

    -- | A version of 'try' which is specialized for IO exceptions.
    -- This simplifies usage as no explicit type signatures are necessary.
    --
    -- Since 0.5.6
    tryIO :: MonadBaseControl IO m => m a -> m (Either IOException a)
    tryIO :: forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> m (Either IOException a)
    tryIO = m a -> m (Either IOException a)
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> m (Either e a)
    Control.Exception.Lifted.try

    -- |
    --
    -- Since 0.5.6
    asSomeException :: SomeException -> SomeException
    asSomeException :: SomeException -> SomeException
    asSomeException = SomeException -> SomeException
    forall a. a -> a
    id

    -- |
    --
    -- Since 0.5.6
    asIOException :: IOException -> IOException
    asIOException :: IOException -> IOException
    asIOException = IOException -> IOException
    forall a. a -> a
    id