control-monad-exception 0.5 → 0.6
raw patch · 7 files changed
+586/−372 lines, 7 filesdep ~monads-fddep ~transformers
Dependency ranges changed: monads-fd, transformers
Files
- Control/Monad/Exception.hs +93/−274
- Control/Monad/Exception/Base.hs +272/−0
- Control/Monad/Exception/Catch.hs +0/−30
- Control/Monad/Exception/MonadsFD.hs +85/−0
- Control/Monad/Exception/Mtl.hs +82/−0
- Control/Monad/Exception/Throws.hs +26/−53
- control-monad-exception.cabal +28/−15
Control/Monad/Exception.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-| A Monad Transformer for explicitly typed checked exceptions.@@ -41,39 +36,61 @@ > 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/+module Control.Monad.Exception (+-- * Important trivia+-- ** Hierarchies of Exceptions+-- $hierarchies - * A type error of the form:+-- ** Unchecked and unexplicit exceptions+-- *** Unchecked exceptions+-- $unchecked -> 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 ()+-- *** Unexplicit exceptions+-- $unexplicit -is the type checker saying:+-- ** Stack Traces+-- $stacktraces -\"hey, you are trying to run a computation which throws a @MyException@ without handling it, and I won't let you\"+-- ** Understanding GHC errors+-- $errors -Either handle it or declare @MyException@ as an 'UncaughtException'.+-- * The EM monad+ EM, tryEM, runEM, runEMParanoid, - * A type error of the form:+-- * The EMT monad transformer+ EMT(..), CallTrace, tryEMT, runEMT, runEMTParanoid, AnyException, UncaughtException, -> 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'-> ...+-- ** The Throws type class+ Throws, Caught, - is due to an exception handler for @MyException@-missing a type annotation to pin down the type of the exception.+-- ** The Try type class for absorbing other failure types+ Try(..), NothingException(..), - * If your sets of exceptions are hierarchical then you need to+-- * Exception primitives+ throw, rethrow, Control.Monad.Exception.Base.catch, Control.Monad.Exception.Base.catchWithSrcLoc,+ finally, onException, bracket, wrapException,++ showExceptionWithTrace,+ FailException(..), MonadZeroException(..),++-- * Reexports+ Exception(..), SomeException(..), Typeable(..),+ MonadFailure(..), WrapFailure(..),+ MonadLoc(..), withLocTH+) where++import Control.Exception (Exception(..), SomeException(..))+import Control.Monad.Exception.Base+import Control.Monad.Exception.Catch+import Control.Monad.Exception.Throws+import Control.Monad.Failure+import Control.Monad.Loc+import Data.Typeable++{- $hierarchies+ If your sets of exceptions are hierarchical then you need to teach 'Throws' about the hierarchy. > -- TopException@@ -82,18 +99,39 @@ > -- MidException > instance Throws ChildException (Caught MidException l) -- | > instance Throws ChildException (Caught TopException l) -- |- > -- ChildException+> -- ChildException+-}+{- $unchecked+An exception @E@ can be declared as unchecked by making @E@ an instance of+ 'UncaughtException'. +> instance UncaughtException E - * Stack traces are provided via the "MonadLoc" package.+ @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.+-}++{- $unexplicit+An exception @E@ can be made unexplicit: @E@ will not appear in the list+ of exceptions. To do so include the following instance in your code:++> instance Throws E l++-}++{- $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 #-}+> { # OPTIONS_GHC -F -pgmF MonadLoc # } Only statements in do blocks appear in the stack trace. -* Example:+ Example: > f () = do throw MyException > g a = do f a@@ -112,254 +150,35 @@ > main, Main(example.hs): (4,16) -}-module Control.Monad.Exception ( --- * The EM monad- EM, tryEM, runEM, runEMParanoid, --- * The EMT monad transformer- EMT, CallTrace, tryEMT, runEMT, runEMTParanoid,---- * Exception primitives- throw, rethrow, Control.Monad.Exception.catch, Control.Monad.Exception.catchWithSrcLoc,- finally, onException, bracket, wrapException,-- showExceptionWithTrace,- FailException(..), MonadZeroException(..),---- * The Try class for absorbing other error monads- Try(..), NothingException(..),---- * Reexports- Exception(..), SomeException(..), Typeable(..),- MonadFailure(..),- Throws, Caught, UncaughtException,- withLoc, withLocTH,--) where--import Control.Applicative-import qualified Control.Exception as CE-import Control.Monad.Identity-import Control.Monad.Exception.Catch-import Control.Monad.Fix-import Control.Monad.Trans-import Control.Monad.Cont.Class-import Control.Monad.RWS.Class-import Control.Monad.Loc-import Control.Monad.Failure-import Data.Monoid-import Data.Typeable-import Text.PrettyPrint-import Prelude hiding (catch)---- | A monad of explicitly typed, checked exceptions-type EM l = EMT l Identity--mapLeft :: (a -> b) -> Either a r -> Either b r-mapLeft f (Left x) = Left (f x)-mapLeft _ (Right x) = Right x---- | Run a computation explicitly handling exceptions-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 computation checking even unchecked (@UncaughtExceptions@) exceptions-runEMParanoid :: EM ParanoidMode a -> a-runEMParanoid = runIdentity . runEMTParanoid--type CallTrace = [String]--newtype EMT l m a = EMT {unEMT :: m (Either (CallTrace, CheckedException l) a)}--type AnyException = Caught SomeException---- | Run a computation explicitly handling exceptions-tryEMT :: Monad m => EMT (AnyException l) m a -> m (Either SomeException a)-tryEMT (EMT m) = mapLeft (checkedException.snd) `liftM` m--runEMT_gen :: forall l m a . Monad m => EMT l m a -> m a-runEMT_gen (EMT m) = m >>= \x ->- case x of- Right x -> return x- Left (loc,e) -> error (showExceptionWithTrace loc (checkedException e))---- | Run a safe computation-runEMT :: Monad m => EMT NoExceptions m a -> m a-runEMT = runEMT_gen---- | Run a safe computation checking even unchecked (@UncaughtException@) exceptions-runEMTParanoid :: Monad m => EMT ParanoidMode m a -> m a-runEMTParanoid = runEMT_gen--instance Monad m => Functor (EMT l m) where- fmap f emt = EMT $ do- v <- unEMT emt- case v of- Left e -> return (Left e)- Right x -> return (Right (f x))--instance Monad m => Monad (EMT l m) where- return = EMT . return . Right-- fail s = EMT $ return $ Left ([], CheckedException $ toException $ FailException s)-- emt >>= f = EMT $ do- v <- unEMT emt- case v of- Left e -> return (Left e)- Right x -> unEMT (f x)--instance Monad m => Applicative (EMT l m) where- pure = return- (<*>) = ap--instance (Exception e, Throws e l, Monad m) => MonadFailure e (EMT l m) where- failure = throw--instance (Exception e, Monad m) => MonadCatch e (EMT (Caught e l) m) (EMT l m) where- catchWithSrcLoc = Control.Monad.Exception.catchWithSrcLoc- catch = Control.Monad.Exception.catch--instance Monad m => MonadLoc (EMT l m) where- withLoc loc (EMT emt) = EMT $ do- current <- emt- case current of- (Left (tr, a)) -> return (Left (loc:tr, a))- _ -> return current---- | The throw primitive-throw :: (Exception e, Throws e l, Monad m) => e -> EMT l m a-throw = EMT . return . (\e -> Left ([],e)) . CheckedException . toException---- | Rethrow an exception keeping the call trace-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.catchWithSrcLoc emt (\_ -> h)---- | Like 'Control.Monad.Exception.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) => EMT (Caught e l) m a -> (e -> e') -> EMT l m a-wrapException m mkE = m `Control.Monad.Exception.catchWithSrcLoc` \loc e -> rethrow loc (mkE e)--showExceptionWithTrace :: Exception e => [String] -> e -> String-showExceptionWithTrace [] e = show e-showExceptionWithTrace trace e = render$- text (show e) $$- text " in" <+> (vcat (map text $ reverse trace))--instance (Throws MonadZeroException l) => MonadPlus (EM l) where- mzero = throw MonadZeroException- mplus emt1 emt2 = EMT$ do- v1 <- unEMT emt1- case v1 of- Left _ -> unEMT emt2- Right _ -> return v1--instance MonadTrans (EMT l) where lift = EMT . liftM Right--instance MonadFix m => MonadFix (EMT l m) where- mfix f = EMT $ mfix $ \a -> unEMT $ f $ case a of- Right r -> r- _ -> error "empty fix argument"-instance UncaughtException SomeException--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))----- -------------------------------------------------- The Try class for absorbing other error monads--- ------------------------------------------------data NothingException = NothingException deriving (Typeable, Show)-instance Exception NothingException--class Try m l where try :: Monad m' => m a -> EMT l m' a-instance Throws NothingException l => Try Maybe l where try = maybe (throw NothingException) return-instance (Exception e, Throws e l) => Try (Either e) l where try = either throw return--instance (Monad m, Try m l) => Try (EMT l m) l where try = join . fmap (EMT . return) .try . unEMT---- -------------- Exceptions--- --------------- | @FailException@ is thrown by Monad 'fail'-data FailException = FailException String deriving (Show, Typeable)-instance Exception FailException+{- $errors+A type error of the form: --- | @MonadZeroException@ is thrown by MonadPlus 'mzero'-data MonadZeroException = MonadZeroException deriving (Show, Typeable)-instance Exception MonadZeroException+> 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 () --- --------------------- mtl boilerplate--- ------------------+is the type checker saying: -instance MonadCont m => MonadCont (EMT l m) where- callCC f = EMT $ callCC $ \c -> unEMT (f (\a -> EMT $ c (Right a)))+\"hey, you are trying to run a computation which throws a @MyException@ without handling it, and I won't let you\" -instance MonadReader r m => MonadReader r (EMT l m) where- ask = lift ask- local f m = EMT (local f (unEMT m))+Either handle it or declare @MyException@ as an 'UncaughtException'. -instance MonadState s m => MonadState s (EMT l m) where- get = lift get- put = lift . put+A type error of the form: -instance (Monoid w, MonadWriter w m) => MonadWriter w (EMT l m) where- tell = lift . tell- listen m = EMT $ do- (res, w) <- listen (unEMT m)- return (fmap (\x -> (x,w)) res)- pass m = EMT $ pass $ do- a <- unEMT m- case a of- Left l -> return (Left l, id)- Right (r,f) -> return (Right r, f)+> 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'+> ... -instance (Monoid w, MonadRWS r w s m) => MonadRWS r w s (EMT l m)+is due to an exception handler for @MyException@+missing a type annotation to pin down the type of the exception.+-}
+ Control/Monad/Exception/Base.hs view
@@ -0,0 +1,272 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE CPP #-}++{-|+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 Control.Applicative+import Control.Monad.Exception.Catch+import Control.Monad.Loc+import Control.Monad.Failure.Class+import Control.Monad.Fix+import Data.Typeable+import Text.PrettyPrint+import Prelude hiding (catch)++type CallTrace = [String]++-- | A Monad Transformer for explicitly typed checked exceptions.+newtype EMT l m a = EMT {unEMT :: m (Either (CallTrace, CheckedException l) a)}++type AnyException = Caught SomeException++-- | Run a computation explicitly handling exceptions+tryEMT :: Monad m => EMT (AnyException l) m a -> m (Either SomeException a)+tryEMT (EMT m) = mapLeft (checkedException.snd) `liftM` m++runEMT_gen :: forall l m a . Monad m => EMT l m a -> m a+runEMT_gen (EMT m) = m >>= \x ->+ case x of+ Right x -> return x+ Left (loc,e) -> error (showExceptionWithTrace loc (checkedException e))++data NoExceptions+data ParanoidMode++-- | Run a safe computation+runEMT :: Monad m => EMT NoExceptions m a -> m a+runEMT = runEMT_gen++-- | Run a safe computation checking even unchecked ('UncaughtException') exceptions+runEMTParanoid :: Monad m => EMT ParanoidMode m a -> m a+runEMTParanoid = runEMT_gen++instance Monad m => Functor (EMT l m) where+ fmap f emt = EMT $ do+ v <- unEMT emt+ case v of+ Left e -> return (Left e)+ Right x -> return (Right (f x))++instance Monad m => Monad (EMT l m) where+ return = EMT . return . Right++ fail s = EMT $ return $ Left ([], CheckedException $ toException $ FailException s)++ emt >>= f = EMT $ do+ v <- unEMT emt+ case v of+ Left e -> return (Left e)+ Right x -> unEMT (f x)++instance Monad m => Applicative (EMT l m) where+ pure = return+ (<*>) = ap++instance (Exception e, Throws e l, Monad m) => MonadFailure e (EMT l m) where+ failure = throw++instance (Exception e, Throws e l, Monad m) => WrapFailure e (EMT l m) where+ wrapFailure mkE m+ = EMT $ do+ v <- unEMT m+ case v of+ Right _ -> return v+ Left (loc, CheckedException (SomeException e))+ -> return $ Left (loc, CheckedException $ toException $ mkE e)++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 Monad m => MonadLoc (EMT l m) where+ withLoc loc (EMT emt) = EMT $ do+ current <- withLoc loc emt+ case current of+ (Left (tr, a)) -> return (Left (loc:tr, a))+ _ -> return current++instance MonadFix m => MonadFix (EMT l m) where+ mfix f = EMT $ mfix $ \a -> unEMT $ f $ case a of+ Right r -> r+ _ -> error "empty fix argument"++-- | The throw primitive+throw :: (Exception e, Throws e l, Monad m) => e -> EMT l m a+throw = EMT . return . (\e -> Left ([],e)) . CheckedException . toException++-- | Rethrow an exception keeping the call trace+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 = render$+ text (show e) $$+ text " in" <+> (vcat (map text $ reverse trace))+{-+-}++-- | Uncaught Exceptions model unchecked exceptions+--+-- In order to declare an unchecked exception @E@,+-- all that is needed is to make @e@ an instance of 'UncaughtException'+--+-- > instance UncaughtException E+--+-- Note that declaring an exception E as unchecked does not automatically+-- turn its children as unchecked too. This is a shortcoming of the current encoding.+--+-- If that is what you want, then declare E as unchecked and unexplicit+-- using an instance of 'Throws':+--+-- > instance Throws E l++class Exception e => UncaughtException e+instance UncaughtException e => Throws e NoExceptions+instance UncaughtException SomeException++-- ---------------+-- The EM Monad+-- ---------------++-- | A monad of explicitly typed, checked exceptions+type EM l = EMT l Identity++-- | Run a computation explicitly handling exceptions+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 computation checking even unchecked (@UncaughtExceptions@) exceptions+runEMParanoid :: EM ParanoidMode a -> a+runEMParanoid = runIdentity . runEMTParanoid++newtype Identity a = Identity{runIdentity::a} deriving (Eq, Ord, Show)+instance Monad Identity where+ return = Identity+ Identity a >>= f = f a++-- -----------------------------------------------+-- The Try class for absorbing other error monads+-- -----------------------------------------------+data NothingException = NothingException deriving (Typeable, Show)+instance Exception NothingException++class Try m l where+ {- | The purpose of 'try' is to combine 'EMT' with other failure handling data types.+ 'try' accepts a failing computation and turns it into an 'EMT' computation.+ The instances provided allow you to 'try' on 'Maybe' and 'Either' computations.+ -}+ try :: Monad m' => m a -> EMT l m' a++instance Throws NothingException l => Try Maybe l where try = maybe (throw NothingException) return+instance (Exception e, Throws e l) => Try (Either e) l where try = either throw return++instance (Monad m, Try m l) => Try (EMT l m) l where try = join . fmap (EMT . return) .try . unEMT++-- -----------+-- Exceptions+-- -----------++-- | @FailException@ is thrown by Monad 'fail'+data FailException = FailException String deriving (Show, Typeable)+instance Exception FailException++-- | @MonadZeroException@ is thrown by MonadPlus 'mzero'+data MonadZeroException = MonadZeroException deriving (Show, Typeable)+instance Exception MonadZeroException+++-- other++mapLeft :: (a -> b) -> Either a r -> Either b r+mapLeft f (Left x) = Left (f x)+mapLeft _ (Right x) = Right x
Control/Monad/Exception/Catch.hs view
@@ -19,21 +19,6 @@ ) where import Control.Monad-#if TRANSFORMERS-import Control.Monad.Trans.Error-import Control.Monad.Trans.List-import Control.Monad.Trans.Reader-import Control.Monad.Trans.State-import Control.Monad.Trans.Writer-import Control.Monad.Trans.RWS-#else-import Control.Monad.Error-import Control.Monad.List-import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.Writer-import Control.Monad.RWS-#endif #if __GLASGOW_HASKELL__ < 610 import Control.Exception.Extensible (Exception(..), SomeException)@@ -42,7 +27,6 @@ import Control.Exception (Exception(..), SomeException) import qualified Control.Exception #endif-import Data.Monoid import Control.Monad.Exception.Throws @@ -58,17 +42,3 @@ -- Throw and Catch instances for the Either and ErrorT monads -- ------------------------------------------------------------instance (Error e) => MonadCatch e (Either e) (Either e) where catch m h = either h Right m-instance (Error e, Monad m) => MonadCatch e (ErrorT e m) (ErrorT e m) where catch = catchError----- Instances for transformers (requires undecidable instances in some cases)--- --------------------------------------------------------------------------instance MonadCatch e m m' => MonadCatch e (ListT m) (ListT m') where catch (ListT m) h = ListT (catch m (runListT . h))-instance MonadCatch e m m' => MonadCatch e (ReaderT r m) (ReaderT r m') where catch (ReaderT m) h = ReaderT (\s -> catch (m s) ((`runReaderT` s) . h))--instance (Monoid w, MonadCatch e m m') => MonadCatch e (WriterT w m) (WriterT w m') where catch (WriterT m) h = WriterT (catch m (runWriterT . h))--instance MonadCatch e m m' => MonadCatch e (StateT s m) (StateT s m') where catch (StateT m) h = StateT (\s -> catch (m s) ((`runStateT` s) . h))--instance (Monoid w, MonadCatch e m m') => MonadCatch e (RWST r w s m) (RWST r w s m') where catch (RWST m) h = RWST (\r s -> catch (m r s) ((\m -> runRWST m r s) . h))
+ Control/Monad/Exception/MonadsFD.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PackageImports #-}++-- | 'EMT' liftings for the classes in the monads-fd package+module Control.Monad.Exception.MonadsFD (module Control.Monad.Exception, Control.Monad.Exception.catch+ ) where++import qualified Control.Exception as CE++import qualified Control.Monad.Exception+import Control.Monad.Exception hiding (catch)+import Control.Monad.Exception.Catch+import Control.Monad.Exception.Throws+import "monads-fd" Control.Monad.Cont.Class+import "monads-fd" Control.Monad.RWS.Class++import Control.Monad+import "transformers" Control.Monad.Trans++import Control.Monad.Trans.Error+import Control.Monad.Trans.List+import Control.Monad.Trans.Reader (ReaderT(..))+import Control.Monad.Trans.State (StateT(..))+import Control.Monad.Trans.Writer (WriterT(..))+import Control.Monad.Trans.RWS (RWST(..))++import Data.Monoid+import Prelude hiding (catch)++instance (Throws MonadZeroException l) => MonadPlus (EM l) where+ mzero = throw MonadZeroException+ mplus emt1 emt2 = EMT$ do+ v1 <- unEMT emt1+ case v1 of+ Left _ -> unEMT emt2+ Right _ -> return v1+++instance MonadTrans (EMT l) where lift = EMT . liftM Right++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 MonadCont m => MonadCont (EMT l m) where+ callCC f = EMT $ callCC $ \c -> unEMT (f (\a -> EMT $ c (Right a)))++instance MonadReader r m => MonadReader r (EMT l m) where+ ask = lift ask+ local f m = EMT (local f (unEMT m))++instance MonadState s m => MonadState s (EMT l m) where+ get = lift get+ put = lift . put++instance (Monoid w, MonadWriter w m) => MonadWriter w (EMT l m) where+ tell = lift . tell+ listen m = EMT $ do+ (res, w) <- listen (unEMT m)+ return (fmap (\x -> (x,w)) res)+ pass m = EMT $ pass $ do+ a <- unEMT m+ case a of+ Left l -> return (Left l, id)+ Right (r,f) -> return (Right r, f)++instance (Monoid w, MonadRWS r w s m) => MonadRWS r w s (EMT l m)+++-- MonadCatch Instances+-- -------------------------------------------------------------------------+-- instance (Error e) => MonadCatch e (Either e) (Either e) where catch m h = either h Right m+instance (Error e, Monad m) => MonadCatch e (ErrorT e m) (ErrorT e m) where catch = catchError++instance MonadCatch e m m' => MonadCatch e (ListT m) (ListT m') where catch (ListT m) h = ListT (catch m (runListT . h))+instance MonadCatch e m m' => MonadCatch e (ReaderT r m) (ReaderT r m') where catch (ReaderT m) h = ReaderT (\s -> catch (m s) ((`runReaderT` s) . h))++instance (Monoid w, MonadCatch e m m') => MonadCatch e (WriterT w m) (WriterT w m') where catch (WriterT m) h = WriterT (catch m (runWriterT . h))++instance MonadCatch e m m' => MonadCatch e (StateT s m) (StateT s m') where catch (StateT m) h = StateT (\s -> catch (m s) ((`runStateT` s) . h))++instance (Monoid w, MonadCatch e m m') => MonadCatch e (RWST r w s m) (RWST r w s m') where catch (RWST m) h = RWST (\r s -> catch (m r s) ((\m -> runRWST m r s) . h))
+ Control/Monad/Exception/Mtl.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE UndecidableInstances #-}++-- | 'EMT' liftings for the classes in the Monad Transformer Library+module Control.Monad.Exception.Mtl (module Control.Monad.Exception, Control.Monad.Exception.catch) where++import qualified Control.Exception as CE++import qualified Control.Monad.Exception+import Control.Monad.Exception hiding (catch)+import Control.Monad.Exception.Catch as Catch+import Control.Monad.Exception.Throws+import "mtl" Control.Monad.Cont.Class+import "mtl" Control.Monad.Error+import "mtl" Control.Monad.List+import "mtl" Control.Monad.Reader+import "mtl" Control.Monad.State+import "mtl" Control.Monad.Writer+import "mtl" Control.Monad.RWS+import Data.Monoid+import Prelude hiding (catch)++instance (Throws MonadZeroException l) => MonadPlus (EM l) where+ mzero = throw MonadZeroException+ mplus emt1 emt2 = EMT$ do+ v1 <- unEMT emt1+ case v1 of+ Left _ -> unEMT emt2+ Right _ -> return v1+++instance MonadTrans (EMT l) where lift = EMT . liftM Right++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 MonadCont m => MonadCont (EMT l m) where+ callCC f = EMT $ callCC $ \c -> unEMT (f (\a -> EMT $ c (Right a)))++instance MonadReader r m => MonadReader r (EMT l m) where+ ask = lift ask+ local f m = EMT (local f (unEMT m))++instance MonadState s m => MonadState s (EMT l m) where+ get = lift get+ put = lift . put++instance (Monoid w, MonadWriter w m) => MonadWriter w (EMT l m) where+ tell = lift . tell+ listen m = EMT $ do+ (res, w) <- listen (unEMT m)+ return (fmap (\x -> (x,w)) res)+ pass m = EMT $ pass $ do+ a <- unEMT m+ case a of+ Left l -> return (Left l, id)+ Right (r,f) -> return (Right r, f)++instance (Monoid w, MonadRWS r w s m) => MonadRWS r w s (EMT l m)++++-- MonadCatch Instances+-- -------------------------------------------------------------------------++-- Commented out due to the problem of duplicated Monad instances for Either+-- instance (Error e) => MonadCatch e (Either e) (Either e) where catch m h = either h Right m+instance (Error e, Monad m) => MonadCatch e (ErrorT e m) (ErrorT e m) where catch = catchError++instance MonadCatch e m m' => MonadCatch e (ListT m) (ListT m') where catch (ListT m) h = ListT (Catch.catch m (runListT . h))+instance MonadCatch e m m' => MonadCatch e (ReaderT r m) (ReaderT r m') where catch (ReaderT m) h = ReaderT (\s -> Catch.catch (m s) ((`runReaderT` s) . h))++instance (Monoid w, MonadCatch e m m') => MonadCatch e (WriterT w m) (WriterT w m') where catch (WriterT m) h = WriterT (Catch.catch m (runWriterT . h))++instance MonadCatch e m m' => MonadCatch e (StateT s m) (StateT s m') where catch (StateT m) h = StateT (\s -> Catch.catch (m s) ((`runStateT` s) . h))++instance (Monoid w, MonadCatch e m m') => MonadCatch e (RWST r w s m) (RWST r w s m') where catch (RWST m) h = RWST (\r s -> Catch.catch (m r s) ((\m -> runRWST m r s) . h))
Control/Monad/Exception/Throws.hs view
@@ -1,18 +1,14 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverlappingInstances, FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}- {-| Defines the @Throws@ binary relationship between types. -} module Control.Monad.Exception.Throws ( Throws, Caught,- CheckedException(..),- UncaughtException,- NoExceptions, ParanoidMode) where+ CheckedException(..)+ ) where #if __GLASGOW_HASKELL__ < 610 import Control.Exception.Extensible (Exception(..), SomeException)@@ -25,30 +21,29 @@ 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.+ There are two cases in which the user may want+ to add further instances to @Throws@. - For example,- the following instance encodes that @MyFileNotFoundException@ is- a subexception of @MyIOException@ :+ 1. To encode subtyping. + 2. To declare an exception as unexplicit (a programming error).++ [/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.+ 'Throws' is not a transitive relation and every ancestor relation+ must be explicitly encoded. > -- TopException > -- |@@ -58,12 +53,17 @@ > instance Throws ChildException (Caught TopException l) -- | > -- ChildException -'SomeException' is automatically- an ancestor of every other exception type.+ 'SomeException' is automatically+ an ancestor of every other exception type. + [/Programming Errors/]+ In order to declare an exception @E@ as a programming error, which should+ not be explicit nor checked, use a 'Throws' instance as follows:++> instance Throws e l -} -class (Private l, Exception e) => Throws e l+class Exception e => Throws e l instance Throws e l => Throws e (Caught e' l) instance Exception e => Throws e (Caught e l)@@ -73,33 +73,6 @@ -- Capturing SomeException captures every possible exception instance Exception e => Throws e (Caught SomeException l) instance Throws SomeException (Caught SomeException l) -- Disambiguation instance---- | 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@------ > instance UncaughtException E------ Note that declaring an exception E as unchecked does not automatically--- turn its children as unchecked too. This is a shortcoming of the current encoding.-{---- If that is what you want, then--- declare E as unchecked using an instance of @Throws@:------ > instance Throws E l------ The shortcoming of this route is that runEMTParanoid won't be able to--- control exceptions declared unchecked this way.--}-class Exception e => UncaughtException e-instance UncaughtException e => Throws e NoExceptions--data NoExceptions-instance Private NoExceptions--data ParanoidMode-instance Private ParanoidMode -- Labelled SomeException -- ------------------------
control-monad-exception.cabal view
@@ -1,6 +1,6 @@ name: control-monad-exception-version: 0.5-Cabal-Version: >= 1.2.3+version: 0.6+Cabal-Version: >= 1.6 build-type: Simple license: PublicDomain author: Pepe Iborra@@ -40,10 +40,12 @@ . In addition to explicitly typed exceptions his package provides: .- * Support for explicitly documented, unchecked exceptions (with 'tryEM').+ * Support for explicitly documented, unchecked exceptions (via 'Control.Monad.Exception.tryEMT'). .- * Support for selective unchecked exceptions (with 'UncaughtException').+ * Support for selective unchecked exceptions (via 'Control.Monad.Exception.UncaughtException'). .+ * Support for selective unexplicit exceptions.+ . * Support for exception call traces via 'Control.Monad.Loc.MonadLoc'. /Example:/ . >@@ -65,14 +67,16 @@ synopsis: Explicitly typed, checked exceptions with stack traces category: Control, Monads stability: experimental-tested-with: GHC ==6.8.2-tested-with: GHC ==6.10.2 tested-with: GHC ==6.10.3 -Flag transformers- description: Use transformers and monads-fd instead of mtl+Flag mtl+ description: Provide mtl instances default: True +Flag monadsfd+ description: Provide monads-fd instances+ default: True + Flag extensibleExceptions description: Use extensible-exception package default: False@@ -89,14 +93,16 @@ build-depends: base >= 4 && < 5 - if flag(transformers)- cpp-options: -DTRANSFORMERS- build-depends:- transformers >= 0.0.1 && <0.2,- monads-fd >= 0.0 && <0.1- else+ if flag(mtl)+ cpp-options: -DMTL build-depends: mtl+ exposed-modules : Control.Monad.Exception.Mtl + if flag(monadsfd)+ cpp-options: -DMONADSFD+ build-depends: transformers, monads-fd+ exposed-modules : Control.Monad.Exception.MonadsFD+ extensions: MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,@@ -105,7 +111,14 @@ UndecidableInstances exposed-modules:+ Control.Monad.Exception+ Control.Monad.Exception.Base Control.Monad.Exception.Catch Control.Monad.Exception.Throws- Control.Monad.Exception ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans++++source-repository head+ type: git+ location: git://github.com/pepeiborra/control-monad-exception.git