exception-transformers 0.2 → 0.3

raw patch · 3 files changed

+210/−47 lines, 3 filesdep ~basedep ~stmPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, stm

API changes (from Hackage documentation)

Files

• Control/Monad/Exception.hs +206/−43
• LICENSE +1/−1
• exception-transformers.cabal +3/−3

@@ -1,4 +1,4 @@--- Copyright (c) 2008-2010+-- Copyright (c) 2008-2011 --         The President and Fellows of Harvard College. -- -- Redistribution and use in source and binary forms, with or without@@ -28,13 +28,15 @@ -------------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Exception--- Copyright   :  (c) Harvard University 2008-2010+-- Copyright   :  (c) Harvard University 2008-2011 -- License     :  BSD-style -- Maintainer  :  mainland@eecs.harvard.edu -- -------------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} @@ -43,7 +45,11 @@     E.SomeException,      MonadException(..),+    onException,+     MonadAsyncException(..),+    bracket,+    bracket_,      ExceptionT(..),     mapExceptionT,@@ -52,50 +58,139 @@  import Prelude hiding (catch) +import Control.Applicative import qualified Control.Exception as E (Exception(..),                                          SomeException,-                                         block,                                          catch,                                          throw,+                                         finally)+#if __GLASGOW_HASKELL__ >= 700+import qualified Control.Exception as E (mask)+#else /* __GLASGOW_HASKELL__ < 700 */+import qualified Control.Exception as E (block,+                                         blocked,                                          unblock)+#endif /* __GLASGOW_HASKELL__ < 700 */ import Control.Monad (MonadPlus(..)) import Control.Monad.Fix (MonadFix(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.Trans.Error (Error(..),+                                  ErrorT(..),+                                  mapErrorT,+                                  runErrorT)+import Control.Monad.Trans.Identity (IdentityT(..),+                                     mapIdentityT,+                                     runIdentityT)+import Control.Monad.Trans.List (ListT(..),+                                 mapListT,+                                 runListT)+import Control.Monad.Trans.Maybe (MaybeT(..),+                                  mapMaybeT,+                                  runMaybeT) import Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..),+                                             mapRWST,                                              runRWST) import Control.Monad.Trans.RWS.Strict as Strict (RWST(..),+                                                 mapRWST,                                                  runRWST)-import Control.Monad.Trans.Reader (ReaderT(..))+import Control.Monad.Trans.Reader (ReaderT(..),+                                   mapReaderT) import Control.Monad.Trans.State.Lazy as Lazy (StateT(..),+                                               mapStateT,                                                runStateT) import Control.Monad.Trans.State.Strict as Strict (StateT(..),+                                                   mapStateT,                                                    runStateT) import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..),+                                                mapWriterT,                                                 runWriterT) import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..),+                                                    mapWriterT,                                                     runWriterT) import Data.Monoid (Monoid)+#if __GLASGOW_HASKELL__ >= 700+import GHC.Conc.Sync (STM(..),+                      catchSTM,+                      throwSTM)+#else /* __GLASGOW_HASKELL__ < 700 */ import GHC.Base (RealWorld,                  State#,                  catchSTM#,                  raiseIO#) import GHC.Conc (STM(..))+#endif /* __GLASGOW_HASKELL__ < 700 */  class (Monad m) => MonadException m where-    -- |Throw an exception.+    -- | Throw an exception.     throw :: E.Exception e => e -> m a-    -- |Catch an exception.-    catch :: E.Exception e => m a -> (e -> m a) -> m a+    -- | Catch an exception.+    catch :: E.Exception e+          => m a        -- ^ The computation to run+          -> (e -> m a) -- ^ Handler to invoke if an exception is raised+          -> m a+    -- | Run a computation and always perform a second, final computation even+    -- if an exception is raised. If a short-circuiting monad transformer such+    -- as ErrorT or MaybeT is used to transform a MonadException monad, then the+    -- implementation of @finally@ for the transformed monad must guarantee that+    -- the final action is also always performed when any short-circuiting+    -- occurs.+    finally :: m a  -- ^ The computation to run+            -> m b  -- ^ Computation to run afterward (even if an exception was+                    -- raised)+            -> m a+    act `finally` sequel = do+        a <- act `catch` \(e :: E.SomeException) -> sequel >> throw e+        _ <- sequel+        return a +-- | If an exception is raised by the computation, then perform a final action+-- and re-raise the exception. If a short-circuiting monad transformer such as+-- ErrorT or MaybeT is used to transform a MonadException monad, then the+-- onException implementation for the transformer must guarantee that the final+-- action is also performed when any short-circuiting occurs.+onException :: MonadException m+            => m a -- ^ The computation to run+            -> m b -- ^ Computation to run if an exception is raised+            -> m a+onException act what =+    act `catch` \(e :: E.SomeException) -> what >> throw e+ 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-    -- |To re-enable asynchronous exceptions inside the scope of 'block',-    -- 'unblock' can be used.-    unblock :: m a -> m a+    -- | Executes a computation with asynchronous exceptions /masked/. The+    -- argument passed to 'mask' is a function that takes as its argument+    -- another function, which can be used to restore the prevailing masking+    -- state within the context of the masked computation.+    mask :: ((forall a. m a -> m a) -> m b) -> m b +-- | When you want to acquire a resource, do some work with it, and then release+-- the resource, it is a good idea to use 'bracket', because 'bracket' will+-- install the necessary exception handler to release the resource in the event+-- that an exception is raised during the computation.  If an exception is+-- raised, then 'bracket' will re-raise the exception (after performing the+-- release).+bracket :: MonadAsyncException m+        => m a         -- ^ computation to run first (\"acquire resource\")+        -> (a -> m b)  -- ^ computation to run last (\"release resource\")+        -> (a -> m c)  -- ^ computation to run in-between+        -> m c         -- returns the value from the in-between computation+bracket before after thing =+    mask $ \restore -> do+        a <- before+        r <- restore (thing a) `onException` after a+        _ <- after a+        return r++-- | A variant of 'bracket' where the return value from the first computation is+-- not required.+bracket_ :: MonadAsyncException m+         => m a+         -> m b+         -> m c+         -> m c+bracket_ before after thing =+    bracket before (const after) (const thing)+ -- -- The ExceptionT monad transformer. --@@ -106,9 +201,9 @@ mapExceptionT :: (m (Either E.SomeException a) -> n (Either E.SomeException b))               -> ExceptionT m a               -> ExceptionT n b-mapExceptionT f m = ExceptionT $ f (runExceptionT m)+mapExceptionT f = ExceptionT . f . runExceptionT --- |Lift the result of running a computation in a monad transformed by+-- | 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@@ -119,12 +214,8 @@         a <- m         return (Right a) -instance (Monad m) => Functor (ExceptionT m) where-    fmap f m = ExceptionT $ do-        a <- runExceptionT m-        case a of-            Left  l -> return (Left  l)-            Right r -> return (Right (f r))+instance (Functor m) => Functor (ExceptionT m) where+    fmap f = ExceptionT . fmap (fmap f) . runExceptionT  instance (Monad m) => Monad (ExceptionT m) where     return a = ExceptionT $ return (Right a)@@ -143,6 +234,22 @@           Left _  -> runExceptionT n           Right r -> return (Right r) +instance (Functor m, Monad m) => Applicative (ExceptionT m) where+    pure a  = ExceptionT $ return (Right a)+    f <*> v = ExceptionT $ do+        mf <- runExceptionT f+        case mf of+            Left  e -> return (Left e)+            Right k -> do+                mv <- runExceptionT v+                case mv of+                    Left  e -> return (Left e)+                    Right x -> return (Right (k x))++instance (Functor m, Monad m) => Alternative (ExceptionT m) where+    empty = mzero+    (<|>) = mplus+ instance (MonadFix m) => MonadFix (ExceptionT m) where     mfix f = ExceptionT $ mfix $ \a -> runExceptionT $ f $ case a of         Right r -> r@@ -160,24 +267,32 @@  instance (MonadIO m) => MonadIO (ExceptionT m) where     liftIO m = ExceptionT $ liftIO $-        (m >>= return . Right)-        `E.catch` \(e :: E.SomeException) -> return (Left e)+        fmap Right m `E.catch` \(e :: E.SomeException) -> return (Left e)  instance (MonadAsyncException m) => MonadAsyncException (ExceptionT m) where-    block   = ExceptionT . block . runExceptionT-    unblock = ExceptionT . unblock . runExceptionT+    mask act = ExceptionT $ mask $ \restore ->+               runExceptionT $ act (mapExceptionT restore)  -- -- Instances for the IO monad. --  instance MonadException IO where-    catch = E.catch-    throw = E.throw+    catch   = E.catch+    throw   = E.throw+    finally = E.finally +#if __GLASGOW_HASKELL__ >= 700 instance MonadAsyncException IO where-    block   = E.block-    unblock = E.unblock+    mask = E.mask+#else /* __GLASGOW_HASKELL__ < 700 */+instance MonadAsyncException IO where+    mask act = do+        b <- E.blocked+        if b+          then act id+          else E.block $ act E.unblock+#endif /* __GLASGOW_HASKELL__ < 700 */  -- -- Instances for the STM monad.@@ -187,6 +302,7 @@     catch = catchSTM     throw = throwSTM +#if __GLASGOW_HASKELL__ < 700 unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #)) unSTM (STM a) = a @@ -199,11 +315,38 @@  throwSTM :: E.Exception e => e -> STM a throwSTM e = STM $ raiseIO# (E.toException e)+#endif /* __GLASGOW_HASKELL__ < 700 */  -- -- MonadException instances for transformers. -- +instance (MonadException m, Error e) =>+    MonadException (ErrorT e m) where+    throw       = lift . throw+    m `catch` h = mapErrorT (\m' -> m' `catch` \e -> runErrorT (h e)) m++    act `finally` sequel =+        mapErrorT (\act' -> act' `finally` runErrorT sequel) act++instance (MonadException m) =>+    MonadException (IdentityT m) where+    throw       = lift . throw+    m `catch` h = mapIdentityT (\m' -> m' `catch` \e -> runIdentityT (h e)) m++instance MonadException m =>+    MonadException (ListT m) where+    throw       = lift . throw+    m `catch` h = mapListT (\m' -> m' `catch` \e -> runListT (h e)) m++instance (MonadException m) =>+    MonadException (MaybeT m) where+    throw       = lift . throw+    m `catch` h = mapMaybeT (\m' -> m' `catch` \e -> runMaybeT (h e)) m++    act `finally` sequel =+        mapMaybeT (\act' -> act' `finally` runMaybeT sequel) act+ instance (Monoid w, MonadException m) =>     MonadException (Lazy.RWST r w s m) where     throw       = lift . throw@@ -250,37 +393,57 @@ -- MonadAsyncException instances for transformers. -- +instance (MonadAsyncException m, Error e) =>+    MonadAsyncException (ErrorT e m) where+    mask act = ErrorT $ mask $ \restore ->+               runErrorT $ act (mapErrorT restore)++instance (MonadAsyncException m) =>+    MonadAsyncException (IdentityT m) where+    mask act = IdentityT $ mask $ \restore ->+               runIdentityT $ act (mapIdentityT restore)++instance (MonadAsyncException m) =>+    MonadAsyncException (ListT m) where+    mask act = ListT $ mask $ \restore ->+               runListT $ act (mapListT restore)++instance (MonadAsyncException m) =>+    MonadAsyncException (MaybeT m) where+    mask act = MaybeT $ mask $ \restore ->+               runMaybeT $ act (mapMaybeT restore)+ 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)+    mask act = Lazy.RWST $ \r s -> mask $ \restore ->+               Lazy.runRWST (act (Lazy.mapRWST restore)) r s  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)+    mask act = Strict.RWST $ \r s -> mask $ \restore ->+               Strict.runRWST (act (Strict.mapRWST restore)) r s  instance (MonadAsyncException m) =>     MonadAsyncException (ReaderT r m) where-    block m    = ReaderT $ \r -> block (runReaderT m r)-    unblock m  = ReaderT $ \r -> unblock (runReaderT m r)+    mask act = ReaderT $ \r -> mask $ \restore ->+               runReaderT (act (mapReaderT restore)) r  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)+    mask act = Lazy.StateT $ \s -> mask $ \restore ->+               Lazy.runStateT (act (Lazy.mapStateT restore)) s  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)+    mask act = Strict.StateT $ \s -> mask $ \restore ->+               Strict.runStateT (act (Strict.mapStateT restore)) s  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)+    mask act = Lazy.WriterT $ mask $ \restore ->+               Lazy.runWriterT $ act (Lazy.mapWriterT restore)  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)+    mask act = Strict.WriterT $ mask $ \restore ->+               Strict.runWriterT $ act (Strict.mapWriterT restore)

@@ -1,4 +1,4 @@-Copyright (c) 2008-2010+Copyright (c) 2008-2011         The President and Fellows of Harvard College.  Redistribution and use in source and binary forms, with or without

@@ -1,9 +1,9 @@ name:           exception-transformers-version:        0.2+version:        0.3 cabal-version:  >= 1.6 license:        BSD3 license-file:   LICENSE-copyright:      (c) 2008-2010 Harvard University+copyright:      (c) 2008-2011 Harvard University author:         Geoffrey Mainland <mainland@eecs.harvard.edu> maintainer:     mainland@eecs.harvard.edu stability:      alpha@@ -23,7 +23,7 @@    build-depends:     base >=4 && <5,-    stm >=2.1 && <2.2,+    stm >=2.1 && <2.3,     transformers >=0.2 && <0.3    ghc-options: