{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.Control.Exception
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
-- Portability :  non-portable (extended exceptions)
--
-- This module provides support for raising and catching both built-in
-- and user-defined exceptions.
--
-- In addition to exceptions thrown by 'IO' operations, exceptions may
-- be thrown by pure code (imprecise exceptions) or by external events
-- (asynchronous exceptions), but may only be caught in the 'IO' monad.
-- For more details, see:
--
--  * /A semantics for imprecise exceptions/, by Simon Peyton Jones,
--    Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,
--    in /PLDI'99/.
--
--  * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton
--    Jones, Andy Moran and John Reppy, in /PLDI'01/.
--
--  * /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
--    by Simon Marlow, in /Haskell '06/.
--
-----------------------------------------------------------------------------

module GHC.Internal.Control.Exception (

        -- * The Exception type
        SomeException(..),
        Exception(..),          -- class
        IOException,            -- instance Eq, Ord, Show, Typeable, Exception
        ArithException(..),     -- instance Eq, Ord, Show, Typeable, Exception
        ArrayException(..),     -- instance Eq, Ord, Show, Typeable, Exception
        AssertionFailed(..),
        SomeAsyncException(..),
        AsyncException(..),     -- instance Eq, Ord, Show, Typeable, Exception
        asyncExceptionToException, asyncExceptionFromException,

        NonTermination(..),
        NestedAtomically(..),
        BlockedIndefinitelyOnMVar(..),
        BlockedIndefinitelyOnSTM(..),
        AllocationLimitExceeded(..),
        CompactionFailed(..),
        Deadlock(..),
        NoMethodError(..),
        PatternMatchFail(..),
        RecConError(..),
        RecSelError(..),
        RecUpdError(..),
        ErrorCall(..),
        TypeError(..),

        -- * Throwing exceptions
        throw,
        throwIO,
        rethrowIO,
        ioError,
        throwTo,

        -- ** The @catch@ functions
        catch,
        catchNoPropagate,
        catches, Handler(..),
        catchJust,

        -- ** Exception annotation

        -- ** The @handle@ functions
        handle,
        handleJust,

        -- ** The @try@ functions
        try,
        tryWithContext,
        tryJust,

        -- ** The @evaluate@ function
        evaluate,

        -- ** The @mapException@ function
        mapException,

        -- ** Asynchronous exception control
        mask,
        mask_,
        uninterruptibleMask,
        uninterruptibleMask_,
        MaskingState(..),
        getMaskingState,
        interruptible,
        allowInterrupt,

        -- * Assertions
        assert,

        -- * Utilities
        bracket,
        bracket_,
        bracketOnError,

        finally,
        onException,

        -- * Annotating exceptions

        ExceptionContext(..),
        annotateIO,
        WhileHandling(..),

  ) where

import GHC.Internal.Control.Exception.Base

import GHC.Internal.Base
import GHC.Internal.IO (interruptible)

-- | You need this when using 'catches'.
data Handler a = forall e . Exception e => Handler (e -> IO a)

-- | @since base-4.6.0.0
instance Functor Handler where
     fmap :: forall a b. (a -> b) -> Handler a -> Handler b
fmap a -> b
f (Handler e -> IO a
h) = (e -> IO b) -> Handler b
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((a -> b) -> IO a -> IO b
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (IO a -> IO b) -> (e -> IO a) -> e -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
h)

{- |
Sometimes you want to catch two different sorts of exception. You could
do something like

> f = expr `catch` \ (ex :: ArithException) -> handleArith ex
>          `catch` \ (ex :: IOException)    -> handleIO    ex

However, there are a couple of problems with this approach. The first is
that having two exception handlers is inefficient. However, the more
serious issue is that the second exception handler will catch exceptions
in the first, e.g. in the example above, if @handleArith@ throws an
@IOException@ then the second exception handler will catch it.

Instead, we provide a function 'catches', which would be used thus:

> f = expr `catches` [Handler (\ (ex :: ArithException) -> handleArith ex),
>                     Handler (\ (ex :: IOException)    -> handleIO    ex)]
-}
catches :: IO a -> [Handler a] -> IO a
catches :: forall a. IO a -> [Handler a] -> IO a
catches IO a
io [Handler a]
handlers = IO a
io IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` [Handler a] -> SomeException -> IO a
forall a. [Handler a] -> SomeException -> IO a
catchesHandler [Handler a]
handlers

catchesHandler :: [Handler a] -> SomeException -> IO a
catchesHandler :: forall a. [Handler a] -> SomeException -> IO a
catchesHandler [Handler a]
handlers SomeException
e = (Handler a -> IO a -> IO a) -> IO a -> [Handler a] -> IO a
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Handler a -> IO a -> IO a
forall {a}. Handler a -> IO a -> IO a
tryHandler (SomeException -> IO a
forall a e. (HasCallStack, Exception e) => e -> a
throw SomeException
e) [Handler a]
handlers
    where tryHandler :: Handler a -> IO a -> IO a
tryHandler (Handler e -> IO a
handler) IO a
res
              = case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                Just e
e' -> e -> IO a
handler e
e'
                Maybe e
Nothing -> IO a
res

-- -----------------------------------------------------------------------------
-- Asynchronous exceptions

-- | When invoked inside 'mask', this function allows a masked
-- asynchronous exception to be raised, if one exists.  It is
-- equivalent to performing an interruptible operation (see
-- #interruptible), but does not involve any actual blocking.
--
-- When called outside 'mask', or inside 'uninterruptibleMask', this
-- function has no effect.
--
-- @since base-4.4.0.0
allowInterrupt :: IO ()
allowInterrupt :: IO ()
allowInterrupt = IO () -> IO ()
forall a. IO a -> IO a
interruptible (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()