MonadCatchIO-mtl 0.1.0.1 → 0.2.0.0

raw patch · 4 files changed

+64/−143 lines, 4 filesdep +extensible-exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: extensible-exceptions

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Control/Monad/CatchIO.hs +59/−2
• Control/Monad/CatchIO/Old.hs +0/−57
• Control/Monad/generic-code.inc +0/−60
• MonadCatchIO-mtl.cabal +5/−24

@@ -2,13 +2,14 @@                                E.Exception(..),                                throw,                                try, tryJust,+                               onException, bracket,                                Handler(..), catches )  where  import Prelude hiding ( catch ) -import qualified Control.Exception as E+import qualified Control.Exception.Extensible as E  import Control.Monad.Reader import Control.Monad.State@@ -48,4 +49,60 @@                                              Nothing -> res  -#include "generic-code.inc"+instance MonadCatchIO IO where+    catch   = E.catch+    block   = E.block+    unblock = E.unblock++instance MonadCatchIO m => MonadCatchIO (ReaderT r m) where+    m `catch` f = ReaderT $ \r -> (runReaderT m r)+                                    `catch` (\e -> runReaderT (f e) r)+    block       = mapReaderT block+    unblock     = mapReaderT unblock++instance MonadCatchIO m => MonadCatchIO (StateT s m) where+    m `catch` f = StateT $ \s -> (runStateT m s)+                                   `catch` (\e -> runStateT (f e) s)+    block       = mapStateT block+    unblock     = mapStateT unblock++instance (MonadCatchIO m, Error e) => MonadCatchIO (ErrorT e m) where+    m `catch` f = mapErrorT (\m' -> m' `catch` (\e -> runErrorT $ f e)) m+    block       = mapErrorT block+    unblock     = mapErrorT unblock++instance (Monoid w, MonadCatchIO m) => MonadCatchIO (WriterT w m) where+    m `catch` f = WriterT $ runWriterT m+                              `catch` \e -> runWriterT (f e)+    block       = mapWriterT block+    unblock     = mapWriterT unblock++instance (Monoid w, MonadCatchIO m) => MonadCatchIO (RWST r w s m) where+    m `catch` f = RWST $ \r s -> runRWST m r s+                           `catch` \e -> runRWST (f e) r s+    block       = mapRWST block+    unblock     = mapRWST unblock++throw = liftIO . E.throwIO++try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))++tryJust p a = do+  r <- try a+  case r of+        Right v -> return (Right v)+        Left  e -> case p e of+                        Nothing -> throw e `asTypeOf` (return $ Left undefined)+                        Just b  -> return (Left b)++-- | Generalized version of 'E.bracket'+bracket :: MonadCatchIO m => m a -> (a -> m b) -> (a -> m c) -> m c+bracket before after thing =+    block (do a <- before+              r <- unblock (thing a) `onException` after a+              after a+              return r)++-- | Generalized version of 'E.onException'+onException :: MonadCatchIO m => m a -> m b -> m a+onException a onEx = a `catch` (\(e::E.SomeException) -> onEx >> throw e)

@@ -1,57 +0,0 @@-module Control.Monad.CatchIO.Old ( MonadCatchIO(..),-                                   E.Exception(..),-                                   throw,-                                   throwDyn, catchDyn,-                                   try, tryJust )--where--#if __BASE_VERSION__ == 3-import qualified Control.Exception as E-#else-import qualified Control.OldException as E-#endif--import Prelude hiding ( catch )--import Data.Dynamic--import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.Error-import Control.Monad.Writer-import Control.Monad.RWS--class MonadIO m => MonadCatchIO m where-    -- | Generalized version of 'E.catch'-    catch :: m a -> (E.Exception -> m a) -> m a--    -- | Generalized version of 'E.block'-    block   :: m a -> m a--    -- | Generalized version of 'E.unblock'-    unblock :: m a -> m a---- | Generalized version of 'E.throwIO'-throw :: MonadCatchIO m => E.Exception -> m a---- | Generalized version of 'E.try'-try :: MonadCatchIO m => m a -> m (Either E.Exception a)---- | Generalized version of 'E.tryJust'-tryJust :: MonadCatchIO m => (E.Exception -> Maybe b) -> m a -> m (Either b a)----#include "../generic-code.inc"--throwDyn :: Typeable e => e -> b-throwDyn = E.throw . E.DynException . toDyn--catchDyn :: (Typeable e, MonadCatchIO m) => m a -> (e -> m a) -> m a-catchDyn a f = a `catch` handler-    where handler e = case e of-                        E.DynException dyn -> case fromDynamic dyn of-                                                Just exception  -> f exception-                                                Nothing         -> E.throw e-                        _                  -> E.throw e

@@ -1,60 +0,0 @@--instance MonadCatchIO IO where-    catch   = E.catch-    block   = E.block-    unblock = E.unblock--instance MonadCatchIO m => MonadCatchIO (ReaderT r m) where-    m `catch` f = ReaderT $ \r -> (runReaderT m r)-                                    `catch` (\e -> runReaderT (f e) r)-    block       = mapReaderT block-    unblock     = mapReaderT unblock--instance MonadCatchIO m => MonadCatchIO (StateT s m) where-    m `catch` f = StateT $ \s -> (runStateT m s)-                                   `catch` (\e -> runStateT (f e) s)-    block       = mapStateT block-    unblock     = mapStateT unblock--instance (MonadCatchIO m, Error e) => MonadCatchIO (ErrorT e m) where-    m `catch` f = mapErrorT (\m' -> m' `catch` (\e -> runErrorT $ f e)) m-    block       = mapErrorT block-    unblock     = mapErrorT unblock--instance (Monoid w, MonadCatchIO m) => MonadCatchIO (WriterT w m) where-    m `catch` f = WriterT $ runWriterT m-                              `catch` \e -> runWriterT (f e)-    block       = mapWriterT block-    unblock     = mapWriterT unblock--instance (Monoid w, MonadCatchIO m) => MonadCatchIO (RWST r w s m) where-    m `catch` f = RWST $ \r s -> runRWST m r s-                           `catch` \e -> runRWST (f e) r s-    block       = mapRWST block-    unblock     = mapRWST unblock--throw = liftIO . E.throwIO--try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))--tryJust p a = do-  r <- try a-  case r of-        Right v -> return (Right v)-        Left  e -> case p e of-                        Nothing -> throw e `asTypeOf` (return $ Left undefined)-                        Just b  -> return (Left b)--{---- | Generalized version of 'E.bracket'-bracket :: MonadCatchIO m => m a -> (a -> m b) -> (a -> m c) -> IO c-bracket before after thing =-    block (do a <- before-              r <- unblock (thing a) `onException` after a-              after a-              return r)---- | Generalized version of 'E.onException'-onException :: MonadCatchIO m => m a -> m b -> m a-onException action onEx = action `catch` (\e -> do onEx; throw e)--}

@@ -1,5 +1,5 @@ name:                MonadCatchIO-mtl-version:             0.1.0.1+version:             0.2.0.0 description:         Provides a monad-transformer version of the @Control.Exception.catch@         function. For this, it defines the @MonadCatchIO@ class, a subset of@@ -16,29 +16,10 @@ build-type:         Simple tested-with:        GHC==6.10 -extra-source-files: Control/Monad/generic-code.inc--Flag base3-  description: Don't expect the new Control.Exception module (prior to base-4)-  default: False- Library-  build-depends:    mtl+  build-depends:    base, mtl, extensible-exceptions   ghc-options:      -Wall-  extensions:       CPP-                    ExistentialQuantification--  if flag(base3) {-    build-depends: base < 4-  } else {-    build-depends: base >= 4-  }--  exposed-modules: Control.Monad.CatchIO.Old+  extensions:       ExistentialQuantification,+                    ScopedTypeVariables -  if flag(base3) {-    cpp-options: -D__BASE_VERSION__=3-  } else {-    cpp-options: -D__BASE_VERSION__=4-    exposed-modules:  Control.Monad.CatchIO-  }+  exposed-modules: Control.Monad.CatchIO