Commit 3373ca90 authored by Sven Tennie's avatar Sven Tennie 😺
Browse files

Introduce SomeExceptionWithLocation

parent ebc21bd7
......@@ -74,10 +74,18 @@ module Control.Monad.Catch (
, bracketOnError
-- * Re-exports from Control.Exception
, Exception(..)
#if __GLASGOW_HASKELL__ >= 903
, SomeExceptionWithLocation(..)
#else
, SomeException(..)
#endif
) where
#if __GLASGOW_HASKELL__ >= 903
import Control.Exception (Exception(..), SomeExceptionWithLocation(..))
#else
import Control.Exception (Exception(..), SomeException(..))
#endif
import qualified Control.Exception as ControlException
import qualified Control.Monad.STM as STM
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS
......@@ -118,6 +126,10 @@ import Data.Monoid
import Control.Applicative
#endif
#if __GLASGOW_HASKELL__ < 903
type SomeExceptionWithLocation = SomeException
#endif
------------------------------------------------------------------------------
-- $mtl
-- The mtl style typeclass
......@@ -316,7 +328,7 @@ class MonadCatch m => MonadMask m where
-- ('ExitCaseAbort').
data ExitCase a
= ExitCaseSuccess a
| ExitCaseException SomeException
| ExitCaseException SomeExceptionWithLocation
| ExitCaseAbort
deriving Show
......@@ -350,17 +362,18 @@ instance MonadThrow STM where
instance MonadCatch STM where
catch = STM.catchSTM
instance e ~ SomeException => MonadThrow (Either e) where
instance e ~ SomeExceptionWithLocation => MonadThrow (Either e) where
throwM = Left . toException
-- | @since 0.8.3
instance e ~ SomeException => MonadCatch (Either e) where
instance e ~ SomeExceptionWithLocation => MonadCatch (Either e) where
catch (Left e) f =
case fromException e of
Nothing -> Left e
Just e' -> f e'
catch x@(Right _) _ = x
-- | @since 0.8.3
instance e ~ SomeException => MonadMask (Either e) where
instance e ~ SomeExceptionWithLocation => MonadMask (Either e) where
mask f = f id
uninterruptibleMask f = f id
......@@ -740,7 +753,7 @@ uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
--
-- /NOTE/ This catches all /exceptions/, but if the monad supports other ways of
-- aborting the computation, those other kinds of errors will not be caught.
catchAll :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchAll :: MonadCatch m => m a -> (SomeExceptionWithLocation -> m a) -> m a
catchAll = catch
-- | Catch all 'IOError' (eqv. 'IOException') exceptions. Still somewhat too
......@@ -771,7 +784,7 @@ handleIOError :: MonadCatch m => (IOError -> m a) -> m a -> m a
handleIOError = handle
-- | Flipped 'catchAll'
handleAll :: MonadCatch m => (SomeException -> m a) -> m a -> m a
handleAll :: MonadCatch m => (SomeExceptionWithLocation -> m a) -> m a -> m a
handleAll = handle
-- | Flipped 'catchIf'
......
......@@ -63,6 +63,11 @@ import Data.Foldable
import Data.Functor.Identity
import Data.Traversable as Traversable
#if __GLASGOW_HASKELL__ < 903
type SomeExceptionWithLocation = SomeException
#endif
------------------------------------------------------------------------------
-- $mtl
-- The mtl style typeclass
......@@ -91,11 +96,11 @@ import Data.Traversable as Traversable
-- >>> runCatchT $ (throwM (ErrorCall "Hello!") :: CatchT IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e)
-- Hello!
newtype CatchT m a = CatchT { runCatchT :: m (Either SomeException a) }
newtype CatchT m a = CatchT { runCatchT :: m (Either SomeExceptionWithLocation a) }
type Catch = CatchT Identity
runCatch :: Catch a -> Either SomeException a
runCatch :: Catch a -> Either SomeExceptionWithLocation a
runCatch = runIdentity . runCatchT
instance Monad m => Functor (CatchT m) where
......@@ -212,7 +217,7 @@ instance MonadRWS r w s m => MonadRWS r w s (CatchT m)
-- | Map the unwrapped computation using the given function.
--
-- @'runCatchT' ('mapCatchT' f m) = f ('runCatchT' m)@
mapCatchT :: (m (Either SomeException a) -> n (Either SomeException b))
mapCatchT :: (m (Either SomeExceptionWithLocation a) -> n (Either SomeExceptionWithLocation b))
-> CatchT m a
-> CatchT n b
mapCatchT f m = CatchT $ f (runCatchT m)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment