MonadCatchIO-transformers-0.3.0.0/0000755000000000000000000000000011740651533015017 5ustar0000000000000000MonadCatchIO-transformers-0.3.0.0/LICENSE0000644000000000000000000000303511740651533016025 0ustar0000000000000000The Takusen License Copyright 2004, Oleg Kiselyov, Alistair Bayley. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder(s) nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. MonadCatchIO-transformers-0.3.0.0/Setup.hs0000644000000000000000000000006011740651533016447 0ustar0000000000000000import Distribution.Simple main = defaultMain MonadCatchIO-transformers-0.3.0.0/MonadCatchIO-transformers.cabal0000644000000000000000000000172511740651533022764 0ustar0000000000000000Name: MonadCatchIO-transformers Version: 0.3.0.0 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE Description: Provides functions to throw and catch exceptions. Unlike the functions from @Control.Exception@, which work in @IO@, these work in any stack of monad transformers (from the 'transformers' package) with @IO@ as the base monad. You can extend this functionality to other monads, by creating an instance of the @MonadCatchIO@ class. Maintainer: ariep@xs4all.nl Category: Control Synopsis: Monad-transformer compatible version of the Control.Exception module Build-Type: Simple Source-repository head Type: darcs Location: http://patch-tag.com/r/AriePeterson/MonadCatchIO-transformers Library Build-Depends: base == 4.*, extensible-exceptions == 0.1.*, transformers >= 0.2 && < 0.4 Exposed-Modules: Control.Monad.CatchIO Hs-Source-Dirs: src Ghc-options: -Wall MonadCatchIO-transformers-0.3.0.0/src/0000755000000000000000000000000011740651533015606 5ustar0000000000000000MonadCatchIO-transformers-0.3.0.0/src/Control/0000755000000000000000000000000011740651533017226 5ustar0000000000000000MonadCatchIO-transformers-0.3.0.0/src/Control/Monad/0000755000000000000000000000000011740651533020264 5ustar0000000000000000MonadCatchIO-transformers-0.3.0.0/src/Control/Monad/CatchIO.hs0000644000000000000000000002141711740651533022077 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-} module Control.Monad.CatchIO ( MonadCatchIO(..) , E.Exception(..) , throw , try, tryJust , Handler(..), catches -- * Utilities , bracket , bracket_ , bracketOnError , finally , onException ) where import Prelude hiding ( catch ) import Control.Applicative ((<$>)) import qualified Control.Exception.Extensible as E import Control.Monad.IO.Class (MonadIO,liftIO) import Control.Monad.Trans.Cont (ContT(ContT) ,runContT ,mapContT ) import Control.Monad.Trans.Error (ErrorT ,runErrorT ,mapErrorT ,Error) import Control.Monad.Trans.Identity (IdentityT ,runIdentityT,mapIdentityT) import Control.Monad.Trans.List (ListT(ListT) ,runListT ,mapListT ) import Control.Monad.Trans.Maybe (MaybeT ,runMaybeT ,mapMaybeT ) import Control.Monad.Trans.RWS (RWST(RWST) ,runRWST ,mapRWST ) import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(RWST) ,runRWST ,mapRWST ) import Control.Monad.Trans.Reader (ReaderT(ReaderT),runReaderT ,mapReaderT ) import Control.Monad.Trans.State (StateT(StateT) ,runStateT ,mapStateT ) import qualified Control.Monad.Trans.State.Strict as Strict (StateT(StateT) ,runStateT ,mapStateT ) import Control.Monad.Trans.Writer (WriterT ,runWriterT ,mapWriterT ) import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT ,runWriterT ,mapWriterT ) 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 instance MonadCatchIO IO where catch = E.catch block = E.block unblock = E.unblock -- | Warning: this instance is somewhat contentious. -- -- In the same way that the @ErrorT e@ instance may fail to perform the final -- action, due to the \"early exit\" behaviour of the monad, this instance -- may perform the final action any number of times, due to the nonlinear -- nature of the continuation monad. -- -- See the mailing list message -- -- for an example of what can go wrong (freeing memory twice). instance MonadCatchIO m => MonadCatchIO (ContT r m) where m `catch` f = ContT $ \c -> runContT m c `catch` \e -> runContT (f e) c block = mapContT block unblock = mapContT unblock -- | Warning: this instance is somewhat contentious. -- -- Note that in monads that fall under this instance (the most basic example -- is @ErrorT e IO@), there are errors of two sorts: -- -- 1. exceptions, (i.e., exceptional values in the underlying @IO@ monad); -- -- 2. error values of type @e@, introduced by the @ErrorT e@ part of the monad. -- -- The instance takes no special action to deal with errors of type 2. -- In particular, 'bracket' will not perform its second argument, if -- its third argument decides to \"exit early\" by throwing an error of type 2. -- -- This may or may not be what you want. -- -- See the mailing list thread starting with -- -- for some details. 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 (MonadCatchIO m) => MonadCatchIO (IdentityT m) where m `catch` f = mapIdentityT (\m' -> m' `catch` \e -> runIdentityT $ f e) m block = mapIdentityT block unblock = mapIdentityT unblock instance MonadCatchIO m => MonadCatchIO (ListT m) where m `catch` f = ListT $ runListT m `catch` \e -> runListT (f e) block = mapListT block unblock = mapListT unblock instance (MonadCatchIO m) => MonadCatchIO (MaybeT m) where m `catch` f = mapMaybeT (\m' -> m' `catch` \e -> runMaybeT $ f e) m block = mapMaybeT block unblock = mapMaybeT 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 instance (Monoid w, MonadCatchIO m) => MonadCatchIO (Strict.RWST r w s m) where m `catch` f = Strict.RWST $ \r s -> Strict.runRWST m r s `catch` \e -> Strict.runRWST (f e) r s block = Strict.mapRWST block unblock = Strict.mapRWST 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 => MonadCatchIO (Strict.StateT s m) where m `catch` f = Strict.StateT $ \s -> Strict.runStateT m s `catch` \e -> Strict.runStateT (f e) s block = Strict.mapStateT block unblock = Strict.mapStateT unblock instance (Monoid w, MonadCatchIO m) => MonadCatchIO (WriterT w m) where m `catch` f = mapWriterT (\m' -> m' `catch` \e -> runWriterT $ f e) m block = mapWriterT block unblock = mapWriterT unblock instance (Monoid w, MonadCatchIO m) => MonadCatchIO (Strict.WriterT w m) where m `catch` f = Strict.mapWriterT (\m' -> m' `catch` \e -> Strict.runWriterT $ f e) m block = Strict.mapWriterT block unblock = Strict.mapWriterT 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, Functor m, E.Exception e) => m a -> m (Either e a) try a = catch (Right <$> a) (return . Left) -- | Generalized version of 'E.tryJust' tryJust :: (MonadCatchIO m, Functor 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) -- | 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 = maybe res h $ E.fromException e -- | 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) -- | A variant of 'bracket' where the return value from the first computation -- is not required. bracket_ :: MonadCatchIO m => m a -- ^ computation to run first (\"acquire resource\") -> m b -- ^ computation to run last (\"release resource\") -> m c -- ^ computation to run in-between -> m c -- returns the value from the in-between computation bracket_ before after thing = block $ do _ <- before r <- unblock thing `onException` after _ <- after return r -- | A specialised variant of 'bracket' with just a computation to run -- afterward. finally :: MonadCatchIO m => m a -- ^ computation to run first -> m b -- ^ computation to run afterward (even if an exception was -- raised) -> m a -- returns the value from the first computation thing `finally` after = block $ do r <- unblock thing `onException` after _ <- after return r -- | Like 'bracket', but only performs the final action if there was an -- exception raised by the in-between computation. bracketOnError :: MonadCatchIO 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 bracketOnError before after thing = block $ do a <- before unblock (thing a) `onException` after a