diff --git a/Control/Monad/Exception.hs b/Control/Monad/Exception.hs --- a/Control/Monad/Exception.hs +++ b/Control/Monad/Exception.hs @@ -1,171 +1,15 @@ -{-# LANGUAGE CPP #-} {-| A Monad Transformer for explicitly typed checked exceptions, described in detail by: - * Jose Iborra, \"Explicitly Typed Exceptions for Haskell", - PADL'10, January 2010, - -The exceptions thrown by a computation are inferred by the typechecker -and appear in the type signature of the computation as 'Throws' constraints. - -Exceptions are defined using the extensible exceptions framework of Marlow (documented in "Control.Exception"): - - * /An Extensible Dynamically-Typed Hierarchy of Exceptions/, by Simon Marlow, in /Haskell '06/. - - /Example/ - - > data DivideByZero = DivideByZero deriving (Show, Typeable) - > data SumOverflow = SumOverflow deriving (Show, Typeable) - - > instance Exception DivideByZero - > instance Exception SumOverflow - - > data Expr = Add Expr Expr | Div Expr Expr | Val Double - - > eval (Val x) = return x - > eval (Add a1 a2) = do - > v1 <- eval a1 - > v2 <- eval a2 - > let sum = v1 + v2 - > if sum < v1 || sum < v2 then throw SumOverflow else return sum - > eval (Div a1 a2) = do - > v1 <- eval a1 - > v2 <- eval a2 - > if v2 == 0 then throw DivideByZero else return (v1 / v2) - - GHCi infers the following types - - > eval :: (Throws DivideByZero l, Throws SumOverflow l) => Expr -> EM l Double - > eval `catch` \ (e::DivideByZero) -> return (-1) :: Throws SumOverflow l => Expr -> EM l Double - > runEM(eval `catch` \ (e::SomeException) -> return (-1)) - > :: Expr -> Double --} - -module Control.Monad.Exception ( --- * Important trivia --- ** Hierarchies of Exceptions --- $hierarchies - --- ** Unchecked exceptions --- *** Unchecked exceptions --- $unchecked - --- ** Stack Traces --- $stacktraces - --- ** Understanding GHC errors --- $errors - --- * The EM monad - EM, tryEM, runEM, runEMParanoid, - --- * The EMT monad transformer - EMT(..), CallTrace, tryEMT, runEMT, runEMTParanoid, AnyException, UncaughtException, - --- ** The Throws type class - Throws, Caught, - --- * Exception primitives - throw, rethrow, Control.Monad.Exception.Base.catch, Control.Monad.Exception.Base.catchWithSrcLoc, - finally, onException, bracket, wrapException, - - showExceptionWithTrace, - FailException(..), MonadZeroException(..), mplusDefault, - --- * Reexports - Exception(..), SomeException(..), Typeable(..), - Failure(..), -#if !MIN_VERSION_failure(0,2,0) - Try(..), NothingException(..), - WrapFailure(..), -#endif - MonadLoc(..), withLocTH -) where - -import Control.Monad.Exception.Base -import Control.Monad.Exception.Catch -import Control.Failure -import Control.Monad.Loc -import Control.Monad.Loc.TH -import Data.Typeable - -{- $hierarchies - If your sets of exceptions are hierarchical then you need to - teach 'Throws' about the hierarchy. See the documentation of - 'Throws' for more info. --} -{- $unchecked -An exception @E@ can be declared as unchecked by making @E@ an instance of - 'UncaughtException'. - -> instance UncaughtException E - - @E@ will still appear in the list of exceptions thrown - by a computation but 'runEMT' will not complain if @E@ escapes the computation - being run. - -Also, 'tryEMT' allows you to run a computation regardless of the exceptions it throws. --} - - -{- $stacktraces - Stack traces are provided via the "MonadLoc" package. - All you need to do is add the following pragma at the top of your Haskell - source files and use do-notation: - -> { # OPTIONS_GHC -F -pgmF MonadLoc # } - - Only statements in do blocks appear in the stack trace. - - Example: - -> f () = do throw MyException -> g a = do f a -> -> main = runEMT $ do -> g () `catchWithSrcLoc` -> \loc (e::MyException) -> lift(putStrLn$ showExceptionWithTrace loc e) - -> -- Running main produces the output: - -> *Main> main -> MyException -> in f, Main(example.hs): (1,6) -> g, Main(example.hs): (2,6) -> main, Main(example.hs): (5,9) -> main, Main(example.hs): (4,16) + * Jose Iborra, \"Explicitly Typed Exceptions for Haskell\", + PADL'10, January 2010, +"Control.Monad.Exception.Pure" provides the classic, Either based monad, +whereas "Control.Monad.Exception.IO" provides a more advanced IO based monad with +the ability to handle asynchronous exceptions as well. -} - -{- $errors -A type error of the form: - -> No instance for (UncaughtException MyException) -> arising from a use of `g' at examples/docatch.hs:21:32-35 -> Possible fix: -> add an instance declaration for (UncaughtException MyException) -> In the expression: g () - -is the type checker saying: - -\"hey, you are trying to run a computation which throws a @MyException@ without handling it, and I won't let you\" - -Either handle it or declare @MyException@ as an 'UncaughtException'. - -A type error of the form: - -> Overlapping instances for Throws MyException (Caught e NoExceptions) -> arising from a use of `g' at docatch.hs:24:3-6 -> Matching instances: -> instance (Throws e l) => Throws e (Caught e' l) -> -- Defined at ../Control/Monad/Exception/Throws.hs:46:9-45 -> instance (Exception e) => Throws e (Caught e l) -> -- Defined at ../Control/Monad/Exception/Throws.hs:47:9-44 -> (The choice depends on the instantiation of `e' -> ... +module Control.Monad.Exception ( module Control.Monad.Exception.Pure ) where -is due to an exception handler for @MyException@ -missing a type annotation to pin down the type of the exception. --} +import Control.Monad.Exception.Pure diff --git a/Control/Monad/Exception/Base.hs b/Control/Monad/Exception/Base.hs --- a/Control/Monad/Exception/Base.hs +++ b/Control/Monad/Exception/Base.hs @@ -5,52 +5,15 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverlappingInstances #-} - -{-| -A Monad Transformer for explicitly typed checked exceptions. - -The exceptions thrown by a computation are inferred by the typechecker -and appear in the type signature of the computation as 'Throws' constraints. - -Exceptions are defined using the extensible exceptions framework of Marlow (documented in "Control.Exception"): - - * /An Extensible Dynamically-Typed Hierarchy of Exceptions/, by Simon Marlow, in /Haskell '06/. - - /Example/ - - > data DivideByZero = DivideByZero deriving (Show, Typeable) - > data SumOverflow = SumOverflow deriving (Show, Typeable) - - > instance Exception DivideByZero - > instance Exception SumOverflow - - > data Expr = Add Expr Expr | Div Expr Expr | Val Double - - > eval (Val x) = return x - > eval (Add a1 a2) = do - > v1 <- eval a1 - > v2 <- eval a2 - > let sum = v1 + v2 - > if sum < v1 || sum < v2 then throw SumOverflow else return sum - > eval (Div a1 a2) = do - > v1 <- eval a1 - > v2 <- eval a2 - > if v2 == 0 then throw DivideByZero else return (v1 / v2) - - GHCi infers the following types - - > eval :: (Throws DivideByZero l, Throws SumOverflow l) => Expr -> EM l Double - > eval `catch` \ (e::DivideByZero) -> return (-1) :: Throws SumOverflow l => Expr -> EM l Double - > runEM(eval `catch` \ (e::SomeException) -> return (-1)) - > :: Expr -> Double --} module Control.Monad.Exception.Base where -import qualified Control.Exception as CE import Control.Applicative +import Control.Arrow +import Control.Monad.Base import Control.Monad.Exception.Catch import Control.Monad.Loc import Control.Monad.Trans.Class +import Control.Monad.Trans.Control import Control.Monad.IO.Class import Control.Failure import Control.Monad.Fix @@ -67,10 +30,10 @@ tryEMT (EMT m) = mapLeft (checkedException.snd) `liftM` m tryEMTWithLoc :: Monad m => EMT AnyException m a -> m (Either (CallTrace, SomeException) a) -tryEMTWithLoc = liftM (mapLeft (\(l,ce) -> (l, checkedException ce))) . unEMT +tryEMTWithLoc = liftM (mapLeft (second checkedException)) . unEMT -runEMT_gen :: forall l m a . Monad m => EMT l m a -> m a -runEMT_gen (EMT m) = m >>= \x -> +runEMTGen :: forall l m a . Monad m => EMT l m a -> m a +runEMTGen (EMT m) = m >>= \x -> case x of Right x -> return x Left (loc,e) -> error (showExceptionWithTrace loc (checkedException e)) @@ -83,11 +46,11 @@ -- | Run a safe computation runEMT :: Monad m => EMT NoExceptions m a -> m a -runEMT = runEMT_gen +runEMT = runEMTGen -- | Run a safe computation checking even unchecked ('UncaughtException') exceptions runEMTParanoid :: Monad m => EMT ParanoidMode m a -> m a -runEMTParanoid = runEMT_gen +runEMTParanoid = runEMTGen instance Monad m => Functor (EMT l m) where fmap f emt = EMT $ do @@ -128,10 +91,20 @@ instance MonadTrans (EMT l) where lift = EMT . liftM Right -instance (Exception e, Monad m) => MonadCatch e (EMT (Caught e l) m) (EMT l m) where - catchWithSrcLoc = Control.Monad.Exception.Base.catchWithSrcLoc - catch = Control.Monad.Exception.Base.catch +instance MonadBase b m => MonadBase b (EMT l m) where + liftBase = liftBaseDefault + +instance MonadBaseControl b m => MonadBaseControl b (EMT l m) where + newtype StM (EMT l m) a = StmEMT {unStmEMT :: ComposeSt (EMT l) m a} + liftBaseWith = defaultLiftBaseWith StmEMT + restoreM = defaultRestoreM unStmEMT + +instance MonadTransControl (EMT l) where + newtype StT (EMT l) a = StEMT {unStEMT :: Either (CallTrace, CheckedException l) a} + liftWith f = EMT $ liftM return $ f $ liftM StEMT . unEMT + restoreT = EMT . liftM unStEMT + instance Monad m => MonadLoc (EMT l m) where withLoc loc (EMT emt) = EMT $ do current <- withLoc loc emt @@ -152,49 +125,6 @@ rethrow :: (Throws e l, Monad m) => CallTrace -> e -> EMT l m a rethrow callt = EMT . return . (\e -> Left (callt,e)) . CheckedException . toException - --- | The catch primitive -catch :: (Exception e, Monad m) => EMT (Caught e l) m a -> (e -> EMT l m a) -> EMT l m a -catch emt h = Control.Monad.Exception.Base.catchWithSrcLoc emt (\_ -> h) - --- | Like 'Control.Monad.Exception.Base.catch' but makes the call trace available -catchWithSrcLoc :: (Exception e, Monad m) => EMT (Caught e l) m a -> (CallTrace -> e -> EMT l m a) -> EMT l m a -catchWithSrcLoc emt h = EMT $ do - v <- unEMT emt - case v of - Right x -> return (Right x) - Left (trace, CheckedException e) -> case fromException e of - Nothing -> return (Left (trace,CheckedException e)) - Just e' -> unEMT (h trace e') - - --- | Sequence two computations discarding the result of the second one. --- If the first computation rises an exception, the second computation is run --- and then the exception is rethrown. -finally :: Monad m => EMT l m a -> EMT l m b -> EMT l m a -finally m sequel = do { v <- m `onException` sequel; _ <- sequel; return v} - - --- | Like finally, but performs the second computation only when the first one --- rises an exception -onException :: Monad m => EMT l m a -> EMT l m b -> EMT l m a -onException (EMT m) (EMT sequel) = EMT $ do - ev <- m - case ev of - Left{} -> do { _ <- sequel; return ev} - Right{} -> return ev - -bracket :: Monad m => EMT l m a -- ^ acquire resource - -> (a -> EMT l m b) -- ^ release resource - -> (a -> EMT l m c) -- ^ computation - -> EMT l m c -bracket acquire release run = do { k <- acquire; run k `finally` (release k) } - --- | Capture an exception e, wrap it, and rethrow. --- Keeps the original monadic call trace. -wrapException :: (Exception e, Throws e' l, Monad m) => (e -> e') -> EMT (Caught e l) m a -> EMT l m a -wrapException mkE m = m `Control.Monad.Exception.Base.catchWithSrcLoc` \loc e -> rethrow loc (mkE e) - showExceptionWithTrace :: Exception e => [String] -> e -> String showExceptionWithTrace [] e = show e showExceptionWithTrace trace e = unlines ( show e @@ -240,6 +170,9 @@ mzero = throw MonadZeroException mplus = mplusDefault +instance (Throws MonadZeroException l) => Alternative (EM l) where + (<|>) = mplus + empty = mzero -- ----------- -- Exceptions -- ----------- @@ -266,8 +199,5 @@ mapLeft _ (Right x) = Right x -instance (Throws SomeException l, MonadIO m) => MonadIO (EMT l m) where - liftIO m = EMT (liftIO m') where - m' = liftM Right m - `CE.catch` - \(e::SomeException) -> return (Left ([], CheckedException e)) +instance MonadIO m => MonadIO (EMT l m) where + liftIO = lift . liftIO diff --git a/Control/Monad/Exception/Catch.hs b/Control/Monad/Exception/Catch.hs --- a/Control/Monad/Exception/Catch.hs +++ b/Control/Monad/Exception/Catch.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} diff --git a/Control/Monad/Exception/IO.hs b/Control/Monad/Exception/IO.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Exception/IO.hs @@ -0,0 +1,229 @@ +{-# LANGUAGE CPP #-} + +{-| +A monad transformer for explicitly typed checked exceptions with support for asynchronous exception handling. Explicit exceptions are supported by the ideas described in: + + * Jose Iborra, \"Explicitly Typed Exceptions for Haskell\", + PADL'10, January 2010, + +The exceptions thrown by a computation are inferred by the typechecker +and appear in the type signature of the computation as 'Throws' constraints. + +Support for asynchronous exceptions is provided by the monad-control package. + + /Example/ + + > data DivideByZero = DivideByZero deriving (Show, Typeable) + > data SumOverflow = SumOverflow deriving (Show, Typeable) + + > instance Exception DivideByZero + > instance Exception SumOverflow + + > data Expr = Add Expr Expr | Div Expr Expr | Val Double + + > eval (Val x) = return x + > eval (Add a1 a2) = do + > v1 <- eval a1 + > v2 <- eval a2 + > let sum = v1 + v2 + > if sum < v1 || sum < v2 then throw SumOverflow else return sum + > eval (Div a1 a2) = do + > v1 <- eval a1 + > v2 <- eval a2 + > if v2 == 0 then throw DivideByZero else return (v1 / v2) + + GHCi infers the following types + + > eval :: (Throws DivideByZero l, Throws SumOverflow l) => Expr -> EM l Double + > eval `catch` \ (e::DivideByZero) -> return (-1) :: Throws SumOverflow l => Expr -> EM l Double + > runEM(eval `catch` \ (e::SomeException) -> return (-1)) + > :: Expr -> Double +-} + +module Control.Monad.Exception.IO ( +-- * Important trivia +-- ** Hierarchies of Exceptions +-- $hierarchies + +-- ** Unchecked exceptions +-- *** Unchecked exceptions +-- $unchecked + +-- ** Stack Traces +-- $stacktraces + +-- ** Understanding GHC errors +-- $errors + +-- * The EM monad + EM, tryEM, tryEMWithLoc, runEM, runEMParanoid, + +-- * The EMT monad transformer + EMT(..), CallTrace, tryEMT, tryEMTWithLoc, runEMT, runEMTParanoid, AnyException, UncaughtException, + +-- ** The Throws type class + Throws, Caught, + +-- * Exception primitives + throw, rethrow, catch, catchWithSrcLoc, + finally, onException, bracket, wrapException, + + showExceptionWithTrace, + FailException(..), MonadZeroException(..), mplusDefault, + +-- * Reexports + Exception(..), SomeException(..), Typeable, + Failure(..), +#if !MIN_VERSION_failure(0,2,0) + Try(..), NothingException(..), + WrapFailure(..), +#endif +) where + +import Control.Monad.Exception.Base +import Control.Monad.Exception.Throws +import Control.Monad.Exception.Catch (Exception, SomeException, fromException, MonadCatch) +import qualified Control.Monad.Exception.Catch +import Control.Failure +import Control.Monad.Trans.Control +import Data.Typeable +import Control.Exception.Lifted as CE (try) + +{- $hierarchies + If exceptions are hierarchical then you need to + teach 'Throws' about the hierarchy. See the documentation of + 'Throws' for more info. +-} +{- $unchecked +An exception @E@ can be declared as unchecked by making @E@ an instance of + 'UncaughtException'. + +> instance UncaughtException E + + @E@ will still appear in the list of exceptions thrown + by a computation but 'runEMT' will not complain if @E@ escapes the computation + being run. + +Also, 'tryEMT' allows you to run a computation regardless of the exceptions it throws. +-} + + +{- $stacktraces + Stack traces are provided via the "MonadLoc" package. + All you need to do is add the following pragma at the top of your Haskell + source files and use do-notation: + +> { # OPTIONS_GHC -F -pgmF MonadLoc # } + + Only statements in do blocks appear in the stack trace. + + Example: + +> f () = do throw MyException +> g a = do f a +> +> main = runEMT $ do +> g () `catchWithSrcLoc` +> \loc (e::MyException) -> lift(putStrLn$ showExceptionWithTrace loc e) + +> -- Running main produces the output: + +> *Main> main +> MyException +> in f, Main(example.hs): (1,6) +> g, Main(example.hs): (2,6) +> main, Main(example.hs): (5,9) +> main, Main(example.hs): (4,16) + +-} + + +{- $errors +A type error of the form: + +> No instance for (UncaughtException MyException) +> arising from a use of `g' at examples/docatch.hs:21:32-35 +> Possible fix: +> add an instance declaration for (UncaughtException MyException) +> In the expression: g () + +is the type checker saying: + +\"hey, you are trying to run a computation which throws a @MyException@ without handling it, and I won't let you\" + +Either handle it or declare @MyException@ as an 'UncaughtException'. + +A type error of the form: + +> Overlapping instances for Throws MyException (Caught e NoExceptions) +> arising from a use of `g' at docatch.hs:24:3-6 +> Matching instances: +> instance (Throws e l) => Throws e (Caught e' l) +> -- Defined at ../Control/Monad/Exception/Throws.hs:46:9-45 +> instance (Exception e) => Throws e (Caught e l) +> -- Defined at ../Control/Monad/Exception/Throws.hs:47:9-44 +> (The choice depends on the instantiation of `e' +> ... + +is due to an exception handler for @MyException@ +missing a type annotation to pin down the type of the exception. +-} + + +-- | The catch primitive +catch :: (Exception e, MonadBaseControl IO m) => EMT (Caught e l) m a -> (e -> EMT l m a) -> EMT l m a +catch emt h = catchWithSrcLoc emt (const h) + +unwrap :: MonadBaseControl IO m => EMT l m a -> m (Either (CallTrace, CheckedException l) a) +unwrap m = do + v <- CE.try $ unEMT m + case v of + Right x -> return x + Left e -> return (Left ([], CheckedException e)) + +-- | Catch and exception and observe the stack trace. +-- If on top of the IO monad, this will also capture asynchronous exceptions +catchWithSrcLoc :: (Exception e, MonadBaseControl IO m) => EMT (Caught e l) m a -> (CallTrace -> e -> EMT l m a) -> EMT l m a +catchWithSrcLoc emt h = EMT $ do + v <- unwrap emt + case v of + Right x -> return (Right x) + Left (trace, CheckedException e) -> handle e trace + where handle e trace = + case fromException e of + Nothing -> return (Left (trace,CheckedException e)) + Just e' -> unEMT (h trace e') + +instance (Exception e, MonadBaseControl IO m) => MonadCatch e (EMT (Caught e l) m) (EMT l m) where + catchWithSrcLoc = catchWithSrcLoc + catch = catch + +-- | Sequence two computations discarding the result of the second one. +-- If the first computation rises an exception, the second computation is run +-- and then the exception is rethrown. +finally :: MonadBaseControl IO m => EMT l m a -> EMT l m b -> EMT l m a +finally m sequel = do { v <- m `onException` sequel; _ <- sequel; return v} + + +-- | Like finally, but performs the second computation only when the first one +-- rises an exception +onException :: MonadBaseControl IO m => EMT l m a -> EMT l m b -> EMT l m a +onException m sequel = EMT $ do + ev <- unwrap m + case ev of + Left{} -> do { _ <- unEMT sequel; return ev} + Right{} -> return ev + +bracket :: MonadBaseControl IO m => + EMT l m a -- ^ acquire resource + -> (a -> EMT l m b) -- ^ release resource + -> (a -> EMT l m c) -- ^ computation + -> EMT l m c +bracket acquire release run = do { k <- acquire; run k `finally` release k } + + +-- | Capture an exception e, wrap it, and rethrow. +-- Keeps the original monadic call trace. +wrapException :: (Exception e, Throws e' l, MonadBaseControl IO m) => + (e -> e') -> EMT (Caught e l) m a -> EMT l m a +wrapException mkE m = m `catchWithSrcLoc` \loc e -> rethrow loc (mkE e) diff --git a/Control/Monad/Exception/Pure.hs b/Control/Monad/Exception/Pure.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Exception/Pure.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE CPP #-} + +{-| +A Monad Transformer for explicitly typed checked exceptions, described in detail by: + + * Jose Iborra, \"Explicitly Typed Exceptions for Haskell\", + PADL'10, January 2010, + +The exceptions thrown by a computation are inferred by the typechecker +and appear in the type signature of the computation as 'Throws' constraints. + +Exceptions are defined using the extensible exceptions framework of Marlow (documented in "Control.Exception"): + + * /An Extensible Dynamically-Typed Hierarchy of Exceptions/, by Simon Marlow, in /Haskell '06/. + + /Example/ + + > data DivideByZero = DivideByZero deriving (Show, Typeable) + > data SumOverflow = SumOverflow deriving (Show, Typeable) + + > instance Exception DivideByZero + > instance Exception SumOverflow + + > data Expr = Add Expr Expr | Div Expr Expr | Val Double + + > eval (Val x) = return x + > eval (Add a1 a2) = do + > v1 <- eval a1 + > v2 <- eval a2 + > let sum = v1 + v2 + > if sum < v1 || sum < v2 then throw SumOverflow else return sum + > eval (Div a1 a2) = do + > v1 <- eval a1 + > v2 <- eval a2 + > if v2 == 0 then throw DivideByZero else return (v1 / v2) + + GHCi infers the following types + + > eval :: (Throws DivideByZero l, Throws SumOverflow l) => Expr -> EM l Double + > eval `catch` \ (e::DivideByZero) -> return (-1) :: Throws SumOverflow l => Expr -> EM l Double + > runEM(eval `catch` \ (e::SomeException) -> return (-1)) + > :: Expr -> Double +-} + +module Control.Monad.Exception.Pure ( +-- * Important trivia +-- ** Hierarchies of Exceptions +-- $hierarchies + +-- ** Unchecked exceptions +-- *** Unchecked exceptions +-- $unchecked + +-- ** Stack Traces +-- $stacktraces + +-- ** Understanding GHC errors +-- $errors + +-- * The EM monad + EM, tryEM, tryEMWithLoc, runEM, runEMParanoid, + +-- * The EMT monad transformer + EMT(..), CallTrace, tryEMT, tryEMTWithLoc, runEMT, runEMTParanoid, AnyException, UncaughtException, + +-- ** The Throws type class + Throws, Caught, + +-- * Exception primitives + throw, rethrow, catch, catchWithSrcLoc, + finally, onException, bracket, wrapException, + + showExceptionWithTrace, + FailException(..), MonadZeroException(..), mplusDefault, + +-- * Reexports + Exception(..), SomeException(..), Typeable1, + Failure(..), +#if !MIN_VERSION_failure(0,2,0) + Try(..), NothingException(..), + WrapFailure(..), +#endif +) where + +import Control.Monad.Exception.Base +import Control.Monad.Exception.Throws +import Control.Monad.Exception.Catch (MonadCatch, Exception, SomeException, fromException) +import qualified Control.Monad.Exception.Catch +import Control.Failure +import Data.Typeable + +{- $hierarchies + If your exceptions are hierarchical then you need to + teach 'Throws' about the hierarchy. See the documentation of + 'Throws' for more info. +-} +{- $unchecked +An exception @E@ can be declared as unchecked by making @E@ an instance of + 'UncaughtException'. + +> instance UncaughtException E + + @E@ will still appear in the list of exceptions thrown + by a computation but 'runEMT' will not complain if @E@ escapes the computation + being run. + +Also, 'tryEMT' allows you to run a computation regardless of the exceptions it throws. +-} + + +{- $stacktraces + Stack traces are provided via the "MonadLoc" package. + All you need to do is add the following pragma at the top of your Haskell + source files and use do-notation: + +> { # OPTIONS_GHC -F -pgmF MonadLoc # } + + Only statements in do blocks appear in the stack trace. + + Example: + +> f () = do throw MyException +> g a = do f a +> +> main = runEMT $ do +> g () `catchWithSrcLoc` +> \loc (e::MyException) -> lift(putStrLn$ showExceptionWithTrace loc e) + +> -- Running main produces the output: + +> *Main> main +> MyException +> in f, Main(example.hs): (1,6) +> g, Main(example.hs): (2,6) +> main, Main(example.hs): (5,9) +> main, Main(example.hs): (4,16) + +-} + + +{- $errors +A type error of the form: + +> No instance for (UncaughtException MyException) +> arising from a use of `g' at examples/docatch.hs:21:32-35 +> Possible fix: +> add an instance declaration for (UncaughtException MyException) +> In the expression: g () + +is the type checker saying: + +\"hey, you are trying to run a computation which throws a @MyException@ without handling it, and I won't let you\" + +Either handle it or declare @MyException@ as an 'UncaughtException'. + +A type error of the form: + +> Overlapping instances for Throws MyException (Caught e NoExceptions) +> arising from a use of `g' at docatch.hs:24:3-6 +> Matching instances: +> instance (Throws e l) => Throws e (Caught e' l) +> -- Defined at ../Control/Monad/Exception/Throws.hs:46:9-45 +> instance (Exception e) => Throws e (Caught e l) +> -- Defined at ../Control/Monad/Exception/Throws.hs:47:9-44 +> (The choice depends on the instantiation of `e' +> ... + +is due to an exception handler for @MyException@ +missing a type annotation to pin down the type of the exception. +-} + + +-- | The catch primitive +catch :: (Exception e, Monad m) => EMT (Caught e l) m a -> (e -> EMT l m a) -> EMT l m a +catch emt h = catchWithSrcLoc emt (const h) + +-- | Catch and exception and observe the stack trace. +-- If on top of the IO monad, this will also capture asynchronous exceptions +catchWithSrcLoc :: (Exception e, Monad m) => EMT (Caught e l) m a -> (CallTrace -> e -> EMT l m a) -> EMT l m a +catchWithSrcLoc emt h = EMT $ do + v <- unEMT emt + case v of + Right x -> return (Right x) + Left (trace, CheckedException e) -> handle e trace + where handle e trace = + case fromException e of + Nothing -> return (Left (trace,CheckedException e)) + Just e' -> unEMT (h trace e') + +instance (Exception e, Monad m) => MonadCatch e (EMT (Caught e l) m) (EMT l m) where + catchWithSrcLoc = catchWithSrcLoc + catch = catch + +-- | Sequence two computations discarding the result of the second one. +-- If the first computation rises an exception, the second computation is run +-- and then the exception is rethrown. +finally :: Monad m => EMT l m a -> EMT l m b -> EMT l m a +finally m sequel = do { v <- m `onException` sequel; _ <- sequel; return v} + + +-- | Like finally, but performs the second computation only when the first one +-- rises an exception +-- TODO asynchronous exceptions! This needs to be moved to Monad +onException :: Monad m => EMT l m a -> EMT l m b -> EMT l m a +onException (EMT m) (EMT sequel) = EMT $ do + ev <- m + case ev of + Left{} -> do { _ <- sequel; return ev} + Right{} -> return ev + +bracket :: Monad m => EMT l m a -- ^ acquire resource + -> (a -> EMT l m b) -- ^ release resource + -> (a -> EMT l m c) -- ^ computation + -> EMT l m c +bracket acquire release run = do { k <- acquire; run k `finally` release k } + + +-- | Capture an exception e, wrap it, and rethrow. +-- Keeps the original monadic call trace. +wrapException :: (Exception e, Throws e' l, Monad m) => (e -> e') -> EMT (Caught e l) m a -> EMT l m a +wrapException mkE m = m `catchWithSrcLoc` \loc e -> rethrow loc (mkE e) diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,8 @@ + * 0.9.0 - Moved to transformers (finally leaving the whole mtl-transformers cisma behind) + * 0.10.0 - removed the dependency on safe-failure + * 0.10.1 - compatibility with failure 0.2 (thanks to Bas van Dijk) + * 0.10.2 - use the identity type from mtl (thanks to Bas), require minimum cabal-install version (thanks to Bernhard Urban) + * 0.10.3 - Moved the MonadIO instance to the main package + * 0.10.3.1 - Compatibility with base 4.6 + * 0.11 - Experimental support for asynchronous exceptions (via monad-control) + * 0.11.1 - Add missing Alternative instances diff --git a/control-monad-exception.cabal b/control-monad-exception.cabal --- a/control-monad-exception.cabal +++ b/control-monad-exception.cabal @@ -1,5 +1,5 @@ name: control-monad-exception -version: 0.10.3.1 +version: 0.11.1 Cabal-Version: >= 1.10 build-type: Simple license: PublicDomain @@ -38,7 +38,7 @@ > runEM(eval `catch` \ (e::SomeException) -> return (-1)) :: Expr -> Double . . - In addition to explicitly typed exceptions his package provides: + In addition to explicitly typed exceptions this package provides: . * Support for explicitly documented, unchecked exceptions (via 'Control.Monad.Exception.tryEMT'). . @@ -61,21 +61,6 @@ > g, Main(example.hs): (2,6) > main, Main(example.hs): (5,9) > main, Main(example.hs): (4,16) - . - /Changes/: - . - . - * 0.9.0 - Moved to transformers (finally leaving the whole mtl-transformers cisma behind) - . - * 0.10.0 - removed the dependency on safe-failure - . - * 0.10.1 - compatibility with failure 0.2 (thanks to Bas van Dijk) - . - * 0.10.2 - use the identity type from mtl (thanks to Bas), require minimum cabal-install version (thanks to Bernhard Urban) - . - * 0.10.3 - Moved the MonadIO instance to the main package - . - * 0.10.3.1 - Compatibility with base 4.6 synopsis: Explicitly typed, checked exceptions with stack traces category: Control, Monads, Failure @@ -83,6 +68,9 @@ tested-with: GHC == 6.12.1 bug-reports: http://github.com/pepeiborra/control-monad-exception/issues +extra-source-files: + changelog + Flag extensibleExceptions description: Use extensible-exception package default: False @@ -92,7 +80,10 @@ buildable: True build-depends: failure >= 0.1 && < 0.3 , transformers >= 0.2 + , transformers-base >= 0.4.1 , monadloc >= 0.7 + , monad-control >= 0.3 + , lifted-base >= 0.2.1 if flag(extensibleExceptions) build-depends: @@ -121,6 +112,8 @@ exposed-modules: Control.Monad.Exception + Control.Monad.Exception.Pure + Control.Monad.Exception.IO Control.Monad.Exception.Base Control.Monad.Exception.Catch Control.Monad.Exception.Throws