exceptions-0.8.0.2/0000755000000000000000000000000012501063347012227 5ustar0000000000000000exceptions-0.8.0.2/.ghci0000644000000000000000000000010712501063347013140 0ustar0000000000000000:set -isrc -idist/build/autogen -optPdist/build/autogen/cabal_macros.h exceptions-0.8.0.2/.gitignore0000644000000000000000000000010412501063347014212 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# exceptions-0.8.0.2/.travis.yml0000644000000000000000000000340112501063347014336 0ustar0000000000000000# NB: don't set `language: haskell` here # See also https://github.com/hvr/multi-ghc-travis for more information env: # we have to use CABALVER=1.16 for GHC<7.6 as well, as there's # no package for earlier cabal versions in the PPA - GHCVER=7.4.2 CABALVER=1.16 - GHCVER=7.6.3 CABALVER=1.16 - GHCVER=7.8.4 CABALVER=1.18 - GHCVER=7.10.1 CABALVER=1.22 - GHCVER=head CABALVER=1.22 matrix: allow_failures: - env: GHCVER=head CABALVER=1.22 # Note: the distinction between `before_install` and `install` is not # important. before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - cabal --version install: - travis_retry cabal update - cabal install --only-dependencies # Here starts the actual work to be performed for the package under # test; any command which exits with a non-zero exit code causes the # build to fail. script: # -v2 provides useful information for debugging - cabal configure -v2 # this builds all libraries and executables # (including tests/benchmarks) - cabal build # tests that a source-distribution can be generated - cabal sdist # check that the generated source-distribution can be built & installed - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; cd dist/; if [ -f "$SRC_TGZ" ]; then cabal install --force-reinstalls "$SRC_TGZ"; else echo "expected '$SRC_TGZ' not found"; exit 1; fi notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313exceptions\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" exceptions-0.8.0.2/.vim.custom0000644000000000000000000000137712501063347014344 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" exceptions-0.8.0.2/AUTHORS.markdown0000644000000000000000000000013012501063347015112 0ustar0000000000000000`exceptions` is based on code contributed by [Mark Lentzcner](http://github.com/mzero). exceptions-0.8.0.2/CHANGELOG.markdown0000644000000000000000000000214112501063347015260 0ustar00000000000000000.8.0.1 ------- * Resolved warnings on GHC 7.10 and with transformers 0.4. 0.8 --- * Use `transformers-compat` to allow support for `ExceptT` even on older `transformers` versions. 0.7 --- * `stm` support 0.6 --- * Split out `MonadMask` * Added `transformers` 0.4 support 0.5 --- * Added instances of `MonadThrow` for `ListT`, `MaybeT`, `ErrorT` and `ContT`. 0.4 --- * Factored out a separate `MonadThrow`. 0.3.3.1 ------- * QuickCheck dependency bump 0.3.3 ----- * Relicensed under the 3-clause BSD license. 0.3.2 ----- * Better documentation for `CatchT`. * Added `handle`-like analogues for parity with `Control.Exception`. 0.3.1 ----- * Fixed test suite. 0.3 --- * Moved `CatchT` to `Control.Monad.Catch.Pure` to make it clear it isn't required for working with `IO`. 0.2.1 --- * Added `mask_` and `uninterruptibleMask_` to `Control.Monad.Catch`. 0.2 --- * Added `uninterruptibleMask` to `MonadCatch`. 0.1.1 ----- * Flagged `Control.Monad.Catch` as `Trustworthy` 0.1.0.1 ----- * License fix. We were accidentally listing both an APL and BSD3 license in the same module 0.1 --- * Repository initialized exceptions-0.8.0.2/exceptions.cabal0000644000000000000000000000337312501063347015402 0ustar0000000000000000name: exceptions category: Control, Exceptions, Monad version: 0.8.0.2 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/exceptions/ bug-reports: http://github.com/ekmett/exceptions/issues copyright: Copyright (C) 2013-2015 Edward A. Kmett Copyright (C) 2012 Google Inc. build-type: Simple tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.0.20150307 synopsis: Extensible optionally-pure exceptions description: Extensible optionally-pure exceptions extra-source-files: .travis.yml .ghci .gitignore .vim.custom travis/cabal-apt-install travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/exceptions.git library build-depends: base >= 4.3 && < 5, stm >= 2.2 && < 3, transformers >= 0.2 && < 0.5, transformers-compat >= 0.3 && < 0.5, mtl >= 2.0 && < 2.3 exposed-modules: Control.Monad.Catch Control.Monad.Catch.Pure ghc-options: -Wall -fwarn-tabs -O2 hs-source-dirs: src test-suite exceptions-tests main-is: Tests.hs other-modules: Control.Monad.Catch.Tests hs-source-dirs: src, tests ghc-options: -Wall -fwarn-tabs type: exitcode-stdio-1.0 build-depends: base, stm, transformers, transformers-compat, mtl, test-framework >= 0.8 && < 0.9, test-framework-quickcheck2 >= 0.3 && < 0.4, QuickCheck >= 2.5 && < 2.8 exceptions-0.8.0.2/LICENSE0000644000000000000000000000271312501063347013237 0ustar0000000000000000Copyright 2013-2015 Edward Kmett Copyright 2012 Google Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. exceptions-0.8.0.2/README.markdown0000644000000000000000000000072112501063347014730 0ustar0000000000000000exceptions ========== [![Build Status](https://secure.travis-ci.org/ekmett/exceptions.png?branch=master)](http://travis-ci.org/ekmett/exceptions) This package provides (optionally pure) extensible exceptions that are compatible with the monad transformer library. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett exceptions-0.8.0.2/Setup.lhs0000644000000000000000000000016512501063347014041 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain exceptions-0.8.0.2/src/0000755000000000000000000000000012501063347013016 5ustar0000000000000000exceptions-0.8.0.2/src/Control/0000755000000000000000000000000012501063347014436 5ustar0000000000000000exceptions-0.8.0.2/src/Control/Monad/0000755000000000000000000000000012501063347015474 5ustar0000000000000000exceptions-0.8.0.2/src/Control/Monad/Catch.hs0000644000000000000000000004660712501063347017067 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_transformers #define MIN_VERSION_transformers(x,y,z) 1 #endif #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1 #endif {-# OPTIONS_GHC -fno-warn-deprecations #-} -------------------------------------------------------------------- -- | -- Copyright : (C) Edward Kmett 2013-2015, (c) Google Inc. 2012 -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module supports monads that can throw extensible exceptions. The -- exceptions are the very same from "Control.Exception", and the operations -- offered very similar, but here they are not limited to 'IO'. -- -- This code is in the style of both transformers and mtl, and is compatible -- with them, though doesn't mimic the module structure or offer the complete -- range of features in those packages. -- -- This is very similar to 'ErrorT' and 'MonadError', but based on features of -- "Control.Exception". In particular, it handles the complex case of -- asynchronous exceptions by including 'mask' in the typeclass. Note that the -- extensible extensions feature relies on the RankNTypes language extension. -------------------------------------------------------------------- module Control.Monad.Catch ( -- * Typeclass -- $mtl MonadThrow(..) , MonadCatch(..) , MonadMask(..) -- * Utilities -- $utilities , mask_ , uninterruptibleMask_ , catchAll , catchIOError , catchJust , catchIf , Handler(..), catches , handle , handleAll , handleIOError , handleJust , handleIf , try , tryJust , onException , bracket , bracket_ , finally , bracketOnError -- * Re-exports from Control.Exception , Exception(..) , SomeException(..) ) where import Control.Exception (Exception(..), SomeException(..)) import qualified Control.Exception as ControlException import qualified Control.Monad.STM as STM import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS import qualified Control.Monad.Trans.RWS.Strict as StrictRWS import qualified Control.Monad.Trans.State.Lazy as LazyS import qualified Control.Monad.Trans.State.Strict as StrictS import qualified Control.Monad.Trans.Writer.Lazy as LazyW import qualified Control.Monad.Trans.Writer.Strict as StrictW import Control.Monad.STM (STM) import Control.Monad.Trans.List (ListT(..), runListT) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Control.Monad.Trans.Error (ErrorT(..), Error, runErrorT) import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Control.Monad.Trans.Cont (ContT) import Control.Monad.Trans.Identity import Control.Monad.Reader as Reader #if __GLASGOW_HASKELL__ < 706 import Prelude hiding (catch, foldr) import Data.Foldable import Data.Monoid #elif __GLASGOW_HASKELL__ < 710 import Prelude hiding (foldr) import Data.Foldable import Data.Monoid #endif ------------------------------------------------------------------------------ -- $mtl -- The mtl style typeclass ------------------------------------------------------------------------------ -- | A class for monads in which exceptions may be thrown. -- -- Instances should obey the following law: -- -- > throwM e >> x = throwM e -- -- In other words, throwing an exception short-circuits the rest of the monadic -- computation. class Monad m => MonadThrow m where -- | Throw an exception. Note that this throws when this action is run in -- the monad @m@, not when it is applied. It is a generalization of -- "Control.Exception"'s 'ControlException.throwIO'. -- -- Should satisfy the law: -- -- > throwM e >> f = throwM e throwM :: Exception e => e -> m a -- | A class for monads which allow exceptions to be caught, in particular -- exceptions which were thrown by 'throwM'. -- -- Instances should obey the following law: -- -- > catch (throwM e) f = f e -- -- Note that the ability to catch an exception does /not/ guarantee that we can -- deal with all possible exit points from a computation. Some monads, such as -- continuation-based stacks, allow for more than just a success/failure -- strategy, and therefore @catch@ /cannot/ be used by those monads to properly -- implement a function such as @finally@. For more information, see -- 'MonadMask'. class MonadThrow m => MonadCatch m where -- | Provide a handler for exceptions thrown during execution of the first -- action. Note that type of the type of the argument to the handler will -- constrain which exceptions are caught. See "Control.Exception"'s -- 'ControlException.catch'. catch :: Exception e => m a -> (e -> m a) -> m a -- | A class for monads which provide for the ability to account for all -- possible exit points from a computation, and to mask asynchronous -- exceptions. Continuation-based monads, and stacks such as @ErrorT e IO@ -- which provide for multiple failure modes, are invalid instances of this -- class. -- -- Note that this package /does/ provide a @MonadMask@ instance for @CatchT@. -- This instance is /only/ valid if the base monad provides no ability to -- provide multiple exit. For example, @IO@ or @Either@ would be invalid base -- monads, but @Reader@ or @State@ would be acceptable. -- -- Instances should ensure that, in the following code: -- -- > f `finally` g -- -- The action @g@ is called regardless of what occurs within @f@, including -- async exceptions. class MonadCatch m => MonadMask m where -- | Runs an action with asynchronous exceptions disabled. The action is -- provided a method for restoring the async. environment to what it was -- at the 'mask' call. See "Control.Exception"'s 'ControlException.mask'. mask :: ((forall a. m a -> m a) -> m b) -> m b -- | Like 'mask', but the masked computation is not interruptible (see -- "Control.Exception"'s 'ControlException.uninterruptibleMask'. WARNING: -- Only use if you need to mask exceptions around an interruptible operation -- AND you can guarantee the interruptible operation will only block for a -- short period of time. Otherwise you render the program/thread unresponsive -- and/or unkillable. uninterruptibleMask :: ((forall a. m a -> m a) -> m b) -> m b instance MonadThrow [] where throwM _ = [] instance MonadThrow Maybe where throwM _ = Nothing instance e ~ SomeException => MonadThrow (Either e) where throwM = Left . toException instance MonadThrow IO where throwM = ControlException.throwIO instance MonadCatch IO where catch = ControlException.catch instance MonadMask IO where mask = ControlException.mask uninterruptibleMask = ControlException.uninterruptibleMask instance MonadThrow STM where throwM = STM.throwSTM instance MonadCatch STM where catch = STM.catchSTM instance MonadThrow m => MonadThrow (IdentityT m) where throwM e = lift $ throwM e instance MonadCatch m => MonadCatch (IdentityT m) where catch (IdentityT m) f = IdentityT (catch m (runIdentityT . f)) instance MonadMask m => MonadMask (IdentityT m) where mask a = IdentityT $ mask $ \u -> runIdentityT (a $ q u) where q :: (m a -> m a) -> IdentityT m a -> IdentityT m a q u = IdentityT . u . runIdentityT uninterruptibleMask a = IdentityT $ uninterruptibleMask $ \u -> runIdentityT (a $ q u) where q :: (m a -> m a) -> IdentityT m a -> IdentityT m a q u = IdentityT . u . runIdentityT instance MonadThrow m => MonadThrow (LazyS.StateT s m) where throwM e = lift $ throwM e instance MonadCatch m => MonadCatch (LazyS.StateT s m) where catch = LazyS.liftCatch catch instance MonadMask m => MonadMask (LazyS.StateT s m) where mask a = LazyS.StateT $ \s -> mask $ \u -> LazyS.runStateT (a $ q u) s where q :: (m (a, s) -> m (a, s)) -> LazyS.StateT s m a -> LazyS.StateT s m a q u (LazyS.StateT b) = LazyS.StateT (u . b) uninterruptibleMask a = LazyS.StateT $ \s -> uninterruptibleMask $ \u -> LazyS.runStateT (a $ q u) s where q :: (m (a, s) -> m (a, s)) -> LazyS.StateT s m a -> LazyS.StateT s m a q u (LazyS.StateT b) = LazyS.StateT (u . b) instance MonadThrow m => MonadThrow (StrictS.StateT s m) where throwM e = lift $ throwM e instance MonadCatch m => MonadCatch (StrictS.StateT s m) where catch = StrictS.liftCatch catch instance MonadMask m => MonadMask (StrictS.StateT s m) where mask a = StrictS.StateT $ \s -> mask $ \u -> StrictS.runStateT (a $ q u) s where q :: (m (a, s) -> m (a, s)) -> StrictS.StateT s m a -> StrictS.StateT s m a q u (StrictS.StateT b) = StrictS.StateT (u . b) uninterruptibleMask a = StrictS.StateT $ \s -> uninterruptibleMask $ \u -> StrictS.runStateT (a $ q u) s where q :: (m (a, s) -> m (a, s)) -> StrictS.StateT s m a -> StrictS.StateT s m a q u (StrictS.StateT b) = StrictS.StateT (u . b) instance MonadThrow m => MonadThrow (ReaderT r m) where throwM e = lift $ throwM e instance MonadCatch m => MonadCatch (ReaderT r m) where catch (ReaderT m) c = ReaderT $ \r -> m r `catch` \e -> runReaderT (c e) r instance MonadMask m => MonadMask (ReaderT r m) where mask a = ReaderT $ \e -> mask $ \u -> runReaderT (a $ q u) e where q :: (m a -> m a) -> ReaderT e m a -> ReaderT e m a q u (ReaderT b) = ReaderT (u . b) uninterruptibleMask a = ReaderT $ \e -> uninterruptibleMask $ \u -> runReaderT (a $ q u) e where q :: (m a -> m a) -> ReaderT e m a -> ReaderT e m a q u (ReaderT b) = ReaderT (u . b) instance (MonadThrow m, Monoid w) => MonadThrow (StrictW.WriterT w m) where throwM e = lift $ throwM e instance (MonadCatch m, Monoid w) => MonadCatch (StrictW.WriterT w m) where catch (StrictW.WriterT m) h = StrictW.WriterT $ m `catch ` \e -> StrictW.runWriterT (h e) instance (MonadMask m, Monoid w) => MonadMask (StrictW.WriterT w m) where mask a = StrictW.WriterT $ mask $ \u -> StrictW.runWriterT (a $ q u) where q :: (m (a, w) -> m (a, w)) -> StrictW.WriterT w m a -> StrictW.WriterT w m a q u b = StrictW.WriterT $ u (StrictW.runWriterT b) uninterruptibleMask a = StrictW.WriterT $ uninterruptibleMask $ \u -> StrictW.runWriterT (a $ q u) where q :: (m (a, w) -> m (a, w)) -> StrictW.WriterT w m a -> StrictW.WriterT w m a q u b = StrictW.WriterT $ u (StrictW.runWriterT b) instance (MonadThrow m, Monoid w) => MonadThrow (LazyW.WriterT w m) where throwM e = lift $ throwM e instance (MonadCatch m, Monoid w) => MonadCatch (LazyW.WriterT w m) where catch (LazyW.WriterT m) h = LazyW.WriterT $ m `catch ` \e -> LazyW.runWriterT (h e) instance (MonadMask m, Monoid w) => MonadMask (LazyW.WriterT w m) where mask a = LazyW.WriterT $ mask $ \u -> LazyW.runWriterT (a $ q u) where q :: (m (a, w) -> m (a, w)) -> LazyW.WriterT w m a -> LazyW.WriterT w m a q u b = LazyW.WriterT $ u (LazyW.runWriterT b) uninterruptibleMask a = LazyW.WriterT $ uninterruptibleMask $ \u -> LazyW.runWriterT (a $ q u) where q :: (m (a, w) -> m (a, w)) -> LazyW.WriterT w m a -> LazyW.WriterT w m a q u b = LazyW.WriterT $ u (LazyW.runWriterT b) instance (MonadThrow m, Monoid w) => MonadThrow (LazyRWS.RWST r w s m) where throwM e = lift $ throwM e instance (MonadCatch m, Monoid w) => MonadCatch (LazyRWS.RWST r w s m) where catch (LazyRWS.RWST m) h = LazyRWS.RWST $ \r s -> m r s `catch` \e -> LazyRWS.runRWST (h e) r s instance (MonadMask m, Monoid w) => MonadMask (LazyRWS.RWST r w s m) where mask a = LazyRWS.RWST $ \r s -> mask $ \u -> LazyRWS.runRWST (a $ q u) r s where q :: (m (a, s, w) -> m (a, s, w)) -> LazyRWS.RWST r w s m a -> LazyRWS.RWST r w s m a q u (LazyRWS.RWST b) = LazyRWS.RWST $ \ r s -> u (b r s) uninterruptibleMask a = LazyRWS.RWST $ \r s -> uninterruptibleMask $ \u -> LazyRWS.runRWST (a $ q u) r s where q :: (m (a, s, w) -> m (a, s, w)) -> LazyRWS.RWST r w s m a -> LazyRWS.RWST r w s m a q u (LazyRWS.RWST b) = LazyRWS.RWST $ \ r s -> u (b r s) instance (MonadThrow m, Monoid w) => MonadThrow (StrictRWS.RWST r w s m) where throwM e = lift $ throwM e instance (MonadCatch m, Monoid w) => MonadCatch (StrictRWS.RWST r w s m) where catch (StrictRWS.RWST m) h = StrictRWS.RWST $ \r s -> m r s `catch` \e -> StrictRWS.runRWST (h e) r s instance (MonadMask m, Monoid w) => MonadMask (StrictRWS.RWST r w s m) where mask a = StrictRWS.RWST $ \r s -> mask $ \u -> StrictRWS.runRWST (a $ q u) r s where q :: (m (a, s, w) -> m (a, s, w)) -> StrictRWS.RWST r w s m a -> StrictRWS.RWST r w s m a q u (StrictRWS.RWST b) = StrictRWS.RWST $ \ r s -> u (b r s) uninterruptibleMask a = StrictRWS.RWST $ \r s -> uninterruptibleMask $ \u -> StrictRWS.runRWST (a $ q u) r s where q :: (m (a, s, w) -> m (a, s, w)) -> StrictRWS.RWST r w s m a -> StrictRWS.RWST r w s m a q u (StrictRWS.RWST b) = StrictRWS.RWST $ \ r s -> u (b r s) -- Transformers which are only instances of MonadThrow and MonadCatch, not MonadMask instance MonadThrow m => MonadThrow (ListT m) where throwM = lift . throwM instance MonadCatch m => MonadCatch (ListT m) where catch (ListT m) f = ListT $ catch m (runListT . f) -- | Throws exceptions into the base monad. instance MonadThrow m => MonadThrow (MaybeT m) where throwM = lift . throwM -- | Catches exceptions from the base monad. instance MonadCatch m => MonadCatch (MaybeT m) where catch (MaybeT m) f = MaybeT $ catch m (runMaybeT . f) -- | Throws exceptions into the base monad. instance (Error e, MonadThrow m) => MonadThrow (ErrorT e m) where throwM = lift . throwM -- | Catches exceptions from the base monad. instance (Error e, MonadCatch m) => MonadCatch (ErrorT e m) where catch (ErrorT m) f = ErrorT $ catch m (runErrorT . f) -- | Throws exceptions into the base monad. instance MonadThrow m => MonadThrow (ExceptT e m) where throwM = lift . throwM -- | Catches exceptions from the base monad. instance MonadCatch m => MonadCatch (ExceptT e m) where catch (ExceptT m) f = ExceptT $ catch m (runExceptT . f) instance MonadThrow m => MonadThrow (ContT r m) where throwM = lift . throwM -- I don't believe any valid of MonadCatch exists for ContT. -- instance MonadCatch m => MonadCatch (ContT r m) where ------------------------------------------------------------------------------ -- $utilities -- These functions follow those from "Control.Exception", except that they are -- based on methods from the 'MonadCatch' typeclass. See -- "Control.Exception" for API usage. ------------------------------------------------------------------------------ -- | Like 'mask', but does not pass a @restore@ action to the argument. mask_ :: MonadMask m => m a -> m a mask_ io = mask $ \_ -> io -- | Like 'uninterruptibleMask', but does not pass a @restore@ action to the -- argument. uninterruptibleMask_ :: MonadMask m => m a -> m a uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io -- | Catches all exceptions, and somewhat defeats the purpose of the extensible -- exception system. Use sparingly. catchAll :: MonadCatch m => m a -> (SomeException -> m a) -> m a catchAll = catch -- | Catch all 'IOError' (eqv. 'IOException') exceptions. Still somewhat too -- general, but better than using 'catchAll'. See 'catchIf' for an easy way -- of catching specific 'IOError's based on the predicates in "System.IO.Error". catchIOError :: MonadCatch m => m a -> (IOError -> m a) -> m a catchIOError = catch -- | Catch exceptions only if they pass some predicate. Often useful with the -- predicates for testing 'IOError' values in "System.IO.Error". catchIf :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> (e -> m a) -> m a catchIf f a b = a `catch` \e -> if f e then b e else throwM e -- | A more generalized way of determining which exceptions to catch at -- run time. catchJust :: (MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a catchJust f a b = a `catch` \e -> maybe (throwM e) b $ f e -- | Flipped 'catch'. See "Control.Exception"'s 'ControlException.handle'. handle :: (MonadCatch m, Exception e) => (e -> m a) -> m a -> m a handle = flip catch {-# INLINE handle #-} -- | Flipped 'catchIOError' handleIOError :: MonadCatch m => (IOError -> m a) -> m a -> m a handleIOError = handle -- | Flipped 'catchAll' handleAll :: MonadCatch m => (SomeException -> m a) -> m a -> m a handleAll = handle -- | Flipped 'catchIf' handleIf :: (MonadCatch m, Exception e) => (e -> Bool) -> (e -> m a) -> m a -> m a handleIf f = flip (catchIf f) -- | Flipped 'catchJust'. See "Control.Exception"'s 'ControlException.handleJust'. handleJust :: (MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a handleJust f = flip (catchJust f) {-# INLINE handleJust #-} -- | Similar to 'catch', but returns an 'Either' result. See "Control.Exception"'s -- 'Control.Exception.try'. try :: (MonadCatch m, Exception e) => m a -> m (Either e a) try a = catch (Right `liftM` a) (return . Left) -- | A variant of 'try' that takes an exception predicate to select -- which exceptions are caught. See "Control.Exception"'s 'ControlException.tryJust' tryJust :: (MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a) tryJust f a = catch (Right `liftM` a) (\e -> maybe (throwM e) (return . Left) (f e)) -- | Generalized version of 'ControlException.Handler' data Handler m a = forall e . ControlException.Exception e => Handler (e -> m a) instance Monad m => Functor (Handler m) where fmap f (Handler h) = Handler (liftM f . h) -- | Catches different sorts of exceptions. See "Control.Exception"'s 'ControlException.catches' catches :: (Foldable f, MonadCatch m) => m a -> f (Handler m a) -> m a catches a hs = a `catch` handler where handler e = foldr probe (throwM e) hs where probe (Handler h) xs = maybe xs h (ControlException.fromException e) -- | Run an action only if an exception is thrown in the main action. The -- exception is not caught, simply rethrown. onException :: MonadCatch m => m a -> m b -> m a onException action handler = action `catchAll` \e -> handler >> throwM e -- | Generalized abstracted pattern of safe resource acquisition and release -- in the face of exceptions. The first action \"acquires\" some value, which -- is \"released\" by the second action at the end. The third action \"uses\" -- the value and its result is the result of the 'bracket'. -- -- If an exception occurs during the use, the release still happens before the -- exception is rethrown. bracket :: MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c bracket acquire release use = mask $ \unmasked -> do resource <- acquire result <- unmasked (use resource) `onException` release resource _ <- release resource return result -- | Version of 'bracket' without any value being passed to the second and -- third actions. bracket_ :: MonadMask m => m a -> m b -> m c -> m c bracket_ before after action = bracket before (const after) (const action) -- | Perform an action with a finalizer action that is run, even if an -- exception occurs. finally :: MonadMask m => m a -> m b -> m a finally action finalizer = bracket_ (return ()) finalizer action -- | Like 'bracket', but only performs the final action if there was an -- exception raised by the in-between computation. bracketOnError :: MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c bracketOnError acquire release use = mask $ \unmasked -> do resource <- acquire unmasked (use resource) `onException` release resource exceptions-0.8.0.2/src/Control/Monad/Catch/0000755000000000000000000000000012501063347016516 5ustar0000000000000000exceptions-0.8.0.2/src/Control/Monad/Catch/Pure.hs0000644000000000000000000001402312501063347017765 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_transformers #define MIN_VERSION_transformers(x,y,z) 1 #endif #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1 #endif -------------------------------------------------------------------- -- | -- Copyright : (C) Edward Kmett 2013-2015, (c) Google Inc. 2012 -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- This module supplies a \'pure\' monad transformer that can be used for -- mock-testing code that throws exceptions, so long as those exceptions -- are always thrown with 'throwM'. -- -- Do not mix 'CatchT' with 'IO'. Choose one or the other for the -- bottom of your transformer stack! -------------------------------------------------------------------- module Control.Monad.Catch.Pure ( -- * Transformer -- $transformer CatchT(..), Catch , runCatch , mapCatchT -- * Typeclass -- $mtl , module Control.Monad.Catch ) where #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706) import Prelude hiding (foldr) #else import Prelude hiding (catch, foldr) #endif import Control.Applicative import Control.Monad.Catch import Control.Monad.Reader as Reader import Control.Monad.RWS #if __GLASGOW_HASKELL__ < 710 import Data.Foldable #endif import Data.Functor.Identity import Data.Traversable as Traversable ------------------------------------------------------------------------------ -- $mtl -- The mtl style typeclass ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- $transformer -- The @transformers@-style monad transfomer ------------------------------------------------------------------------------ -- | Add 'Exception' handling abilities to a 'Monad'. -- -- This should /never/ be used in combination with 'IO'. Think of 'CatchT' -- as an alternative base monad for use with mocking code that solely throws -- exceptions via 'throwM'. -- -- Note: that 'IO' monad has these abilities already, so stacking 'CatchT' on top -- of it does not add any value and can possibly be confusing: -- -- >>> (error "Hello!" :: IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e) -- Hello! -- -- >>> runCatchT $ (error "Hello!" :: CatchT IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e) -- *** Exception: Hello! -- -- >>> runCatchT $ (throwM (ErrorCall "Hello!") :: CatchT IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e) -- Hello! newtype CatchT m a = CatchT { runCatchT :: m (Either SomeException a) } type Catch = CatchT Identity runCatch :: Catch a -> Either SomeException a runCatch = runIdentity . runCatchT instance Monad m => Functor (CatchT m) where fmap f (CatchT m) = CatchT (liftM (fmap f) m) instance Monad m => Applicative (CatchT m) where pure a = CatchT (return (Right a)) (<*>) = ap instance Monad m => Monad (CatchT m) where return a = CatchT (return (Right a)) CatchT m >>= k = CatchT $ m >>= \ea -> case ea of Left e -> return (Left e) Right a -> runCatchT (k a) fail = CatchT . return . Left . toException . userError instance MonadFix m => MonadFix (CatchT m) where mfix f = CatchT $ mfix $ \a -> runCatchT $ f $ case a of Right r -> r _ -> error "empty mfix argument" instance Foldable m => Foldable (CatchT m) where foldMap f (CatchT m) = foldMap (foldMapEither f) m where foldMapEither g (Right a) = g a foldMapEither _ (Left _) = mempty instance (Monad m, Traversable m) => Traversable (CatchT m) where traverse f (CatchT m) = CatchT <$> Traversable.traverse (traverseEither f) m where traverseEither g (Right a) = Right <$> g a traverseEither _ (Left e) = pure (Left e) instance Monad m => Alternative (CatchT m) where empty = mzero (<|>) = mplus instance Monad m => MonadPlus (CatchT m) where mzero = CatchT $ return $ Left $ toException $ userError "" mplus (CatchT m) (CatchT n) = CatchT $ m >>= \ea -> case ea of Left _ -> n Right a -> return (Right a) instance MonadTrans CatchT where lift m = CatchT $ do a <- m return $ Right a instance MonadIO m => MonadIO (CatchT m) where liftIO m = CatchT $ do a <- liftIO m return $ Right a instance Monad m => MonadThrow (CatchT m) where throwM = CatchT . return . Left . toException instance Monad m => MonadCatch (CatchT m) where catch (CatchT m) c = CatchT $ m >>= \ea -> case ea of Left e -> case fromException e of Just e' -> runCatchT (c e') Nothing -> return (Left e) Right a -> return (Right a) -- | Note: This instance is only valid if the underlying monad has a single -- exit point! instance Monad m => MonadMask (CatchT m) where mask a = a id uninterruptibleMask a = a id instance MonadState s m => MonadState s (CatchT m) where get = lift get put = lift . put #if MIN_VERSION_mtl(2,1,0) state = lift . state #endif instance MonadReader e m => MonadReader e (CatchT m) where ask = lift ask local f (CatchT m) = CatchT (local f m) instance MonadWriter w m => MonadWriter w (CatchT m) where tell = lift . tell listen = mapCatchT $ \ m -> do (a, w) <- listen m return $! fmap (\ r -> (r, w)) a pass = mapCatchT $ \ m -> pass $ do a <- m return $! case a of Left l -> (Left l, id) Right (r, f) -> (Right r, f) #if MIN_VERSION_mtl(2,1,0) writer aw = CatchT (Right `liftM` writer aw) #endif instance MonadRWS r w s m => MonadRWS r w s (CatchT m) -- | Map the unwrapped computation using the given function. -- -- @'runCatchT' ('mapCatchT' f m) = f ('runCatchT' m)@ mapCatchT :: (m (Either SomeException a) -> n (Either SomeException b)) -> CatchT m a -> CatchT n b mapCatchT f m = CatchT $ f (runCatchT m) exceptions-0.8.0.2/tests/0000755000000000000000000000000012501063347013371 5ustar0000000000000000exceptions-0.8.0.2/tests/Tests.hs0000644000000000000000000000026112501063347015026 0ustar0000000000000000module Main where import Test.Framework (defaultMain) import qualified Control.Monad.Catch.Tests main :: IO () main = defaultMain [ Control.Monad.Catch.Tests.tests ] exceptions-0.8.0.2/tests/Control/0000755000000000000000000000000012501063347015011 5ustar0000000000000000exceptions-0.8.0.2/tests/Control/Monad/0000755000000000000000000000000012501063347016047 5ustar0000000000000000exceptions-0.8.0.2/tests/Control/Monad/Catch/0000755000000000000000000000000012501063347017071 5ustar0000000000000000exceptions-0.8.0.2/tests/Control/Monad/Catch/Tests.hs0000644000000000000000000000765712501063347020546 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE CPP #-} module Control.Monad.Catch.Tests (tests) where #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706) import Prelude hiding (catch) #endif import Control.Applicative ((<*>)) import Data.Data (Data, Typeable) import Control.Monad.Trans.Identity (IdentityT(..)) import Control.Monad.Reader (ReaderT(..)) import Control.Monad.List (ListT(..)) import Control.Monad.Trans.Maybe (MaybeT(..)) import Control.Monad.Error (ErrorT(..)) import Control.Monad.STM (STM, atomically) --import Control.Monad.Cont (ContT(..)) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Property, once) import Test.QuickCheck.Monadic (monadic, run, assert) import Test.QuickCheck.Property (morallyDubiousIOProperty) import qualified Control.Monad.State.Lazy as LazyState import qualified Control.Monad.State.Strict as StrictState import qualified Control.Monad.Writer.Lazy as LazyWriter import qualified Control.Monad.Writer.Strict as StrictWriter import qualified Control.Monad.RWS.Lazy as LazyRWS import qualified Control.Monad.RWS.Strict as StrictRWS import Control.Monad.Catch import Control.Monad.Catch.Pure data TestException = TestException String deriving (Show, Eq, Data, Typeable) instance Exception TestException data MSpec = forall m. (MonadCatch m) => MSpec { mspecName :: String , mspecRunner :: (m Property -> Property) } testMonadCatch :: MSpec -> Property testMonadCatch MSpec { mspecRunner } = monadic mspecRunner $ run $ catch failure handler where failure = throwM (TestException "foo") >> error "testMonadCatch" handler (_ :: TestException) = return () testCatchJust :: MSpec -> Property testCatchJust MSpec { mspecRunner } = monadic mspecRunner $ do nice <- run $ catchJust testException posFailure posHandler assert $ nice == ("pos", True) bad <- run $ catch (catchJust testException negFailure posHandler) negHandler assert $ bad == ("neg", True) where testException (TestException s) = if s == "pos" then Just True else Nothing posHandler x = return ("pos", x) negHandler (_ :: TestException) = return ("neg", True) posFailure = throwM (TestException "pos") >> error "testCatchJust pos" negFailure = throwM (TestException "neg") >> error "testCatchJust neg" tests :: Test tests = testGroup "Control.Monad.Catch.Tests" $ [ mkMonadCatch , mkCatchJust ] <*> mspecs where mspecs = [ MSpec "IO" io , MSpec "IdentityT IO" $ io . runIdentityT , MSpec "LazyState.StateT IO" $ io . flip LazyState.evalStateT () , MSpec "StrictState.StateT IO" $ io . flip StrictState.evalStateT () , MSpec "ReaderT IO" $ io . flip runReaderT () , MSpec "LazyWriter.WriterT IO" $ io . fmap tfst . LazyWriter.runWriterT , MSpec "StrictWriter.WriterT IO" $ io . fmap tfst . StrictWriter.runWriterT , MSpec "LazyRWS.RWST IO" $ \m -> io $ fmap tfst $ LazyRWS.evalRWST m () () , MSpec "StrictRWS.RWST IO" $ \m -> io $ fmap tfst $ StrictRWS.evalRWST m () () , MSpec "ListT IO" $ \m -> io $ fmap (\[x] -> x) (runListT m) , MSpec "MaybeT IO" $ \m -> io $ fmap (maybe undefined id) (runMaybeT m) , MSpec "ErrorT IO" $ \m -> io $ fmap (either error id) (runErrorT m) , MSpec "STM" $ io . atomically --, MSpec "ContT IO" $ \m -> io $ runContT m return , MSpec "CatchT Indentity" $ fromRight . runCatch ] tfst :: (Property, ()) -> Property = fst fromRight (Left _) = error "fromRight" fromRight (Right a) = a io = morallyDubiousIOProperty mkMonadCatch = mkTestType "MonadCatch" testMonadCatch mkCatchJust = mkTestType "catchJust" testCatchJust mkTestType name test = \spec -> testProperty (name ++ " " ++ mspecName spec) $ once $ test spec exceptions-0.8.0.2/travis/0000755000000000000000000000000012501063347013537 5ustar0000000000000000exceptions-0.8.0.2/travis/cabal-apt-install0000755000000000000000000000127212501063347016757 0ustar0000000000000000#! /bin/bash set -eu APT="sudo apt-get -q -y" CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall" $APT update $APT install dctrl-tools # Find potential system packages to satisfy cabal dependencies deps() { local M='^\([^ ]\+\)-[0-9.]\+ (.*$' local G=' -o ( -FPackage -X libghc-\L\1\E-dev )' local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \ | sed -ne "s/$M/$G/p" | sort -u)" grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u } $APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special $CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage if ! $APT install hlint ; then $APT install $(deps hlint) cabal install hlint fi exceptions-0.8.0.2/travis/config0000644000000000000000000000120612501063347014726 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global