exceptions (empty) → 0.1
raw patch · 14 files changed
+799/−0 lines, 14 filesdep +QuickCheckdep +basedep +mtlsetup-changed
Dependencies added: QuickCheck, base, mtl, test-framework, test-framework-quickcheck2, transformers
Files
- .ghci +1/−0
- .gitignore +13/−0
- .travis.yml +26/−0
- .vim.custom +31/−0
- AUTHORS.markdown +1/−0
- CHANGELOG.markdown +3/−0
- LICENSE +202/−0
- README.markdown +15/−0
- Setup.lhs +7/−0
- exceptions.cabal +58/−0
- src/Control/Monad/Catch.hs +389/−0
- tests/Tests.hs +10/−0
- travis/cabal-apt-install +27/−0
- travis/config +16/−0
+ .ghci view
@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optPdist/build/autogen/cabal_macros.h
+ .gitignore view
@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#
+ .travis.yml view
@@ -0,0 +1,26 @@+language: 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"
+ .vim.custom view
@@ -0,0 +1,31 @@+" 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 <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" 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"
+ AUTHORS.markdown view
@@ -0,0 +1,1 @@+`exceptions` is based on code contributed by [Mark Lentzcner](http://github.com/mzero).
+ CHANGELOG.markdown view
@@ -0,0 +1,3 @@+0.1+---+* Repository initialized
+ LICENSE view
@@ -0,0 +1,202 @@++ 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.
+ README.markdown view
@@ -0,0 +1,15 @@+exceptions+==========++[](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
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ exceptions.cabal view
@@ -0,0 +1,58 @@+name: exceptions+category: Control, Exceptions, Monad+version: 0.1+cabal-version: >= 1.8+license: OtherLicense+license-file: LICENSE+author: Edward A. Kmett+maintainer: Edward A. Kmett <ekmett@gmail.com>+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++ 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
+ src/Control/Monad/Catch.hs view
@@ -0,0 +1,389 @@+{-+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 #-}++#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+-- License : BSD3+-- Maintainer: Edward Kmett <ekmett@gmail.com>+-- 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(..)++ -- * Transformer+ -- $transformer+ , CatchT(..), Catch+ , runCatch+ , mapCatchT++ -- * Utilities+ -- $utilities+ , catchAll+ , catchIOError+ , catchJust+ , catchIf+ , Handler(..), catches+ , handle+ , handleJust+ , 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.Applicative+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+import Data.Functor.Identity+import Data.Traversable as Traversable++------------------------------------------------------------------------------+-- $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 diabled. 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++instance MonadCatch IO where+ throwM = ControlException.throwIO+ catch = ControlException.catch+ mask = ControlException.mask++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++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)++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)++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)++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)++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)++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)++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)++------------------------------------------------------------------------------+-- $transformer+-- The @transformers@-style monad transfomer+------------------------------------------------------------------------------++-- | Add 'Exception' handling abilities to a 'Monad'.+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++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)++------------------------------------------------------------------------------+-- $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.+------------------------------------------------------------------------------++-- | 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 '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
+ tests/Tests.hs view
@@ -0,0 +1,10 @@+module Main where++import Test.Framework (defaultMain)++import qualified Control.Monad.Catch.Tests++main :: IO ()+main = defaultMain+ [ Control.Monad.Catch.Tests.tests+ ]
+ travis/cabal-apt-install view
@@ -0,0 +1,27 @@+#! /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+
+ travis/config view
@@ -0,0 +1,16 @@+-- 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