diff --git a/Control/Monad/Exception.hs b/Control/Monad/Exception.hs --- a/Control/Monad/Exception.hs +++ b/Control/Monad/Exception.hs @@ -6,27 +6,127 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NamedFieldPuns #-} +{-| +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 + +/Notes about type errors and exception hierarchies/ + + * 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. + + * If your sets of exceptions are hierarchical then you need to + teach 'Throws' about the hierarchy. + +> -- TopException +> -- | +> instance Throws MidException TopException -- | +> -- MidException +> instance Throws ChildException MidException -- | +> instance Throws ChildException TopException -- | +> -- ChildException + + + * Stack traces are only provided for explicitly annotated program points. + For now there is the TH macro 'withLocTH' to help with this. + Eventually a preprocessor could be written to automatically insert calls + to 'withLoc' at every do statement. + +> f () = $withLocTH $ throw MyException +> g a = $withLocTH $ f a +> +> main = runEMT $ $withLocTH $ do +> g () `catchWithSrcLoc` \loc (e::MyException) -> lift(putStrLn$ showExceptionWithTrace loc e) + +> -- Running main produces the output: + +> *Main> main +> MyException +> in Main(example.hs): (12,6) +> Main(example.hs): (11,7) + + +-} module Control.Monad.Exception ( - EM, evalEM, runEM, runEMParanoid, - EMT, evalEMT, runEMT, runEMTParanoid, - WithSrcLoc(..), withLocTH, showExceptionWithTrace, + EM, tryEM, runEM, runEMParanoid, + EMT, tryEMT, runEMT, runEMTParanoid, + WithSrcLoc(..), withLocTH, MonadZeroException(..), module Control.Monad.Exception.Class ) where import Control.Applicative import Control.Monad.Identity import Control.Monad.Exception.Class -import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Cont.Class import Control.Monad.RWS.Class import Data.Monoid import Data.Typeable -import qualified Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax hiding (lift) -import Prelude hiding (catch) import Text.PrettyPrint +import Prelude hiding (catch) +-- | A monad of explicitly typed, checked exceptions type EM l = EMT l Identity @@ -35,14 +135,14 @@ mapLeft _ (Right x) = Right x -- | Run a computation explicitly handling exceptions -evalEM :: EM (AnyException l) a -> Either SomeException a -evalEM = runIdentity . evalEMT +tryEM :: EM (AnyException l) a -> Either SomeException a +tryEM = runIdentity . tryEMT -- | Run a safe computation runEM :: EM NoExceptions a -> a runEM = runIdentity . runEMT --- | Run a safe computation checking even unchecked (@UncaughtExceptions@) exceptions +-- | Run a computation checking even unchecked (@UncaughtExceptions@) exceptions runEMParanoid :: EM ParanoidMode a -> a runEMParanoid = runIdentity . runEMTParanoid @@ -53,19 +153,14 @@ type AnyException = Caught SomeException --- | Run explicitly handling exceptions -evalEMT :: Monad m => EMT (AnyException l) m a -> m (Either SomeException a) -evalEMT (EMT m) = mapLeft (wrapException.snd) `liftM` m +-- | Run a computation explicitly handling exceptions +tryEMT :: Monad m => EMT (AnyException l) m a -> m (Either SomeException a) +tryEMT (EMT m) = mapLeft (unwrapException.snd) `liftM` m runEMT_gen :: Monad m => EMT l m a -> m a runEMT_gen (EMT m) = liftM f m where f (Right x) = x - f (Left e) = error (uncurry showExceptionWithTrace e) - -showExceptionWithTrace :: Show e => [String] -> e -> String -showExceptionWithTrace trace e = render$ - text (show e) $$ - text " in" <+> (vcat (map text $ reverse trace)) + f (Left (loc,e)) = error (showExceptionWithTrace loc (unwrapException e)) -- | Run a safe computation runEMT :: Monad m => EMT NoExceptions m a -> m a @@ -129,7 +224,6 @@ -- when used to wrap a EMT computation. -- -- On any other monad or value, 'withLoc' is defined as the identity - -- | hello withLoc :: String -> a -> a instance WithSrcLoc a where withLoc _ = id diff --git a/Control/Monad/Exception/Class.hs b/Control/Monad/Exception/Class.hs --- a/Control/Monad/Exception/Class.hs +++ b/Control/Monad/Exception/Class.hs @@ -5,14 +5,19 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverlappingInstances #-} + +{-| Defines 'MonadThrow' and 'MonadCatch' type classes and suitable instances for 'IO' and 'Either'. +-} + module Control.Monad.Exception.Class ( module Control.Monad, + module Control.Monad.Exception.Throws, MonadThrow(..), MonadCatch(..), - Throws, Caught, WrapException(..), Exception(..), SomeException(..), - UncaughtException, NoExceptions, ParanoidMode + showExceptionWithTrace ) where import Control.Monad @@ -40,29 +45,12 @@ import Control.Exception (Exception(..), SomeException) import qualified Control.Exception #endif -import Data.Monoid import Data.Typeable -import Prelude hiding (catch) - - --- Closing a type class with an unexported constraint --- @Private@ is unexported -class Private l -instance Private (Caught e l) - -{-| @Throws@ is the mechanism used to keep a type level - list of exceptions. - - Usually there is no need for the user of this library - to add further instances to @Throws@ except in one - case: to encode subtyping. For instance if we have - an @IOException@ type and a @FIleNotFoundException@ subcase, - we need to add the instance: +import Text.PrettyPrint - > instance Throws FileNotFoundException (Caught IOException l) +import Control.Monad.Exception.Throws --} -class (Private l, Exception e) => Throws e l -- | e -> l +import Prelude hiding (catch) class Monad m => MonadThrow e m where throw :: e -> m a @@ -80,35 +68,23 @@ instance Exception e => MonadCatch e IO IO where catch = Control.Exception.catch - --- | A type level witness of a exception handler. -data Caught e l - -instance Exception e => Throws e (Caught e l) -instance Throws e l => Throws e (Caught e' l) - --- | @SomeException@ is at the top of the exception hierarchy --- . --- Capturing SomeException captures every possible exception -instance Exception e => Throws e (Caught SomeException l) - -data NoExceptions -instance Private NoExceptions +{-| Given a list of source locations and an exception, @showExceptionWithTrace@ produces output of the form -data ParanoidMode -instance Private ParanoidMode +> +> in (): (12,6) +> (): (11,7) +> ... --- | Uncaught Exceptions model unchecked exceptions (a la RuntimeException in Java) --- --- In order to declare an unchecked exception @e@, --- all that is needed is to make @e@ an instance of @UncaughtException@ -class Exception e => UncaughtException e -instance UncaughtException e => Throws e NoExceptions +-} +showExceptionWithTrace :: Exception e => [String] -> e -> String +showExceptionWithTrace trace e = render$ + text (show e) $$ + text " in" <+> (vcat (map text $ reverse trace)) -- Labelled SomeException -- ------------------------ -- | @WrapException@ adds a phantom type parameter @l@ to @SomeException@ -newtype WrapException l = WrapException {wrapException::SomeException} deriving (Typeable) +newtype WrapException l = WrapException {unwrapException::SomeException} deriving (Typeable) instance Show (WrapException l) where show (WrapException e) = show e -- Throw and Catch instances for the Either and ErrorT monads diff --git a/Control/Monad/Exception/Throws.hs b/Control/Monad/Exception/Throws.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Exception/Throws.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverlappingInstances, FlexibleInstances #-} + +{-| +Defines the @Throws@ binary relationship between types. +-} + +module Control.Monad.Exception.Throws (Throws, Caught, UncaughtException, NoExceptions, ParanoidMode) where + +#if __GLASGOW_HASKELL__ < 610 +import Control.Exception.Extensible (Exception(..), SomeException) +#else +import Control.Exception (Exception(..), SomeException) +#endif + + +-- | A type level witness of a exception handler. +data Caught e l + + +-- Closing a type class with an unexported constraint +-- @Private@ is unexported +class Private l +instance Private (Caught e l) + +{-| @Throws@ is a type level binary relationship + used to model a list of exceptions. + + Usually there is no need for the user + to add further instances to @Throws@ except + to encode subtyping. + As there is no way to automatically infer + the subcases of an exception, they have to be encoded + manually mirroring the hierarchy defined in the defined + 'Exception' instances. + + For example, + the following instance encodes that @MyFileNotFoundException@ is + a subexception of @MyIOException@ : + + > instance Throws MyFileNotFoundException (Caught MyIOException l) + + 'Throws' is not a transitive relation and every ancestor relation + must be explicitly encoded. + +> -- TopException +> -- | +> instance Throws MidException TopException -- | +> -- MidException +> instance Throws ChildException MidException -- | +> instance Throws ChildException TopException -- | +> -- ChildException + +'SomeException' is automatically + an ancestor of every other exception type. + + +-} + +class (Private l, Exception e) => Throws e l + +instance Throws e l => Throws e (Caught e' l) +instance Exception e => Throws e (Caught e l) + +-- | @SomeException@ is at the top of the exception hierarchy +-- . +-- Capturing SomeException captures every possible exception +instance Exception e => Throws e (Caught SomeException l) + +-- | Uncaught Exceptions model unchecked exceptions (a la RuntimeException in Java) +-- +-- In order to declare an unchecked exception @e@, +-- all that is needed is to make @e@ an instance of @UncaughtException@ +class Exception e => UncaughtException e +instance UncaughtException e => Throws e NoExceptions + + +data NoExceptions +instance Private NoExceptions + +data ParanoidMode +instance Private ParanoidMode 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.4.5 +version: 0.4.6 Cabal-Version: >= 1.2.3 build-type: Simple license: PublicDomain @@ -8,7 +8,9 @@ homepage: http://safe-tools.dsic.upv.es/mediawiki/index.php/Jose_Iborra/Papers/Exceptions description: This package provides explicitly typed, checked exceptions as a library. - + . + Computations throwing different types of exception can be combined seamlessly. + . /Example/ . > data Expr = Add Expr Expr | Div Expr Expr | Val Double @@ -35,20 +37,22 @@ > eval `catch` \ (e::DivideByZero) -> return (-1) :: Throws SumOverflow l => Expr -> EM l Double > runEM(eval `catch` \ (e::SomeException) -> return (-1)) :: Expr -> Double . - New in version 0.4: . - * Support for unchecked exceptions (with 'UncaughtException') + This package provides, among other things: . - * Support for exception stack traces (with 'WithSrcLoc'). /Example/ + * Support for explicitly documented, unchecked exceptions (with 'tryEM'). . + * Support for selective unchecked exceptions (with 'UncaughtException'). + . + * Support for exception stack traces (experimental). /Example:/ + . > f () = $withLocTH $ throw MyException > g a = $withLocTH $ f a > > main = runEMT $ $withLocTH $ do - > g () `catchWithSrcLoc` \loc MyException -> - > lift $ putStrLn (showExceptionWithTrace loc MyException) + > g () `catchWithSrcLoc` \loc (e::MyException) -> lift(putStrLn$ showExceptionWithTrace loc e) . - > -- Running main produces the output: + > -- Running main produces the output: . > *Main> main > MyException @@ -98,5 +102,6 @@ build-depends: pretty, template-haskell exposed-modules: Control.Monad.Exception.Class + Control.Monad.Exception.Throws Control.Monad.Exception ghc-options: -Wall -fno-warn-name-shadowing