exception-mtl 0.1 → 0.2

raw patch · 2 files changed

+130/−63 lines, 2 filesdep +stmPVP ok

version bump matches the API change (PVP)

Dependencies added: stm

API changes (from Hackage documentation)

Files

• Control/Monad/Exception.hs +121/−56
• exception-mtl.cabal +9/−7

@@ -35,8 +35,10 @@ --------------------------------------------------------------------------------  {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-}  module Control.Monad.Exception (@@ -44,7 +46,7 @@     E.SomeException,      MonadException(..),-    MonadIOException(..),+    MonadAsyncException(..),      ExceptionT(..),     mapExceptionT,@@ -82,6 +84,11 @@ import Control.Monad.Writer.Strict as Strict (WriterT(..),                                               runWriterT) import Data.Monoid (Monoid)+import GHC.Base (RealWorld,+                 State#,+                 catchSTM#,+                 raiseIO#)+import GHC.Conc (STM(..))  class (Monad m) => MonadException m where     -- |Throw an exception.@@ -89,25 +96,37 @@     -- |Catch an exception.     catch :: E.Exception e => m a -> (e -> m a) -> m a -class (MonadIO m, MonadException m) => MonadIOException m where+class (MonadIO m, MonadException m) => MonadAsyncException m where     -- |Applying 'block' to a computation will execute that computation with     -- asynchronous exceptions /blocked/.-    block   :: m a -> m a+    block :: m a -> m a     -- |To re-enable asynchronous exceptions inside the scope of 'block',     -- 'unblock' can be used.     unblock :: m a -> m a -newtype ExceptionT m a = ExceptionT { runExceptionT :: m (Either E.SomeException a) }+--+-- The ExceptionT monad transformer.+-- +newtype ExceptionT m a =+    ExceptionT { runExceptionT :: m (Either E.SomeException a) }+ mapExceptionT :: (m (Either E.SomeException a) -> n (Either E.SomeException b))               -> ExceptionT m a               -> ExceptionT n b mapExceptionT f m = ExceptionT $ f (runExceptionT m) +-- |Lift the result of running a computation in a monad transformed by+-- 'ExceptionT' into another monad that supports exceptions. liftException :: MonadException m => Either E.SomeException a -> m a liftException (Left e)  = throw e liftException (Right a) = return a +instance MonadTrans ExceptionT where+    lift m = ExceptionT $ do+        a <- m+        return (Right a)+ instance (Monad m) => Functor (ExceptionT m) where     fmap f m = ExceptionT $ do         a <- runExceptionT m@@ -147,115 +166,161 @@                         Nothing -> return (Left l)           Right r -> return (Right r) -instance MonadTrans ExceptionT where-    lift m = ExceptionT $ do-        a <- m-        return (Right a)- instance (MonadIO m) => MonadIO (ExceptionT m) where     liftIO m = ExceptionT $ liftIO $         (m >>= return . Right)         `E.catch` \(e :: E.SomeException) -> return (Left e) -instance (MonadCont m) => MonadCont (ExceptionT m) where-    callCC f = ExceptionT $-        callCC $ \c ->-        runExceptionT (f (\a -> ExceptionT $ c (Right a)))--instance (MonadRWS r w s m) => MonadRWS r w s (ExceptionT m)--instance (MonadReader r m) => MonadReader r (ExceptionT m) where-    ask       = lift ask-    local f m = ExceptionT $ local f (runExceptionT m)--instance (MonadState s m) => MonadState s (ExceptionT m) where-    get = lift get-    put = lift . put+instance (MonadAsyncException m) => MonadAsyncException (ExceptionT m) where+    block   = ExceptionT . block . runExceptionT+    unblock = ExceptionT . unblock . runExceptionT -instance (MonadWriter w m) => MonadWriter w (ExceptionT m) where-    tell     = lift . tell-    listen m = ExceptionT $ do-        (a, w) <- listen (runExceptionT m)-        case a of-            Left  l -> return $ Left  l-            Right r -> return $ Right (r, w)-    pass   m = ExceptionT $ pass $ do-        a <- runExceptionT m-        case a of-            Left  l      -> return (Left  l, id)-            Right (r, f) -> return (Right r, f)+--+-- Instances for the IO monad.+--  instance MonadException IO where     catch = E.catch     throw = E.throw -instance (Monoid w, MonadException m) => MonadException (Lazy.RWST r w s m) where+instance MonadAsyncException IO where+    block   = E.block+    unblock = E.unblock++--+-- Instances for the STM monad.+--++instance MonadException STM where+    catch = catchSTM+    throw = throwSTM++unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))+unSTM (STM a) = a++catchSTM :: E.Exception e => STM a -> (e -> STM a) -> STM a+catchSTM (STM m) handler = STM $ catchSTM# m handler'+  where+    handler' e = case E.fromException e of+                   Just e' -> unSTM (handler e')+                   Nothing -> raiseIO# e++throwSTM :: E.Exception e => e -> STM a+throwSTM e = STM $ raiseIO# (E.toException e)++--+-- MonadException instances for mtl monad transformers.+--++instance (Monoid w, MonadException m) =>+    MonadException (Lazy.RWST r w s m) where     throw       = lift . throw     m `catch` h = Lazy.RWST $ \r s ->                   Lazy.runRWST m r s `catch` \e -> Lazy.runRWST (h e) r s -instance (Monoid w, MonadException m) => MonadException (Strict.RWST r w s m) where+instance (Monoid w, MonadException m) =>+    MonadException (Strict.RWST r w s m) where     throw       = lift . throw     m `catch` h = Strict.RWST $ \r s ->                   Strict.runRWST m r s `catch` \e -> Strict.runRWST (h e) r s -instance (MonadException m) => MonadException (ReaderT r m) where+instance (MonadException m) =>+    MonadException (ReaderT r m) where     throw       = lift . throw     m `catch` h = ReaderT $ \r ->                   runReaderT m r `catch` \e -> runReaderT (h e) r -instance (MonadException m) => MonadException (Lazy.StateT s m) where+instance (MonadException m) =>+    MonadException (Lazy.StateT s m) where     throw       = lift . throw     m `catch` h = Lazy.StateT $ \s ->                   Lazy.runStateT m s `catch` \e -> Lazy.runStateT (h e) s -instance (MonadException m) => MonadException (Strict.StateT s m) where+instance (MonadException m) =>+    MonadException (Strict.StateT s m) where     throw       = lift . throw     m `catch` h = Strict.StateT $ \s ->                   Strict.runStateT m s `catch` \e -> Strict.runStateT (h e) s -instance (Monoid w, MonadException m) => MonadException (Lazy.WriterT w m) where+instance (Monoid w, MonadException m) =>+    MonadException (Lazy.WriterT w m) where     throw       = lift . throw     m `catch` h = Lazy.WriterT $                   Lazy.runWriterT m `catch` \e -> Lazy.runWriterT (h e) -instance (Monoid w, MonadException m) => MonadException (Strict.WriterT w m) where+instance (Monoid w, MonadException m) =>+    MonadException (Strict.WriterT w m) where     throw       = lift . throw     m `catch` h = Strict.WriterT $                   Strict.runWriterT m `catch` \e -> Strict.runWriterT (h e) -instance MonadIOException IO where-    block   = E.block-    unblock = E.unblock--instance (MonadIOException m) => MonadIOException (ExceptionT m) where-    block   = ExceptionT . block . runExceptionT-    unblock = ExceptionT . block . runExceptionT+--+-- MonadAsyncException instances for mtl monad transformers.+-- -instance (Monoid w, MonadIOException m) => MonadIOException (Lazy.RWST r w s m) where+instance (Monoid w, MonadAsyncException m) =>+    MonadAsyncException (Lazy.RWST r w s m) where     block m    = Lazy.RWST $ \r s -> block (Lazy.runRWST m r s)     unblock m  = Lazy.RWST $ \r s -> unblock (Lazy.runRWST m r s) -instance (Monoid w, MonadIOException m) => MonadIOException (Strict.RWST r w s m) where+instance (Monoid w, MonadAsyncException m) =>+    MonadAsyncException (Strict.RWST r w s m) where     block m    = Strict.RWST $ \r s -> block (Strict.runRWST m r s)     unblock m  = Strict.RWST $ \r s -> unblock (Strict.runRWST m r s) -instance (MonadIOException m) => MonadIOException (ReaderT r m) where+instance (MonadAsyncException m) =>+    MonadAsyncException (ReaderT r m) where     block m    = ReaderT $ \r -> block (runReaderT m r)     unblock m  = ReaderT $ \r -> unblock (runReaderT m r) -instance (MonadIOException m) => MonadIOException (Lazy.StateT s m) where+instance (MonadAsyncException m) =>+    MonadAsyncException (Lazy.StateT s m) where     block m    = Lazy.StateT $ \s -> block (Lazy.runStateT m s)     unblock m  = Lazy.StateT $ \s -> unblock (Lazy.runStateT m s) -instance (MonadIOException m) => MonadIOException (Strict.StateT s m) where+instance (MonadAsyncException m) =>+    MonadAsyncException (Strict.StateT s m) where     block m    = Strict.StateT $ \s -> block (Strict.runStateT m s)     unblock m  = Strict.StateT $ \s -> unblock (Strict.runStateT m s) -instance (Monoid w, MonadIOException m) => MonadIOException (Lazy.WriterT w m) where+instance (Monoid w, MonadAsyncException m) =>+    MonadAsyncException (Lazy.WriterT w m) where     block m    = Lazy.WriterT $ block (Lazy.runWriterT m)     unblock m  = Lazy.WriterT $ unblock (Lazy.runWriterT m) -instance (Monoid w, MonadIOException m) => MonadIOException (Strict.WriterT w m) where+instance (Monoid w, MonadAsyncException m) =>+    MonadAsyncException (Strict.WriterT w m) where     block m    = Strict.WriterT $ block (Strict.runWriterT m)     unblock m  = Strict.WriterT $ unblock (Strict.runWriterT m)++--+-- mtl instances for transformed monads.+--++instance (MonadCont m) => MonadCont (ExceptionT m) where+    callCC f = ExceptionT $+        callCC $ \c ->+        runExceptionT (f (\a -> ExceptionT $ c (Right a)))++instance (MonadRWS r w s m) => MonadRWS r w s (ExceptionT m)++instance (MonadReader r m) => MonadReader r (ExceptionT m) where+    ask       = lift ask+    local f m = ExceptionT $ local f (runExceptionT m)++instance (MonadState s m) => MonadState s (ExceptionT m) where+    get = lift get+    put = lift . put++instance (MonadWriter w m) => MonadWriter w (ExceptionT m) where+    tell     = lift . tell+    listen m = ExceptionT $ do+        (a, w) <- listen (runExceptionT m)+        case a of+            Left  l -> return $ Left  l+            Right r -> return $ Right (r, w)+    pass   m = ExceptionT $ pass $ do+        a <- runExceptionT m+        case a of+            Left  l      -> return (Left  l, id)+            Right (r, f) -> return (Right r, f)

@@ -1,5 +1,5 @@ name:           exception-mtl-version:        0.1+version:        0.2 cabal-version:  >= 1.6 license:        BSD3 license-file:   LICENSE@@ -9,10 +9,11 @@ stability:      alpha homepage:       http://www.eecs.harvard.edu/~mainland/ category:       Control, Monad, Error Handling, Failure-synopsis:       An mtl-compatible monad transformer for unchecked extensible-		exceptions.-description:    This package provides a monad transformer that allows unchecked-		extensible exceptions to be thrown and caught.+synopsis:       Type classes and monads for unchecked extensible exceptions.+description:    This package provides type classes, a monad and a monad+		transformer that support unchecked extensible exceptions as+		well as asynchronous exceptions. It also provides instances for+		the classes defined by mtl.  build-type:     Simple @@ -21,8 +22,9 @@     Control.Monad.Exception    build-depends:-    base >= 4 && < 5,-    mtl >= 1.1 && < 1.2+    base >=4 && <5,+    mtl >=1.1 && <1.2,+    stm >=2.1 && <2.2    ghc-options:     -Wall