asynchronous-exceptions-1.0: Control/Exception/Async.hs

{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification #-}
-- |
-- 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
  ( SomeAsyncException
  , asyncToException
  , asyncFromException
  , isAsynchronous
  , catchSync
  , handleSync
  , trySync
  )
  where

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

-- | Exception class for asynchronous exceptions.
--
-- To mark an exception as asynchronous:
--
-- >instance Exception MyException where
-- >  fromException = asyncFromException
-- >  toException = asyncToException
--
-- Note that as of base 4.6, 'AsyncException' is not yet a subclass of
-- 'SomeAsyncException'. Use 'isAsynchronous' to recognize both
-- 'AsyncException' and 'SomeAsyncException'.
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
asyncToException :: Exception e => e -> SomeException
asyncToException = toException . SomeAsyncException

-- | 'fromException' implementation for asynchronous exceptions
asyncFromException :: Exception e => SomeException -> Maybe e
asyncFromException x = do
  SomeException e <- fromException x
  cast e

-- | 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)