exceptions-0.3.2/0000755000000000000000000000000012204777021012065 5ustar0000000000000000exceptions-0.3.2/.ghci0000644000000000000000000000010712204777021012776 0ustar0000000000000000:set -isrc -idist/build/autogen -optPdist/build/autogen/cabal_macros.h exceptions-0.3.2/.gitignore0000644000000000000000000000010412204777021014050 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# exceptions-0.3.2/.travis.yml0000644000000000000000000000123312204777021014175 0ustar0000000000000000language: haskell before_install: # Uncomment whenever hackage is down. # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update - cabal update # Try installing some of the build-deps with apt-get for speed. - travis/cabal-apt-install $mode install: - cabal configure -flib-Werror $mode - cabal build script: - $script && hlint src --cpp-define HLINT notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313exceptions\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" env: - mode="--enable-tests" script="cabal test --show-details=always" exceptions-0.3.2/.vim.custom0000644000000000000000000000137712204777021014202 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.3.2/AUTHORS.markdown0000644000000000000000000000013012204777021014750 0ustar0000000000000000`exceptions` is based on code contributed by [Mark Lentzcner](http://github.com/mzero). exceptions-0.3.2/CHANGELOG.markdown0000644000000000000000000000113412204777021015117 0ustar00000000000000000.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.3.2/exceptions.cabal0000644000000000000000000000323212204777021015232 0ustar0000000000000000name: exceptions category: Control, Exceptions, Monad version: 0.3.2 cabal-version: >= 1.8 license: OtherLicense 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 Edward A. Kmett Copyright (C) 2012 Google Inc. build-type: Simple tested-with: GHC == 7.4.1, GHC == 7.6.1 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, transformers >= 0.2 && < 0.4, mtl >= 2.0 && < 2.2 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 hs-source-dirs: src, tests ghc-options: -Wall -fwarn-tabs type: exitcode-stdio-1.0 build-depends: base >= 4.3 && < 5, transformers >= 0.2 && < 0.4, mtl >= 2.0 && < 2.2, test-framework >= 0.8 && < 0.9, test-framework-quickcheck2 >= 0.3 && < 0.4, QuickCheck >= 2.5 && < 2.6 exceptions-0.3.2/LICENSE0000644000000000000000000002514312204777021013077 0ustar0000000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. exceptions-0.3.2/README.markdown0000644000000000000000000000072112204777021014566 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.3.2/Setup.lhs0000644000000000000000000000016512204777021013677 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain exceptions-0.3.2/src/0000755000000000000000000000000012204777021012654 5ustar0000000000000000exceptions-0.3.2/src/Control/0000755000000000000000000000000012204777021014274 5ustar0000000000000000exceptions-0.3.2/src/Control/Monad/0000755000000000000000000000000012204777021015332 5ustar0000000000000000exceptions-0.3.2/src/Control/Monad/Catch.hs0000644000000000000000000003333712204777021016721 0ustar0000000000000000{- Copyright 2012 Google Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -} {-# 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, (c) Google Inc. 2012 -- 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 the RankNTypes language extension. -------------------------------------------------------------------- module Control.Monad.Catch ( -- * Typeclass -- $mtl MonadCatch(..) -- * 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 #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706) import Prelude hiding (foldr) #else import Prelude hiding (catch, foldr) #endif import Control.Exception (Exception(..), SomeException(..)) import qualified Control.Exception as ControlException 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.Trans.Identity import Control.Monad.Reader as Reader import Control.Monad.RWS import Data.Foldable ------------------------------------------------------------------------------ -- $mtl -- The mtl style typeclass ------------------------------------------------------------------------------ class Monad m => MonadCatch 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'. throwM :: Exception e => e -> m a -- | 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 -- | 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 MonadCatch IO where throwM = ControlException.throwIO catch = ControlException.catch mask = ControlException.mask uninterruptibleMask = ControlException.uninterruptibleMask instance MonadCatch m => MonadCatch (IdentityT m) where throwM e = lift $ throwM e catch (IdentityT m) f = IdentityT (catch m (runIdentityT . f)) mask a = IdentityT $ mask $ \u -> runIdentityT (a $ q u) where q u = IdentityT . u . runIdentityT uninterruptibleMask a = IdentityT $ uninterruptibleMask $ \u -> runIdentityT (a $ q u) where q u = IdentityT . u . runIdentityT instance MonadCatch m => MonadCatch (LazyS.StateT s m) where throwM e = lift $ throwM e catch = LazyS.liftCatch catch mask a = LazyS.StateT $ \s -> mask $ \u -> LazyS.runStateT (a $ q u) s where q u (LazyS.StateT b) = LazyS.StateT (u . b) uninterruptibleMask a = LazyS.StateT $ \s -> uninterruptibleMask $ \u -> LazyS.runStateT (a $ q u) s where q u (LazyS.StateT b) = LazyS.StateT (u . b) instance MonadCatch m => MonadCatch (StrictS.StateT s m) where throwM e = lift $ throwM e catch = StrictS.liftCatch catch mask a = StrictS.StateT $ \s -> mask $ \u -> StrictS.runStateT (a $ q u) s where q u (StrictS.StateT b) = StrictS.StateT (u . b) uninterruptibleMask a = StrictS.StateT $ \s -> uninterruptibleMask $ \u -> StrictS.runStateT (a $ q u) s where q u (StrictS.StateT b) = StrictS.StateT (u . b) instance MonadCatch m => MonadCatch (ReaderT r m) where throwM e = lift $ throwM e catch (ReaderT m) c = ReaderT $ \r -> m r `catch` \e -> runReaderT (c e) r mask a = ReaderT $ \e -> mask $ \u -> Reader.runReaderT (a $ q u) e where q u (ReaderT b) = ReaderT (u . b) uninterruptibleMask a = ReaderT $ \e -> uninterruptibleMask $ \u -> Reader.runReaderT (a $ q u) e where q u (ReaderT b) = ReaderT (u . b) instance (MonadCatch m, Monoid w) => MonadCatch (StrictW.WriterT w m) where throwM e = lift $ throwM e catch (StrictW.WriterT m) h = StrictW.WriterT $ m `catch ` \e -> StrictW.runWriterT (h e) mask a = StrictW.WriterT $ mask $ \u -> StrictW.runWriterT (a $ q u) where q u b = StrictW.WriterT $ u (StrictW.runWriterT b) uninterruptibleMask a = StrictW.WriterT $ uninterruptibleMask $ \u -> StrictW.runWriterT (a $ q u) where q u b = StrictW.WriterT $ u (StrictW.runWriterT b) instance (MonadCatch m, Monoid w) => MonadCatch (LazyW.WriterT w m) where throwM e = lift $ throwM e catch (LazyW.WriterT m) h = LazyW.WriterT $ m `catch ` \e -> LazyW.runWriterT (h e) mask a = LazyW.WriterT $ mask $ \u -> LazyW.runWriterT (a $ q u) where q u b = LazyW.WriterT $ u (LazyW.runWriterT b) uninterruptibleMask a = LazyW.WriterT $ uninterruptibleMask $ \u -> LazyW.runWriterT (a $ q u) where q u b = LazyW.WriterT $ u (LazyW.runWriterT b) instance (MonadCatch m, Monoid w) => MonadCatch (LazyRWS.RWST r w s m) where throwM e = lift $ throwM e catch (LazyRWS.RWST m) h = LazyRWS.RWST $ \r s -> m r s `catch` \e -> LazyRWS.runRWST (h e) r s mask a = LazyRWS.RWST $ \r s -> mask $ \u -> LazyRWS.runRWST (a $ q u) r s where 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 u (LazyRWS.RWST b) = LazyRWS.RWST $ \ r s -> u (b r s) instance (MonadCatch m, Monoid w) => MonadCatch (StrictRWS.RWST r w s m) where throwM e = lift $ throwM e catch (StrictRWS.RWST m) h = StrictRWS.RWST $ \r s -> m r s `catch` \e -> StrictRWS.runRWST (h e) r s mask a = StrictRWS.RWST $ \r s -> mask $ \u -> StrictRWS.runRWST (a $ q u) r s where 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 u (StrictRWS.RWST b) = StrictRWS.RWST $ \ r s -> u (b r s) ------------------------------------------------------------------------------ -- $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_ :: MonadCatch m => m a -> m a mask_ io = mask $ \_ -> io -- | Like 'uninterruptibleMask', but does not pass a @restore@ action to the -- argument. uninterruptibleMask_ :: MonadCatch 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 :: MonadCatch 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_ :: MonadCatch 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 :: MonadCatch 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 :: MonadCatch 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.3.2/src/Control/Monad/Catch/0000755000000000000000000000000012204777021016354 5ustar0000000000000000exceptions-0.3.2/src/Control/Monad/Catch/Pure.hs0000644000000000000000000001447012204777021017631 0ustar0000000000000000{- Copyright 2012 Google Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -} {-# 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, (c) Google Inc. 2012 -- 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 import Data.Foldable 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 => MonadCatch (CatchT m) where throwM = CatchT . return . Left . toException 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) 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. -- -- * @'runErrorT' ('mapErrorT' f m) = f ('runErrorT' 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.3.2/tests/0000755000000000000000000000000012204777021013227 5ustar0000000000000000exceptions-0.3.2/tests/Tests.hs0000644000000000000000000000026112204777021014664 0ustar0000000000000000module Main where import Test.Framework (defaultMain) import qualified Control.Monad.Catch.Tests main :: IO () main = defaultMain [ Control.Monad.Catch.Tests.tests ] exceptions-0.3.2/travis/0000755000000000000000000000000012204777021013375 5ustar0000000000000000exceptions-0.3.2/travis/cabal-apt-install0000755000000000000000000000127212204777021016615 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.3.2/travis/config0000644000000000000000000000120612204777021014564 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