{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, CPP #-}
-- |
-- It is often useful to distinguish between synchronous and asynchronous
-- exceptions. The common idiom is to run a user-supplied computation
-- catching any synchronous exceptions but allowing asynchronous exceptions
-- (such as user interrupt) pass through.
--
-- There's no way to know how — synchronously or asynchronously — an
-- exception was thrown, so we have to work around it by relying on the
-- exception type itself.
--
-- This module provides an extensible type for asynchronous exceptions
-- — 'SomeAsyncException' — as well as functions for catching synchronous
-- exceptions.

module Control.Exception.Async
  (
    -- * Exception class for asynchronous exceptions

    -- | To mark an exception as asynchronous:
    --
    -- >instance Exception MyException where
    -- >  fromException = asyncFromException
    -- >  toException = asyncToException
    --
    -- Note that until base 4.7 (GHC 7.8) 'AsyncException' was not a subclass
    -- of 'SomeAsyncException'. Use 'isAsynchronous' to recognize both
    -- 'AsyncException' and 'SomeAsyncException'.
    --
    -- The re-exported documentation may say «Since: 4.7.0.0» — ignore
    -- that. For older versions this package provides its own compatible
    -- definitions.
    SomeAsyncException
  , asyncExceptionToException
  , asyncExceptionFromException
    -- * Detecting asynchronous exceptions
  , isAsynchronous
    -- * Catching synchronous exceptions
  , catchSync
  , handleSync
  , trySync
  )
  where

import Control.Exception as E
import Control.Monad
import Data.Typeable
import Data.Maybe

#if !MIN_VERSION_base(4,7,0)
-- | Exception class for asynchronous exceptions
data SomeAsyncException
  = forall e . Exception e => SomeAsyncException e
  deriving Typeable

instance Exception SomeAsyncException

instance Show SomeAsyncException where
  showsPrec p (SomeAsyncException e) = showsPrec p e

-- | 'toException' implementation for asynchronous exceptions
asyncExceptionToException :: Exception e => e -> SomeException
asyncExceptionToException = toException . SomeAsyncException

-- | 'fromException' implementation for asynchronous exceptions
asyncExceptionFromException :: Exception e => SomeException -> Maybe e
asyncExceptionFromException x = do
  SomeAsyncException a <- fromException x
  cast a
#endif

-- | Check whether an exception is asynchronous
isAsynchronous :: SomeException -> Bool
isAsynchronous e =
  isJust (fromException e :: Maybe AsyncException) ||
  isJust (fromException e :: Maybe SomeAsyncException)


-- | Like 'catch', but catch any synchronous exceptions; let asynchronous ones pass through
catchSync :: IO a -> (SomeException -> IO a) -> IO a
catchSync a h =
  E.catch a $ \e ->
    if isAsynchronous e
      then throwIO e
      else h e

-- | Like 'handle', but catch any synchronous exceptions; let asynchronous ones pass through
handleSync :: (SomeException -> IO a) -> IO a -> IO a
handleSync = flip catchSync

-- | Like 'try', but catch any synchronous exceptions; let asynchronous ones pass through
trySync :: IO b -> IO (Either SomeException b)
trySync a =
  catchSync
    (liftM Right a)
    (return . Left)