MonadCatchIO-transformers 0.0.2.0 → 0.1.0.0

raw patch · 2 files changed

+56/−61 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• MonadCatchIO-transformers.cabal +1/−1
• src/Control/Monad/CatchIO.hs +55/−60

@@ -1,5 +1,5 @@ Name:            MonadCatchIO-transformers-Version:         0.0.2.0+Version:         0.1.0.0 Cabal-Version:   >= 1.2 License:         PublicDomain Description:

@@ -27,91 +27,86 @@ import Control.Monad.Trans.RWS    (RWST(RWST)      ,runRWST   ,mapRWST   ) import Data.Monoid                (Monoid) -class MonadIO m => MonadCatchIO m where-    -- | Generalized version of 'E.catch'-    catch   :: E.Exception e => m a -> (e -> 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 e) => e -> m a---- | Generalized version of 'E.try'-try :: (MonadCatchIO m, E.Exception e) => m a -> m (Either e a)---- | Generalized version of 'E.tryJust'-tryJust :: (MonadCatchIO m, E.Exception e)-        => (e -> Maybe b) -> m a -> m (Either b a)---- | Generalized version of 'E.Handler'-data Handler m a = forall e . E.Exception e => Handler (e -> m a)---- | Generalized version of 'E.catches'-catches :: MonadCatchIO m => m a -> [Handler m a] -> m a-catches a handlers = a `catch` handler-    where handler e = foldr tryH (throw e) handlers-            where tryH (Handler h) res = case E.fromException e of-                                             Just e' -> h e'-                                             Nothing -> res+class MonadIO m => MonadCatchIO m where+  -- | Generalized version of 'E.catch'+  catch   :: E.Exception e => m a -> (e -> m a) -> m a+  +  -- | Generalized version of 'E.block'+  block   :: m a -> m a+  +  -- | Generalized version of 'E.unblock'+  unblock :: m a -> m a   instance MonadCatchIO IO where-    catch   = E.catch-    block   = E.block-    unblock = E.unblock+  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+  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+  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+  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+  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+  m `catch` f = RWST $ \r s -> runRWST m r s `catch` \e -> runRWST (f e) r s+  block       = mapRWST block+  unblock     = mapRWST unblock ++-- | Generalized version of 'E.throwIO'+throw :: (MonadIO m, E.Exception e) => e -> m a throw = liftIO . E.throwIO +-- | Generalized version of 'E.try'+try :: (MonadCatchIO m, E.Exception e) => m a -> m (Either e a) try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) +-- | Generalized version of 'E.tryJust'+tryJust :: (MonadCatchIO m, E.Exception e)+        => (e -> Maybe b) -> m a -> m (Either b a) 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)+    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.Handler'+data Handler m a = forall e . E.Exception e => Handler (e -> m a)++-- | Generalized version of 'E.catches'+catches :: MonadCatchIO m => m a -> [Handler m a] -> m a+catches a handlers = a `catch` handler where+  handler e = foldr tryH (throw e) handlers where+    tryH (Handler h) res = case E.fromException e of+      Just e' -> h e'+      Nothing -> res+ -- | 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)+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