exceptions 0.10.5 → 0.10.6

raw patch · 13 files changed

+1729/−1709 lines, 13 filesdep +call-stackdep ~basedep ~template-haskellsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: call-stack

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• .ghci +1/−1
• .gitignore +38/−38
• .vim.custom +31/−31
• AUTHORS.markdown +1/−1
• CHANGELOG.markdown +124/−118
• LICENSE +31/−31
• README.markdown +15/−15
• Setup.lhs +7/−7
• exceptions.cabal +97/−97
• src/Control/Monad/Catch.hs +891/−877
• src/Control/Monad/Catch/Pure.hs +225/−225
• tests/Control/Monad/Catch/Tests.hs +258/−258
• tests/Tests.hs +10/−10

@@ -1,1 +1,1 @@-:set -isrc -idist/build/autogen -optPdist/build/autogen/cabal_macros.h+:set -isrc -idist/build/autogen -optPdist/build/autogen/cabal_macros.h

@@ -1,38 +1,38 @@-dist-dist-newstyle-docs-wiki-TAGS-tags-wip-.DS_Store-.*.swp-.*.swo-*.o-*.hi-*~-*#-.stack-work/-cabal-dev-*.chi-*.chs.h-*.dyn_o-*.dyn_hi-.hpc-.hsenv-.cabal-sandbox/-cabal.sandbox.config-*.prof-*.aux-*.hp-*.eventlog-cabal.project.local-cabal.project.local~-.HTF/-.ghc.environment.*--# GHC-dist-boot-dist-install-GNUmakefile-ghc.mk+dist
+dist-newstyle
+docs
+wiki
+TAGS
+tags
+wip
+.DS_Store
+.*.swp
+.*.swo
+*.o
+*.hi
+*~
+*#
+.stack-work/
+cabal-dev
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+
+# GHC
+dist-boot
+dist-install
+GNUmakefile
+ghc.mk

@@ -1,31 +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"+" 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"

@@ -1,1 +1,1 @@-`exceptions` is based on code contributed by [Mark Lentzcner](http://github.com/mzero).+`exceptions` is based on code contributed by [Mark Lentzcner](http://github.com/mzero).

@@ -1,118 +1,124 @@-0.10.5 [2022.05.07]---------------------* Allow building with `transformers-0.6.*` and `mtl-2.3.*`.--0.10.4 [2019.12.26]---------------------* Allow building with `template-haskell-2.16.*`.-* Only depend on `transformers-compat` on old versions of GHC.--0.10.3 [2019.08.27]---------------------* `MonadThrow` instance for the strict `ST` monad.--0.10.2 [2019.05.02]---------------------* Allow building with `base-4.13`/`template-haskell-2.15`.--0.10.1 [2019.03.26]---------------------* Define a `MonadFail` instance for `CatchT`.-* Allow `QuickCheck-2.13` in the test suite.--0.10.0--------* Fix a regression in 0.9.0 whereby the non-IO effects in `bracket`'s `use`-  action were not visible to the `release` action, and the non-IO effects in the-  `release` action were not visible after the `bracket` call.-* The type of `generalBracket` was changed in order to restore those non-IO-  effects, so if you are a library author that provides a `MonadMask` instance,-  you will need to update your implementation of this method.-* Add `MonadMask` instance for `MaybeT`-* Add `onError` function whose action also runs on errors which are not-  exceptions, such as a `Nothing` or a `Left`.--0.9.0-------* Add `generalBracket` to the `MonadMask` typeclass, allowing more-  valid instances.--  Note that functions such as `bracket` and `finally` are now based off of-  `generalBracket`, so if you are a library author that provides a `MonadMask`-  instance, you will need to provide an implementation of this method.-* Add `MonadMask` instances for `ExceptT` and `ErrorT`--0.8.3-------* `MonadCatch` and `MonadMask` instances for `Either SomeException`--0.8.1-------* Support for throwing in the `template-haskell` `Q` monad-* Support for `transformers` 0.5--0.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+0.10.6 [2022.11.30]
+-------------------
+* The class methods and functions in `Control.Monad.Catch` now have
+  `HasCallStack` constraints.
+* Drop support for GHC 7.0 and 7.2.
+
+0.10.5 [2022.05.07]
+-------------------
+* Allow building with `transformers-0.6.*` and `mtl-2.3.*`.
+
+0.10.4 [2019.12.26]
+-------------------
+* Allow building with `template-haskell-2.16.*`.
+* Only depend on `transformers-compat` on old versions of GHC.
+
+0.10.3 [2019.08.27]
+-------------------
+* `MonadThrow` instance for the strict `ST` monad.
+
+0.10.2 [2019.05.02]
+-------------------
+* Allow building with `base-4.13`/`template-haskell-2.15`.
+
+0.10.1 [2019.03.26]
+-------------------
+* Define a `MonadFail` instance for `CatchT`.
+* Allow `QuickCheck-2.13` in the test suite.
+
+0.10.0
+------
+* Fix a regression in 0.9.0 whereby the non-IO effects in `bracket`'s `use`
+  action were not visible to the `release` action, and the non-IO effects in the
+  `release` action were not visible after the `bracket` call.
+* The type of `generalBracket` was changed in order to restore those non-IO
+  effects, so if you are a library author that provides a `MonadMask` instance,
+  you will need to update your implementation of this method.
+* Add `MonadMask` instance for `MaybeT`
+* Add `onError` function whose action also runs on errors which are not
+  exceptions, such as a `Nothing` or a `Left`.
+
+0.9.0
+-----
+* Add `generalBracket` to the `MonadMask` typeclass, allowing more
+  valid instances.
+
+  Note that functions such as `bracket` and `finally` are now based off of
+  `generalBracket`, so if you are a library author that provides a `MonadMask`
+  instance, you will need to provide an implementation of this method.
+* Add `MonadMask` instances for `ExceptT` and `ErrorT`
+
+0.8.3
+-----
+* `MonadCatch` and `MonadMask` instances for `Either SomeException`
+
+0.8.1
+-----
+* Support for throwing in the `template-haskell` `Q` monad
+* Support for `transformers` 0.5
+
+0.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

@@ -1,31 +1,31 @@-Copyright 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.+Copyright 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.

@@ -1,15 +1,15 @@-exceptions-==========--[![Hackage](https://img.shields.io/hackage/v/exceptions.svg)](https://hackage.haskell.org/package/exceptions) [![Build Status](https://github.com/ekmett/exceptions/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/exceptions/actions?query=workflow%3AHaskell-CI)--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
+==========
+
+[![Hackage](https://img.shields.io/hackage/v/exceptions.svg)](https://hackage.haskell.org/package/exceptions) [![Build Status](https://github.com/ekmett/exceptions/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/exceptions/actions?query=workflow%3AHaskell-CI)
+
+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

@@ -1,7 +1,7 @@-#!/usr/bin/runhaskell-> module Main (main) where--> import Distribution.Simple--> main :: IO ()-> main = defaultMain+#!/usr/bin/runhaskell
+> module Main (main) where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

@@ -1,97 +1,97 @@-name:          exceptions-category:      Control, Exceptions, Monad-version:       0.10.5-cabal-version: >= 1.10-license:       BSD3-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-2015 Edward A. Kmett-               Copyright (C) 2012 Google Inc.-build-type:    Simple-tested-with:   GHC == 7.0.4-             , GHC == 7.2.2-             , GHC == 7.4.2-             , GHC == 7.6.3-             , GHC == 7.8.4-             , GHC == 7.10.3-             , GHC == 8.0.2-             , GHC == 8.2.2-             , GHC == 8.4.4-             , GHC == 8.6.5-             , GHC == 8.8.4-             , GHC == 8.10.4-             , GHC == 9.0.1-synopsis:      Extensible optionally-pure exceptions-description:   Extensible optionally-pure exceptions.--extra-source-files:-  .ghci-  .gitignore-  .vim.custom-  AUTHORS.markdown-  README.markdown-  CHANGELOG.markdown--source-repository head-  type: git-  location: git://github.com/ekmett/exceptions.git--flag transformers-0-4-  description: Use @transformers-0.4@ or later.-  default:     True--library-  build-depends:-    base                       >= 4.3      && < 5,-    stm                        >= 2.2      && < 3,-    template-haskell           >= 2.2      && < 2.19,-    mtl                        >= 2.0      && < 2.4--  if !impl(ghc >= 8.0)-    build-depends: fail        == 4.9.*--  if flag(transformers-0-4)-    build-depends:-      transformers             >= 0.4      && < 0.7-  else-    build-depends:-      transformers             >= 0.2      && < 0.4,-      transformers-compat      >= 0.3      && < 0.8--  exposed-modules:-    Control.Monad.Catch-    Control.Monad.Catch.Pure--  ghc-options: -Wall -fwarn-tabs -O2-  hs-source-dirs: src-  default-language: Haskell2010--test-suite exceptions-tests-  main-is: Tests.hs-  other-modules: Control.Monad.Catch.Tests-  hs-source-dirs: tests-  ghc-options: -Wall -fwarn-tabs-  default-language: Haskell2010-  type: exitcode-stdio-1.0-  build-depends:-    base,-    exceptions,-    stm,-    template-haskell,-    mtl                        >= 2.0,-    test-framework             >= 0.8      && < 0.9,-    test-framework-hunit       >= 0.3      && < 0.4,-    test-framework-quickcheck2 >= 0.3      && < 0.4,-    QuickCheck                 >= 2.5      && < 2.15--  if flag(transformers-0-4)-    build-depends:-      transformers             >= 0.4      && < 0.7-  else-    build-depends:-      transformers             >= 0.2      && < 0.4,-      transformers-compat      >= 0.3      && < 0.8+name:          exceptions
+category:      Control, Exceptions, Monad
+version:       0.10.6
+cabal-version: >= 1.10
+license:       BSD3
+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-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.3
+             , GHC == 8.0.2
+             , GHC == 8.2.2
+             , GHC == 8.4.4
+             , GHC == 8.6.5
+             , GHC == 8.8.4
+             , GHC == 8.10.7
+             , GHC == 9.0.2
+             , GHC == 9.2.2
+synopsis:      Extensible optionally-pure exceptions
+description:   Extensible optionally-pure exceptions.
+
+extra-source-files:
+  .ghci
+  .gitignore
+  .vim.custom
+  AUTHORS.markdown
+  README.markdown
+  CHANGELOG.markdown
+
+source-repository head
+  type: git
+  location: git://github.com/ekmett/exceptions.git
+
+flag transformers-0-4
+  description: Use @transformers-0.4@ or later.
+  default:     True
+
+library
+  build-depends:
+    base                       >= 4.5      && < 5,
+    stm                        >= 2.2      && < 3,
+    template-haskell           >= 2.7      && < 2.20,
+    mtl                        >= 2.0      && < 2.4
+
+  if !impl(ghc >= 8.0)
+    build-depends: call-stack  >= 0.1      && < 0.5,
+                   fail        == 4.9.*
+
+  if flag(transformers-0-4)
+    build-depends:
+      transformers             >= 0.4      && < 0.7
+  else
+    build-depends:
+      transformers             >= 0.2      && < 0.4,
+      transformers-compat      >= 0.3      && < 0.8
+
+  exposed-modules:
+    Control.Monad.Catch
+    Control.Monad.Catch.Pure
+
+  ghc-options: -Wall -fwarn-tabs -O2
+  hs-source-dirs: src
+  default-language: Haskell2010
+
+test-suite exceptions-tests
+  main-is: Tests.hs
+  other-modules: Control.Monad.Catch.Tests
+  hs-source-dirs: tests
+  ghc-options: -Wall -fwarn-tabs
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  build-depends:
+    base,
+    exceptions,
+    stm,
+    template-haskell,
+    mtl                        >= 2.0,
+    test-framework             >= 0.8      && < 0.9,
+    test-framework-hunit       >= 0.3      && < 0.4,
+    test-framework-quickcheck2 >= 0.3      && < 0.4,
+    QuickCheck                 >= 2.5      && < 2.15
+
+  if flag(transformers-0-4)
+    build-depends:
+      transformers             >= 0.4      && < 0.7
+  else
+    build-depends:
+      transformers             >= 0.2      && < 0.4,
+      transformers-compat      >= 0.3      && < 0.8

@@ -1,877 +1,891 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif--#if !(MIN_VERSION_transformers(0,6,0))-{-# OPTIONS_GHC -fno-warn-deprecations #-}-#endif------------------------------------------------------------------------ |--- Copyright   :  (C) Edward Kmett 2013-2015, (c) Google Inc. 2012--- License     :  BSD-style (see the file LICENSE)--- 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 exceptions feature relies on the RankNTypes language extension.-----------------------------------------------------------------------module Control.Monad.Catch (-    -- * Typeclass-    -- $mtl-    MonadThrow(..)-  , MonadCatch(..)-  , MonadMask(..)-  , ExitCase(..)--    -- * Utilities-    -- $utilities-  , mask_-  , uninterruptibleMask_-  , catchAll-  , catchIOError-  , catchJust-  , catchIf-  , Handler(..), catches-  , handle-  , handleAll-  , handleIOError-  , handleJust-  , handleIf-  , try-  , tryJust-  , onException-  , onError-  , bracket-  , bracket_-  , finally-  , bracketOnError-    -- * Re-exports from Control.Exception-  , Exception(..)-  , SomeException(..)-  ) where--import Control.Exception (Exception(..), SomeException(..))-import qualified Control.Exception as ControlException-import Control.Monad (liftM)-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.ST (ST)-import Control.Monad.STM (STM)-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)-import Control.Monad.Trans.Except (ExceptT(..), runExceptT)-import Control.Monad.Trans.Cont (ContT)-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)--import Language.Haskell.TH.Syntax (Q)--#if MIN_VERSION_base(4,4,0)-import Control.Monad.ST.Unsafe (unsafeIOToST)-#else-import Control.Monad.ST (unsafeIOToST)-#endif--#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--#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif--#if !(MIN_VERSION_transformers(0,6,0))-import Control.Monad.Trans.Error (ErrorT(..), Error, runErrorT)-import Control.Monad.Trans.List (ListT(..), runListT)-#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 are invalid--- instances of this class.------ Instances should ensure that, in the following code:------ > fg = f `finally` g------ The action @g@ is called regardless of what occurs within @f@, including--- async exceptions. Some monads allow @f@ to abort the computation via other--- effects than throwing an exception. For simplicity, we will consider aborting--- and throwing an exception to be two forms of "throwing an error".------ If @f@ and @g@ both throw an error, the error thrown by @fg@ depends on which--- errors we're talking about. In a monad transformer stack, the deeper layers--- override the effects of the inner layers; for example, @ExceptT e1 (Except--- e2) a@ represents a value of type @Either e2 (Either e1 a)@, so throwing both--- an @e1@ and an @e2@ will result in @Left e2@. If @f@ and @g@ both throw an--- error from the same layer, instances should ensure that the error from @g@--- wins.------ Effects other than throwing an error are also overridden by the deeper layers.--- For example, @StateT s Maybe a@ represents a value of type @s -> Maybe (a,--- s)@, so if an error thrown from @f@ causes this function to return @Nothing@,--- any changes to the state which @f@ also performed will be erased. As a--- result, @g@ will see the state as it was before @f@. Once @g@ completes,--- @f@'s error will be rethrown, so @g@' state changes will be erased as well.--- This is the normal interaction between effects in a monad transformer stack.------ By contrast, <https://hackage.haskell.org/package/lifted-base lifted-base>'s--- version of 'finally' always discards all of @g@'s non-IO effects, and @g@--- never sees any of @f@'s non-IO effects, regardless of the layer ordering and--- regardless of whether @f@ throws an error. This is not the result of--- interacting effects, but a consequence of @MonadBaseControl@'s approach.-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--  -- | A generalized version of 'bracket' which uses 'ExitCase' to distinguish-  -- the different exit cases, and returns the values of both the 'use' and-  -- 'release' actions. In practice, this extra information is rarely needed,-  -- so it is often more convenient to use one of the simpler functions which-  -- are defined in terms of this one, such as 'bracket', 'finally', 'onError',-  -- and 'bracketOnError'.-  ---  -- This function exists because in order to thread their effects through the-  -- execution of 'bracket', monad transformers need values to be threaded from-  -- 'use' to 'release' and from 'release' to the output value.-  ---  -- /NOTE/ This method was added in version 0.9.0 of this-  -- library. Previously, implementation of functions like 'bracket'-  -- and 'finally' in this module were based on the 'mask' and-  -- 'uninterruptibleMask' functions only, disallowing some classes of-  -- tranformers from having @MonadMask@ instances (notably-  -- multi-exit-point transformers like 'ExceptT'). If you are a-  -- library author, you'll now need to provide an implementation for-  -- this method. The @StateT@ implementation demonstrates most of the-  -- subtleties:-  ---  -- @-  -- generalBracket acquire release use = StateT $ \s0 -> do-  --   ((b, _s2), (c, s3)) <- generalBracket-  --     (runStateT acquire s0)-  --     (\(resource, s1) exitCase -> case exitCase of-  --       ExitCaseSuccess (b, s2) -> runStateT (release resource (ExitCaseSuccess b)) s2-  ---  --       -- In the two other cases, the base monad overrides @use@'s state-  --       -- changes and the state reverts to @s1@.-  --       ExitCaseException e     -> runStateT (release resource (ExitCaseException e)) s1-  --       ExitCaseAbort           -> runStateT (release resource ExitCaseAbort) s1-  --     )-  --     (\(resource, s1) -> runStateT (use resource) s1)-  --   return ((b, c), s3)-  -- @-  ---  -- The @StateT s m@ implementation of @generalBracket@ delegates to the @m@-  -- implementation of @generalBracket@. The @acquire@, @use@, and @release@-  -- arguments given to @StateT@'s implementation produce actions of type-  -- @StateT s m a@, @StateT s m b@, and @StateT s m c@. In order to run those-  -- actions in the base monad, we need to call @runStateT@, from which we-  -- obtain actions of type @m (a, s)@, @m (b, s)@, and @m (c, s)@. Since each-  -- action produces the next state, it is important to feed the state produced-  -- by the previous action to the next action.-  ---  -- In the 'ExitCaseSuccess' case, the state starts at @s0@, flows through-  -- @acquire@ to become @s1@, flows through @use@ to become @s2@, and finally-  -- flows through @release@ to become @s3@. In the other two cases, @release@-  -- does not receive the value @s2@, so its action cannot see the state changes-  -- performed by @use@. This is fine, because in those two cases, an error was-  -- thrown in the base monad, so as per the usual interaction between effects-  -- in a monad transformer stack, those state changes get reverted. So we start-  -- from @s1@ instead.-  ---  -- Finally, the @m@ implementation of @generalBracket@ returns the pairs-  -- @(b, s)@ and @(c, s)@. For monad transformers other than @StateT@, this-  -- will be some other type representing the effects and values performed and-  -- returned by the @use@ and @release@ actions. The effect part of the @use@-  -- result, in this case @_s2@, usually needs to be discarded, since those-  -- effects have already been incorporated in the @release@ action.-  ---  -- The only effect which is intentionally not incorporated in the @release@-  -- action is the effect of throwing an error. In that case, the error must be-  -- re-thrown. One subtlety which is easy to miss is that in the case in which-  -- @use@ and @release@ both throw an error, the error from @release@ should-  -- take priority. Here is an implementation for @ExceptT@ which demonstrates-  -- how to do this.-  ---  -- @-  -- generalBracket acquire release use = ExceptT $ do-  --   (eb, ec) <- generalBracket-  --     (runExceptT acquire)-  --     (\eresource exitCase -> case eresource of-  --       Left e -> return (Left e) -- nothing to release, acquire didn't succeed-  --       Right resource -> case exitCase of-  --         ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))-  --         ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))-  --         _                         -> runExceptT (release resource ExitCaseAbort))-  --     (either (return . Left) (runExceptT . use))-  --   return $ do-  --     -- The order in which we perform those two 'Either' effects determines-  --     -- which error will win if they are both 'Left's. We want the error from-  --     -- 'release' to win.-  --     c <- ec-  --     b <- eb-  --     return (b, c)-  -- @-  ---  -- @since 0.9.0-  generalBracket-    :: m a-    -- ^ acquire some resource-    -> (a -> ExitCase b -> m c)-    -- ^ release the resource, observing the outcome of the inner action-    -> (a -> m b)-    -- ^ inner action to perform with the resource-    -> m (b, c)---- | A 'MonadMask' computation may either succeed with a value, abort with an--- exception, or abort for some other reason. For example, in @ExceptT e IO@--- you can use 'throwM' to abort with an exception ('ExitCaseException') or--- 'Control.Monad.Trans.Except.throwE' to abort with a value of type 'e'--- ('ExitCaseAbort').-data ExitCase a-  = ExitCaseSuccess a-  | ExitCaseException SomeException-  | ExitCaseAbort-  deriving Show--instance MonadThrow [] where-  throwM _ = []-instance MonadThrow Maybe where-  throwM _ = Nothing-instance MonadThrow Q where-  throwM = fail . show--instance MonadThrow IO where-  throwM = ControlException.throwIO-instance MonadCatch IO where-  catch = ControlException.catch-instance MonadMask IO where-  mask = ControlException.mask-  uninterruptibleMask = ControlException.uninterruptibleMask-  generalBracket acquire release use = mask $ \unmasked -> do-    resource <- acquire-    b <- unmasked (use resource) `catch` \e -> do-      _ <- release resource (ExitCaseException e)-      throwM e-    c <- release resource (ExitCaseSuccess b)-    return (b, c)--instance MonadThrow (ST s) where-  throwM = unsafeIOToST . ControlException.throwIO--instance MonadThrow STM where-  throwM = STM.throwSTM-instance MonadCatch STM where-  catch = STM.catchSTM--instance e ~ SomeException => MonadThrow (Either e) where-  throwM = Left . toException--- | @since 0.8.3-instance e ~ SomeException => MonadCatch (Either e) where-  catch (Left e) f =-    case fromException e of-      Nothing -> Left e-      Just e' -> f e'-  catch x@(Right _) _ = x--- | @since 0.8.3-instance e ~ SomeException => MonadMask (Either e) where-  mask f = f id-  uninterruptibleMask f = f id--  generalBracket acquire release use =-    case acquire of-      Left e -> Left e-      Right resource ->-        case use resource of-          Left e -> release resource (ExitCaseException e) >> Left e-          Right b -> do-            c <- release resource (ExitCaseSuccess b)-            return (b, c)--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--  generalBracket acquire release use = IdentityT $-    generalBracket-      (runIdentityT acquire)-      (\resource exitCase -> runIdentityT (release resource exitCase))-      (\resource -> runIdentityT (use resource))--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)--  generalBracket acquire release use = LazyS.StateT $ \s0 -> do-    -- This implementation is given as an example in the documentation of-    -- 'generalBracket', so when changing it, remember to update the-    -- documentation's copy as well-    ((b, _s2), (c, s3)) <- generalBracket-      (LazyS.runStateT acquire s0)-      (\(resource, s1) exitCase -> case exitCase of-        ExitCaseSuccess (b, s2) -> LazyS.runStateT (release resource (ExitCaseSuccess b)) s2-        -- In the two other cases, the base monad overrides @use@'s state-        -- changes and the state reverts to @s1@.-        ExitCaseException e     -> LazyS.runStateT (release resource (ExitCaseException e)) s1-        ExitCaseAbort           -> LazyS.runStateT (release resource ExitCaseAbort) s1)-      (\(resource, s1) -> LazyS.runStateT (use resource) s1)-    return ((b, c), s3)--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)--  generalBracket acquire release use = StrictS.StateT $ \s0 -> do-    ((b, _s2), (c, s3)) <- generalBracket-      (StrictS.runStateT acquire s0)-      (\(resource, s1) exitCase -> case exitCase of-        ExitCaseSuccess (b, s2) -> StrictS.runStateT (release resource (ExitCaseSuccess b)) s2-        -- In the two other cases, the base monad overrides @use@'s state-        -- changes and the state reverts to @s1@.-        ExitCaseException e     -> StrictS.runStateT (release resource (ExitCaseException e)) s1-        ExitCaseAbort           -> StrictS.runStateT (release resource ExitCaseAbort) s1)-      (\(resource, s1) -> StrictS.runStateT (use resource) s1)-    return ((b, c), s3)--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)--  generalBracket acquire release use = ReaderT $ \r ->-    generalBracket-      (runReaderT acquire r)-      (\resource exitCase -> runReaderT (release resource exitCase) r)-      (\resource -> runReaderT (use resource) r)--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)--  generalBracket acquire release use = StrictW.WriterT $ do-    ((b, _w12), (c, w123)) <- generalBracket-      (StrictW.runWriterT acquire)-      (\(resource, w1) exitCase -> case exitCase of-        ExitCaseSuccess (b, w12) -> do-          (c, w3) <- StrictW.runWriterT (release resource (ExitCaseSuccess b))-          return (c, mappend w12 w3)-        -- In the two other cases, the base monad overrides @use@'s state-        -- changes and the state reverts to @w1@.-        ExitCaseException e -> do-          (c, w3) <- StrictW.runWriterT (release resource (ExitCaseException e))-          return (c, mappend w1 w3)-        ExitCaseAbort -> do-          (c, w3) <- StrictW.runWriterT (release resource ExitCaseAbort)-          return (c, mappend w1 w3))-      (\(resource, w1) -> do-        (a, w2) <- StrictW.runWriterT (use resource)-        return (a, mappend w1 w2))-    return ((b, c), w123)--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)--  generalBracket acquire release use = LazyW.WriterT $ do-    ((b, _w12), (c, w123)) <- generalBracket-      (LazyW.runWriterT acquire)-      (\(resource, w1) exitCase -> case exitCase of-        ExitCaseSuccess (b, w12) -> do-          (c, w3) <- LazyW.runWriterT (release resource (ExitCaseSuccess b))-          return (c, mappend w12 w3)-        -- In the two other cases, the base monad overrides @use@'s state-        -- changes and the state reverts to @w1@.-        ExitCaseException e -> do-          (c, w3) <- LazyW.runWriterT (release resource (ExitCaseException e))-          return (c, mappend w1 w3)-        ExitCaseAbort -> do-          (c, w3) <- LazyW.runWriterT (release resource ExitCaseAbort)-          return (c, mappend w1 w3))-      (\(resource, w1) -> do-        (a, w2) <- LazyW.runWriterT (use resource)-        return (a, mappend w1 w2))-    return ((b, c), w123)--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)--  generalBracket acquire release use = LazyRWS.RWST $ \r s0 -> do-    ((b, _s2, _w12), (c, s3, w123)) <- generalBracket-      (LazyRWS.runRWST acquire r s0)-      (\(resource, s1, w1) exitCase -> case exitCase of-        ExitCaseSuccess (b, s2, w12) -> do-          (c, s3, w3) <- LazyRWS.runRWST (release resource (ExitCaseSuccess b)) r s2-          return (c, s3, mappend w12 w3)-        -- In the two other cases, the base monad overrides @use@'s state-        -- changes and the state reverts to @s1@ and @w1@.-        ExitCaseException e -> do-          (c, s3, w3) <- LazyRWS.runRWST (release resource (ExitCaseException e)) r s1-          return (c, s3, mappend w1 w3)-        ExitCaseAbort -> do-          (c, s3, w3) <- LazyRWS.runRWST (release resource ExitCaseAbort) r s1-          return (c, s3, mappend w1 w3))-      (\(resource, s1, w1) -> do-        (a, s2, w2) <- LazyRWS.runRWST (use resource) r s1-        return (a, s2, mappend w1 w2))-    return ((b, c), s3, w123)--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)--  generalBracket acquire release use = StrictRWS.RWST $ \r s0 -> do-    ((b, _s2, _w12), (c, s3, w123)) <- generalBracket-      (StrictRWS.runRWST acquire r s0)-      (\(resource, s1, w1) exitCase -> case exitCase of-        ExitCaseSuccess (b, s2, w12) -> do-          (c, s3, w3) <- StrictRWS.runRWST (release resource (ExitCaseSuccess b)) r s2-          return (c, s3, mappend w12 w3)-        -- In the two other cases, the base monad overrides @use@'s state-        -- changes and the state reverts to @s1@ and @w1@.-        ExitCaseException e -> do-          (c, s3, w3) <- StrictRWS.runRWST (release resource (ExitCaseException e)) r s1-          return (c, s3, mappend w1 w3)-        ExitCaseAbort -> do-          (c, s3, w3) <- StrictRWS.runRWST (release resource ExitCaseAbort) r s1-          return (c, s3, mappend w1 w3))-      (\(resource, s1, w1) -> do-        (a, s2, w2) <- StrictRWS.runRWST (use resource) r s1-        return (a, s2, mappend w1 w2))-    return ((b, c), s3, w123)---- | 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)--- | @since 0.10.0-instance MonadMask m => MonadMask (MaybeT m) where-  mask f = MaybeT $ mask $ \u -> runMaybeT $ f (q u)-    where-      q :: (m (Maybe a) -> m (Maybe a))-        -> MaybeT m a -> MaybeT m a-      q u (MaybeT b) = MaybeT (u b)-  uninterruptibleMask f = MaybeT $ uninterruptibleMask $ \u -> runMaybeT $ f (q u)-    where-      q :: (m (Maybe a) -> m (Maybe a))-        -> MaybeT m a -> MaybeT m a-      q u (MaybeT b) = MaybeT (u b)--  generalBracket acquire release use = MaybeT $ do-    (eb, ec) <- generalBracket-      (runMaybeT acquire)-      (\resourceMay exitCase -> case resourceMay of-        Nothing -> return Nothing -- nothing to release, acquire didn't succeed-        Just resource -> case exitCase of-          ExitCaseSuccess (Just b) -> runMaybeT (release resource (ExitCaseSuccess b))-          ExitCaseException e      -> runMaybeT (release resource (ExitCaseException e))-          _                        -> runMaybeT (release resource ExitCaseAbort))-      (\resourceMay -> case resourceMay of-        Nothing -> return Nothing-        Just resource -> runMaybeT (use resource))-    -- The order in which we perform those two 'Maybe' effects doesn't matter,-    -- since the error message is the same regardless.-    return ((,) <$> eb <*> ec)---- | 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)--- | @since 0.9.0-instance MonadMask m => MonadMask (ExceptT e m) where-  mask f = ExceptT $ mask $ \u -> runExceptT $ f (q u)-    where-      q :: (m (Either e a) -> m (Either e a))-        -> ExceptT e m a -> ExceptT e m a-      q u (ExceptT b) = ExceptT (u b)-  uninterruptibleMask f = ExceptT $ uninterruptibleMask $ \u -> runExceptT $ f (q u)-    where-      q :: (m (Either e a) -> m (Either e a))-        -> ExceptT e m a -> ExceptT e m a-      q u (ExceptT b) = ExceptT (u b)--  generalBracket acquire release use = ExceptT $ do-    -- This implementation is given as an example in the documentation of-    -- 'generalBracket', so when changing it, remember to update the-    -- documentation's copy as well-    (eb, ec) <- generalBracket-      (runExceptT acquire)-      (\eresource exitCase -> case eresource of-        Left e -> return (Left e) -- nothing to release, acquire didn't succeed-        Right resource -> case exitCase of-          ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))-          ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))-          _                         -> runExceptT (release resource ExitCaseAbort))-      (either (return . Left) (runExceptT . use))-    return $ do-      -- The order in which we perform those two 'Either' effects determines-      -- which error will win if they are both 'Left's. We want the error from-      -- 'release' to win.-      c <- ec-      b <- eb-      return (b, c)--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--#if !(MIN_VERSION_transformers(0,6,0))--- | 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)-instance (Error e, MonadMask m) => MonadMask (ErrorT e m) where-  mask f = ErrorT $ mask $ \u -> runErrorT $ f (q u)-    where-      q :: (m (Either e a) -> m (Either e a))-        -> ErrorT e m a -> ErrorT e m a-      q u (ErrorT b) = ErrorT (u b)-  uninterruptibleMask f = ErrorT $ uninterruptibleMask $ \u -> runErrorT $ f (q u)-    where-      q :: (m (Either e a) -> m (Either e a))-        -> ErrorT e m a -> ErrorT e m a-      q u (ErrorT b) = ErrorT (u b)--  generalBracket acquire release use = ErrorT $ do-    (eb, ec) <- generalBracket-      (runErrorT acquire)-      (\eresource exitCase -> case eresource of-        Left e -> return (Left e) -- nothing to release, acquire didn't succeed-        Right resource -> case exitCase of-          ExitCaseSuccess (Right b) -> runErrorT (release resource (ExitCaseSuccess b))-          ExitCaseException e       -> runErrorT (release resource (ExitCaseException e))-          _                         -> runErrorT (release resource ExitCaseAbort))-      (either (return . Left) (runErrorT . use))-    return $ do-      -- The order in which we perform those two 'Either' effects determines-      -- which error will win if they are both 'Left's. We want the error from-      -- 'release' to win.-      c <- ec-      b <- eb-      return (b, c)---- 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)-#endif----------------------------------------------------------------------------------- $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.------ /NOTE/ This catches all /exceptions/, but if the monad supports other ways of--- aborting the computation, those other kinds of errors will not be caught.-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.------ /NOTE/ The action is only run if an /exception/ is thrown. If the monad--- supports other ways of aborting the computation, the action won't run if--- those other kinds of errors are thrown. See 'onError'.-onException :: MonadCatch m => m a -> m b -> m a-onException action handler = action `catchAll` \e -> handler >> throwM e---- | Run an action only if an error is thrown in the main action. Unlike--- 'onException', this works with every kind of error, not just exceptions. For--- example, if @f@ is an 'ExceptT' computation which aborts with a 'Left', the--- computation @onError f g@ will execute @g@, while @onException f g@ will not.------ This distinction is only meaningful for monads which have multiple exit--- points, such as 'Except' and 'MaybeT'. For monads that only have a single--- exit point, there is no difference between 'onException' and 'onError',--- except that 'onError' has a more constrained type.------ @since 0.10.0-onError :: MonadMask m => m a -> m b -> m a-onError action handler = bracketOnError (return ()) (const handler) (const action)---- | Generalized abstracted pattern of safe resource acquisition and release--- in the face of errors. 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 error is thrown during the use, the release still happens before the--- error is rethrown.------ Note that this is essentially a type-specialized version of--- 'generalBracket'. This function has a more common signature (matching the--- signature from "Control.Exception"), and is often more convenient to use. By--- contrast, 'generalBracket' is more expressive, allowing us to implement--- other functions like 'bracketOnError'.-bracket :: MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b-bracket acquire release = liftM fst . generalBracket-  acquire-  (\a _exitCase -> release a)---- | Version of 'bracket' without any value being passed to the second and--- third actions.-bracket_ :: MonadMask m => m a -> m c -> m b -> m b-bracket_ before after action = bracket before (const after) (const action)---- | Perform an action with a finalizer action that is run, even if an--- error 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 an error is--- thrown by the in-between computation.-bracketOnError :: MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b-bracketOnError acquire release = liftM fst . generalBracket-  acquire-  (\a exitCase -> case exitCase of-    ExitCaseSuccess _ -> return ()-    _ -> do-      _ <- release a-      return ())+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+#ifndef MIN_VERSION_transformers
+#define MIN_VERSION_transformers(x,y,z) 1
+#endif
+
+#if !(MIN_VERSION_transformers(0,6,0))
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+#endif
+--------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) Edward Kmett 2013-2015, (c) Google Inc. 2012
+-- License     :  BSD-style (see the file LICENSE)
+-- 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 exceptions feature relies on the RankNTypes language extension.
+--------------------------------------------------------------------
+
+module Control.Monad.Catch (
+    -- * Typeclass
+    -- $mtl
+    MonadThrow(..)
+  , MonadCatch(..)
+  , MonadMask(..)
+  , ExitCase(..)
+
+    -- * Utilities
+    -- $utilities
+  , mask_
+  , uninterruptibleMask_
+  , catchAll
+  , catchIOError
+  , catchJust
+  , catchIf
+  , Handler(..), catches
+  , handle
+  , handleAll
+  , handleIOError
+  , handleJust
+  , handleIf
+  , try
+  , tryJust
+  , onException
+  , onError
+  , bracket
+  , bracket_
+  , finally
+  , bracketOnError
+    -- * Re-exports from Control.Exception
+  , Exception(..)
+  , SomeException(..)
+  ) where
+
+import Control.Exception (Exception(..), SomeException(..))
+import qualified Control.Exception as ControlException
+import Control.Monad (liftM)
+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.ST (ST)
+import Control.Monad.STM (STM)
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
+import Control.Monad.Trans.Cont (ContT)
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
+
+import Language.Haskell.TH.Syntax (Q)
+
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.ST.Unsafe (unsafeIOToST)
+#else
+import Control.Monad.ST (unsafeIOToST)
+#endif
+
+#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
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative
+#endif
+
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack, withFrozenCallStack)
+#else
+import Data.CallStack (HasCallStack)
+#endif
+
+#if !(MIN_VERSION_transformers(0,6,0))
+import Control.Monad.Trans.Error (ErrorT(..), Error, runErrorT)
+import Control.Monad.Trans.List (ListT(..), runListT)
+#endif
+
+#if __GLASGOW_HASKELL__ < 800
+withFrozenCallStack :: a -> a
+withFrozenCallStack a = a
+#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 :: (HasCallStack, 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 :: (HasCallStack, 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 are invalid
+-- instances of this class.
+--
+-- Instances should ensure that, in the following code:
+--
+-- > fg = f `finally` g
+--
+-- The action @g@ is called regardless of what occurs within @f@, including
+-- async exceptions. Some monads allow @f@ to abort the computation via other
+-- effects than throwing an exception. For simplicity, we will consider aborting
+-- and throwing an exception to be two forms of "throwing an error".
+--
+-- If @f@ and @g@ both throw an error, the error thrown by @fg@ depends on which
+-- errors we're talking about. In a monad transformer stack, the deeper layers
+-- override the effects of the inner layers; for example, @ExceptT e1 (Except
+-- e2) a@ represents a value of type @Either e2 (Either e1 a)@, so throwing both
+-- an @e1@ and an @e2@ will result in @Left e2@. If @f@ and @g@ both throw an
+-- error from the same layer, instances should ensure that the error from @g@
+-- wins.
+--
+-- Effects other than throwing an error are also overridden by the deeper layers.
+-- For example, @StateT s Maybe a@ represents a value of type @s -> Maybe (a,
+-- s)@, so if an error thrown from @f@ causes this function to return @Nothing@,
+-- any changes to the state which @f@ also performed will be erased. As a
+-- result, @g@ will see the state as it was before @f@. Once @g@ completes,
+-- @f@'s error will be rethrown, so @g@' state changes will be erased as well.
+-- This is the normal interaction between effects in a monad transformer stack.
+--
+-- By contrast, <https://hackage.haskell.org/package/lifted-base lifted-base>'s
+-- version of 'finally' always discards all of @g@'s non-IO effects, and @g@
+-- never sees any of @f@'s non-IO effects, regardless of the layer ordering and
+-- regardless of whether @f@ throws an error. This is not the result of
+-- interacting effects, but a consequence of @MonadBaseControl@'s approach.
+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 :: HasCallStack => ((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 :: HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
+
+  -- | A generalized version of 'bracket' which uses 'ExitCase' to distinguish
+  -- the different exit cases, and returns the values of both the 'use' and
+  -- 'release' actions. In practice, this extra information is rarely needed,
+  -- so it is often more convenient to use one of the simpler functions which
+  -- are defined in terms of this one, such as 'bracket', 'finally', 'onError',
+  -- and 'bracketOnError'.
+  --
+  -- This function exists because in order to thread their effects through the
+  -- execution of 'bracket', monad transformers need values to be threaded from
+  -- 'use' to 'release' and from 'release' to the output value.
+  --
+  -- /NOTE/ This method was added in version 0.9.0 of this
+  -- library. Previously, implementation of functions like 'bracket'
+  -- and 'finally' in this module were based on the 'mask' and
+  -- 'uninterruptibleMask' functions only, disallowing some classes of
+  -- tranformers from having @MonadMask@ instances (notably
+  -- multi-exit-point transformers like 'ExceptT'). If you are a
+  -- library author, you'll now need to provide an implementation for
+  -- this method. The @StateT@ implementation demonstrates most of the
+  -- subtleties:
+  --
+  -- @
+  -- generalBracket acquire release use = StateT $ \s0 -> do
+  --   ((b, _s2), (c, s3)) <- generalBracket
+  --     (runStateT acquire s0)
+  --     (\(resource, s1) exitCase -> case exitCase of
+  --       ExitCaseSuccess (b, s2) -> runStateT (release resource (ExitCaseSuccess b)) s2
+  --
+  --       -- In the two other cases, the base monad overrides @use@'s state
+  --       -- changes and the state reverts to @s1@.
+  --       ExitCaseException e     -> runStateT (release resource (ExitCaseException e)) s1
+  --       ExitCaseAbort           -> runStateT (release resource ExitCaseAbort) s1
+  --     )
+  --     (\(resource, s1) -> runStateT (use resource) s1)
+  --   return ((b, c), s3)
+  -- @
+  --
+  -- The @StateT s m@ implementation of @generalBracket@ delegates to the @m@
+  -- implementation of @generalBracket@. The @acquire@, @use@, and @release@
+  -- arguments given to @StateT@'s implementation produce actions of type
+  -- @StateT s m a@, @StateT s m b@, and @StateT s m c@. In order to run those
+  -- actions in the base monad, we need to call @runStateT@, from which we
+  -- obtain actions of type @m (a, s)@, @m (b, s)@, and @m (c, s)@. Since each
+  -- action produces the next state, it is important to feed the state produced
+  -- by the previous action to the next action.
+  --
+  -- In the 'ExitCaseSuccess' case, the state starts at @s0@, flows through
+  -- @acquire@ to become @s1@, flows through @use@ to become @s2@, and finally
+  -- flows through @release@ to become @s3@. In the other two cases, @release@
+  -- does not receive the value @s2@, so its action cannot see the state changes
+  -- performed by @use@. This is fine, because in those two cases, an error was
+  -- thrown in the base monad, so as per the usual interaction between effects
+  -- in a monad transformer stack, those state changes get reverted. So we start
+  -- from @s1@ instead.
+  --
+  -- Finally, the @m@ implementation of @generalBracket@ returns the pairs
+  -- @(b, s)@ and @(c, s)@. For monad transformers other than @StateT@, this
+  -- will be some other type representing the effects and values performed and
+  -- returned by the @use@ and @release@ actions. The effect part of the @use@
+  -- result, in this case @_s2@, usually needs to be discarded, since those
+  -- effects have already been incorporated in the @release@ action.
+  --
+  -- The only effect which is intentionally not incorporated in the @release@
+  -- action is the effect of throwing an error. In that case, the error must be
+  -- re-thrown. One subtlety which is easy to miss is that in the case in which
+  -- @use@ and @release@ both throw an error, the error from @release@ should
+  -- take priority. Here is an implementation for @ExceptT@ which demonstrates
+  -- how to do this.
+  --
+  -- @
+  -- generalBracket acquire release use = ExceptT $ do
+  --   (eb, ec) <- generalBracket
+  --     (runExceptT acquire)
+  --     (\eresource exitCase -> case eresource of
+  --       Left e -> return (Left e) -- nothing to release, acquire didn't succeed
+  --       Right resource -> case exitCase of
+  --         ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))
+  --         ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))
+  --         _                         -> runExceptT (release resource ExitCaseAbort))
+  --     (either (return . Left) (runExceptT . use))
+  --   return $ do
+  --     -- The order in which we perform those two 'Either' effects determines
+  --     -- which error will win if they are both 'Left's. We want the error from
+  --     -- 'release' to win.
+  --     c <- ec
+  --     b <- eb
+  --     return (b, c)
+  -- @
+  --
+  -- @since 0.9.0
+  generalBracket
+    :: HasCallStack
+    => m a
+    -- ^ acquire some resource
+    -> (a -> ExitCase b -> m c)
+    -- ^ release the resource, observing the outcome of the inner action
+    -> (a -> m b)
+    -- ^ inner action to perform with the resource
+    -> m (b, c)
+
+-- | A 'MonadMask' computation may either succeed with a value, abort with an
+-- exception, or abort for some other reason. For example, in @ExceptT e IO@
+-- you can use 'throwM' to abort with an exception ('ExitCaseException') or
+-- 'Control.Monad.Trans.Except.throwE' to abort with a value of type 'e'
+-- ('ExitCaseAbort').
+data ExitCase a
+  = ExitCaseSuccess a
+  | ExitCaseException SomeException
+  | ExitCaseAbort
+  deriving Show
+
+instance MonadThrow [] where
+  throwM _ = []
+instance MonadThrow Maybe where
+  throwM _ = Nothing
+instance MonadThrow Q where
+  throwM = fail . show
+
+instance MonadThrow IO where
+  throwM = ControlException.throwIO
+instance MonadCatch IO where
+  catch = ControlException.catch
+instance MonadMask IO where
+  mask = ControlException.mask
+  uninterruptibleMask = ControlException.uninterruptibleMask
+  generalBracket acquire release use = mask $ \unmasked -> do
+    resource <- acquire
+    b <- unmasked (use resource) `catch` \e -> do
+      _ <- release resource (ExitCaseException e)
+      throwM e
+    c <- release resource (ExitCaseSuccess b)
+    return (b, c)
+
+instance MonadThrow (ST s) where
+  throwM = unsafeIOToST . ControlException.throwIO
+
+instance MonadThrow STM where
+  throwM = STM.throwSTM
+instance MonadCatch STM where
+  catch = STM.catchSTM
+
+instance e ~ SomeException => MonadThrow (Either e) where
+  throwM = Left . toException
+-- | @since 0.8.3
+instance e ~ SomeException => MonadCatch (Either e) where
+  catch (Left e) f =
+    case fromException e of
+      Nothing -> Left e
+      Just e' -> f e'
+  catch x@(Right _) _ = x
+-- | @since 0.8.3
+instance e ~ SomeException => MonadMask (Either e) where
+  mask f = f id
+  uninterruptibleMask f = f id
+
+  generalBracket acquire release use =
+    case acquire of
+      Left e -> Left e
+      Right resource ->
+        case use resource of
+          Left e -> release resource (ExitCaseException e) >> Left e
+          Right b -> do
+            c <- release resource (ExitCaseSuccess b)
+            return (b, c)
+
+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
+
+  generalBracket acquire release use = IdentityT $
+    generalBracket
+      (runIdentityT acquire)
+      (\resource exitCase -> runIdentityT (release resource exitCase))
+      (\resource -> runIdentityT (use resource))
+
+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)
+
+  generalBracket acquire release use = LazyS.StateT $ \s0 -> do
+    -- This implementation is given as an example in the documentation of
+    -- 'generalBracket', so when changing it, remember to update the
+    -- documentation's copy as well
+    ((b, _s2), (c, s3)) <- generalBracket
+      (LazyS.runStateT acquire s0)
+      (\(resource, s1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, s2) -> LazyS.runStateT (release resource (ExitCaseSuccess b)) s2
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @s1@.
+        ExitCaseException e     -> LazyS.runStateT (release resource (ExitCaseException e)) s1
+        ExitCaseAbort           -> LazyS.runStateT (release resource ExitCaseAbort) s1)
+      (\(resource, s1) -> LazyS.runStateT (use resource) s1)
+    return ((b, c), s3)
+
+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)
+
+  generalBracket acquire release use = StrictS.StateT $ \s0 -> do
+    ((b, _s2), (c, s3)) <- generalBracket
+      (StrictS.runStateT acquire s0)
+      (\(resource, s1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, s2) -> StrictS.runStateT (release resource (ExitCaseSuccess b)) s2
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @s1@.
+        ExitCaseException e     -> StrictS.runStateT (release resource (ExitCaseException e)) s1
+        ExitCaseAbort           -> StrictS.runStateT (release resource ExitCaseAbort) s1)
+      (\(resource, s1) -> StrictS.runStateT (use resource) s1)
+    return ((b, c), s3)
+
+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)
+
+  generalBracket acquire release use = ReaderT $ \r ->
+    generalBracket
+      (runReaderT acquire r)
+      (\resource exitCase -> runReaderT (release resource exitCase) r)
+      (\resource -> runReaderT (use resource) r)
+
+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)
+
+  generalBracket acquire release use = StrictW.WriterT $ do
+    ((b, _w12), (c, w123)) <- generalBracket
+      (StrictW.runWriterT acquire)
+      (\(resource, w1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, w12) -> do
+          (c, w3) <- StrictW.runWriterT (release resource (ExitCaseSuccess b))
+          return (c, mappend w12 w3)
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @w1@.
+        ExitCaseException e -> do
+          (c, w3) <- StrictW.runWriterT (release resource (ExitCaseException e))
+          return (c, mappend w1 w3)
+        ExitCaseAbort -> do
+          (c, w3) <- StrictW.runWriterT (release resource ExitCaseAbort)
+          return (c, mappend w1 w3))
+      (\(resource, w1) -> do
+        (a, w2) <- StrictW.runWriterT (use resource)
+        return (a, mappend w1 w2))
+    return ((b, c), w123)
+
+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)
+
+  generalBracket acquire release use = LazyW.WriterT $ do
+    ((b, _w12), (c, w123)) <- generalBracket
+      (LazyW.runWriterT acquire)
+      (\(resource, w1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, w12) -> do
+          (c, w3) <- LazyW.runWriterT (release resource (ExitCaseSuccess b))
+          return (c, mappend w12 w3)
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @w1@.
+        ExitCaseException e -> do
+          (c, w3) <- LazyW.runWriterT (release resource (ExitCaseException e))
+          return (c, mappend w1 w3)
+        ExitCaseAbort -> do
+          (c, w3) <- LazyW.runWriterT (release resource ExitCaseAbort)
+          return (c, mappend w1 w3))
+      (\(resource, w1) -> do
+        (a, w2) <- LazyW.runWriterT (use resource)
+        return (a, mappend w1 w2))
+    return ((b, c), w123)
+
+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)
+
+  generalBracket acquire release use = LazyRWS.RWST $ \r s0 -> do
+    ((b, _s2, _w12), (c, s3, w123)) <- generalBracket
+      (LazyRWS.runRWST acquire r s0)
+      (\(resource, s1, w1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, s2, w12) -> do
+          (c, s3, w3) <- LazyRWS.runRWST (release resource (ExitCaseSuccess b)) r s2
+          return (c, s3, mappend w12 w3)
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @s1@ and @w1@.
+        ExitCaseException e -> do
+          (c, s3, w3) <- LazyRWS.runRWST (release resource (ExitCaseException e)) r s1
+          return (c, s3, mappend w1 w3)
+        ExitCaseAbort -> do
+          (c, s3, w3) <- LazyRWS.runRWST (release resource ExitCaseAbort) r s1
+          return (c, s3, mappend w1 w3))
+      (\(resource, s1, w1) -> do
+        (a, s2, w2) <- LazyRWS.runRWST (use resource) r s1
+        return (a, s2, mappend w1 w2))
+    return ((b, c), s3, w123)
+
+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)
+
+  generalBracket acquire release use = StrictRWS.RWST $ \r s0 -> do
+    ((b, _s2, _w12), (c, s3, w123)) <- generalBracket
+      (StrictRWS.runRWST acquire r s0)
+      (\(resource, s1, w1) exitCase -> case exitCase of
+        ExitCaseSuccess (b, s2, w12) -> do
+          (c, s3, w3) <- StrictRWS.runRWST (release resource (ExitCaseSuccess b)) r s2
+          return (c, s3, mappend w12 w3)
+        -- In the two other cases, the base monad overrides @use@'s state
+        -- changes and the state reverts to @s1@ and @w1@.
+        ExitCaseException e -> do
+          (c, s3, w3) <- StrictRWS.runRWST (release resource (ExitCaseException e)) r s1
+          return (c, s3, mappend w1 w3)
+        ExitCaseAbort -> do
+          (c, s3, w3) <- StrictRWS.runRWST (release resource ExitCaseAbort) r s1
+          return (c, s3, mappend w1 w3))
+      (\(resource, s1, w1) -> do
+        (a, s2, w2) <- StrictRWS.runRWST (use resource) r s1
+        return (a, s2, mappend w1 w2))
+    return ((b, c), s3, w123)
+
+-- | 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)
+-- | @since 0.10.0
+instance MonadMask m => MonadMask (MaybeT m) where
+  mask f = MaybeT $ mask $ \u -> runMaybeT $ f (q u)
+    where
+      q :: (m (Maybe a) -> m (Maybe a))
+        -> MaybeT m a -> MaybeT m a
+      q u (MaybeT b) = MaybeT (u b)
+  uninterruptibleMask f = MaybeT $ uninterruptibleMask $ \u -> runMaybeT $ f (q u)
+    where
+      q :: (m (Maybe a) -> m (Maybe a))
+        -> MaybeT m a -> MaybeT m a
+      q u (MaybeT b) = MaybeT (u b)
+
+  generalBracket acquire release use = MaybeT $ do
+    (eb, ec) <- generalBracket
+      (runMaybeT acquire)
+      (\resourceMay exitCase -> case resourceMay of
+        Nothing -> return Nothing -- nothing to release, acquire didn't succeed
+        Just resource -> case exitCase of
+          ExitCaseSuccess (Just b) -> runMaybeT (release resource (ExitCaseSuccess b))
+          ExitCaseException e      -> runMaybeT (release resource (ExitCaseException e))
+          _                        -> runMaybeT (release resource ExitCaseAbort))
+      (\resourceMay -> case resourceMay of
+        Nothing -> return Nothing
+        Just resource -> runMaybeT (use resource))
+    -- The order in which we perform those two 'Maybe' effects doesn't matter,
+    -- since the error message is the same regardless.
+    return ((,) <$> eb <*> ec)
+
+-- | 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)
+-- | @since 0.9.0
+instance MonadMask m => MonadMask (ExceptT e m) where
+  mask f = ExceptT $ mask $ \u -> runExceptT $ f (q u)
+    where
+      q :: (m (Either e a) -> m (Either e a))
+        -> ExceptT e m a -> ExceptT e m a
+      q u (ExceptT b) = ExceptT (u b)
+  uninterruptibleMask f = ExceptT $ uninterruptibleMask $ \u -> runExceptT $ f (q u)
+    where
+      q :: (m (Either e a) -> m (Either e a))
+        -> ExceptT e m a -> ExceptT e m a
+      q u (ExceptT b) = ExceptT (u b)
+
+  generalBracket acquire release use = ExceptT $ do
+    -- This implementation is given as an example in the documentation of
+    -- 'generalBracket', so when changing it, remember to update the
+    -- documentation's copy as well
+    (eb, ec) <- generalBracket
+      (runExceptT acquire)
+      (\eresource exitCase -> case eresource of
+        Left e -> return (Left e) -- nothing to release, acquire didn't succeed
+        Right resource -> case exitCase of
+          ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))
+          ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))
+          _                         -> runExceptT (release resource ExitCaseAbort))
+      (either (return . Left) (runExceptT . use))
+    return $ do
+      -- The order in which we perform those two 'Either' effects determines
+      -- which error will win if they are both 'Left's. We want the error from
+      -- 'release' to win.
+      c <- ec
+      b <- eb
+      return (b, c)
+
+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
+
+#if !(MIN_VERSION_transformers(0,6,0))
+-- | 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)
+instance (Error e, MonadMask m) => MonadMask (ErrorT e m) where
+  mask f = ErrorT $ mask $ \u -> runErrorT $ f (q u)
+    where
+      q :: (m (Either e a) -> m (Either e a))
+        -> ErrorT e m a -> ErrorT e m a
+      q u (ErrorT b) = ErrorT (u b)
+  uninterruptibleMask f = ErrorT $ uninterruptibleMask $ \u -> runErrorT $ f (q u)
+    where
+      q :: (m (Either e a) -> m (Either e a))
+        -> ErrorT e m a -> ErrorT e m a
+      q u (ErrorT b) = ErrorT (u b)
+
+  generalBracket acquire release use = ErrorT $ do
+    (eb, ec) <- generalBracket
+      (runErrorT acquire)
+      (\eresource exitCase -> case eresource of
+        Left e -> return (Left e) -- nothing to release, acquire didn't succeed
+        Right resource -> case exitCase of
+          ExitCaseSuccess (Right b) -> runErrorT (release resource (ExitCaseSuccess b))
+          ExitCaseException e       -> runErrorT (release resource (ExitCaseException e))
+          _                         -> runErrorT (release resource ExitCaseAbort))
+      (either (return . Left) (runErrorT . use))
+    return $ do
+      -- The order in which we perform those two 'Either' effects determines
+      -- which error will win if they are both 'Left's. We want the error from
+      -- 'release' to win.
+      c <- ec
+      b <- eb
+      return (b, c)
+
+-- 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)
+#endif
+
+------------------------------------------------------------------------------
+-- $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_ :: (HasCallStack, MonadMask m) => m a -> m a
+mask_ io = withFrozenCallStack (\f -> mask (\x -> f x)) (\_ -> io)
+
+-- | Like 'uninterruptibleMask', but does not pass a @restore@ action to the
+-- argument.
+uninterruptibleMask_ :: (HasCallStack, MonadMask m) => m a -> m a
+uninterruptibleMask_ io = withFrozenCallStack (\f -> uninterruptibleMask (\x -> f x)) (\_ -> io)
+
+-- | Catches all exceptions, and somewhat defeats the purpose of the extensible
+-- exception system. Use sparingly.
+--
+-- /NOTE/ This catches all /exceptions/, but if the monad supports other ways of
+-- aborting the computation, those other kinds of errors will not be caught.
+catchAll :: (HasCallStack, MonadCatch m) => m a -> (SomeException -> m a) -> m a
+catchAll = withFrozenCallStack 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 :: (HasCallStack, MonadCatch m) => m a -> (IOError -> m a) -> m a
+catchIOError = withFrozenCallStack catch
+
+-- | Catch exceptions only if they pass some predicate. Often useful with the
+-- predicates for testing 'IOError' values in "System.IO.Error".
+catchIf :: (HasCallStack, MonadCatch m, Exception e) =>
+    (e -> Bool) -> m a -> (e -> m a) -> m a
+catchIf f a b = withFrozenCallStack catch a (\e -> if f e then b e else throwM e)
+
+-- | A more generalized way of determining which exceptions to catch at
+-- run time.
+catchJust :: (HasCallStack, MonadCatch m, Exception e) =>
+    (e -> Maybe b) -> m a -> (b -> m a) -> m a
+catchJust f a b = withFrozenCallStack catch a (\e -> maybe (throwM e) b $ f e)
+
+-- | Flipped 'catch'. See "Control.Exception"'s 'ControlException.handle'.
+handle :: (HasCallStack, MonadCatch m, Exception e) => (e -> m a) -> m a -> m a
+handle = flip (withFrozenCallStack catch)
+{-# INLINE handle #-}
+
+-- | Flipped 'catchIOError'
+handleIOError :: (HasCallStack, MonadCatch m) => (IOError -> m a) -> m a -> m a
+handleIOError = withFrozenCallStack handle
+
+-- | Flipped 'catchAll'
+handleAll :: (HasCallStack, MonadCatch m) => (SomeException -> m a) -> m a -> m a
+handleAll = withFrozenCallStack handle
+
+-- | Flipped 'catchIf'
+handleIf :: (HasCallStack, MonadCatch m, Exception e) => (e -> Bool) -> (e -> m a) -> m a -> m a
+handleIf f = flip (withFrozenCallStack catchIf f)
+
+-- | Flipped 'catchJust'. See "Control.Exception"'s 'ControlException.handleJust'.
+handleJust :: (HasCallStack, MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a
+handleJust f = flip (withFrozenCallStack catchJust f)
+{-# INLINE handleJust #-}
+
+-- | Similar to 'catch', but returns an 'Either' result. See "Control.Exception"'s
+-- 'Control.Exception.try'.
+try :: (HasCallStack, MonadCatch m, Exception e) => m a -> m (Either e a)
+try a = withFrozenCallStack 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 :: (HasCallStack, MonadCatch m, Exception e) =>
+    (e -> Maybe b) -> m a -> m (Either b a)
+tryJust f a = withFrozenCallStack 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 :: (HasCallStack, Foldable f, MonadCatch m) => m a -> f (Handler m a) -> m a
+catches a hs = withFrozenCallStack catch a 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.
+--
+-- /NOTE/ The action is only run if an /exception/ is thrown. If the monad
+-- supports other ways of aborting the computation, the action won't run if
+-- those other kinds of errors are thrown. See 'onError'.
+onException :: (HasCallStack, MonadCatch m) => m a -> m b -> m a
+onException action handler = withFrozenCallStack catchAll action (\e -> handler >> throwM e)
+
+-- | Run an action only if an error is thrown in the main action. Unlike
+-- 'onException', this works with every kind of error, not just exceptions. For
+-- example, if @f@ is an 'ExceptT' computation which aborts with a 'Left', the
+-- computation @onError f g@ will execute @g@, while @onException f g@ will not.
+--
+-- This distinction is only meaningful for monads which have multiple exit
+-- points, such as 'Except' and 'MaybeT'. For monads that only have a single
+-- exit point, there is no difference between 'onException' and 'onError',
+-- except that 'onError' has a more constrained type.
+--
+-- @since 0.10.0
+onError :: (HasCallStack, MonadMask m) => m a -> m b -> m a
+onError action handler = withFrozenCallStack bracketOnError (return ()) (const handler) (const action)
+
+-- | Generalized abstracted pattern of safe resource acquisition and release
+-- in the face of errors. 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 error is thrown during the use, the release still happens before the
+-- error is rethrown.
+--
+-- Note that this is essentially a type-specialized version of
+-- 'generalBracket'. This function has a more common signature (matching the
+-- signature from "Control.Exception"), and is often more convenient to use. By
+-- contrast, 'generalBracket' is more expressive, allowing us to implement
+-- other functions like 'bracketOnError'.
+bracket :: (HasCallStack, MonadMask m) => m a -> (a -> m c) -> (a -> m b) -> m b
+bracket acquire release = liftM fst . withFrozenCallStack generalBracket
+  acquire
+  (\a _exitCase -> release a)
+
+-- | Version of 'bracket' without any value being passed to the second and
+-- third actions.
+bracket_ :: (HasCallStack, MonadMask m) => m a -> m c -> m b -> m b
+bracket_ before after action = withFrozenCallStack bracket before (const after) (const action)
+
+-- | Perform an action with a finalizer action that is run, even if an
+-- error occurs.
+finally :: (HasCallStack, MonadMask m) => m a -> m b -> m a
+finally action finalizer = withFrozenCallStack bracket_ (return ()) finalizer action
+
+-- | Like 'bracket', but only performs the final action if an error is
+-- thrown by the in-between computation.
+bracketOnError :: (HasCallStack, MonadMask m) => m a -> (a -> m c) -> (a -> m b) -> m b
+bracketOnError acquire release = liftM fst . withFrozenCallStack generalBracket
+  acquire
+  (\a exitCase -> case exitCase of
+    ExitCaseSuccess _ -> return ()
+    _ -> do
+      _ <- release a
+      return ())

@@ -1,225 +1,225 @@-{-# 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 <ekmett@gmail.com>--- 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 qualified Control.Monad.Fail as Fail-import Control.Monad.Fix (MonadFix(..))-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (MonadPlus(..), ap, liftM)-import Control.Monad.Reader (MonadReader(..))-import Control.Monad.RWS (MonadRWS)-import Control.Monad.State (MonadState(..))-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.Writer (MonadWriter(..))-#if __GLASGOW_HASKELL__ < 710-import Data.Foldable-import Data.Monoid (Monoid(..))-#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 = pure-  CatchT m >>= k = CatchT $ m >>= \ea -> case ea of-    Left e -> return (Left e)-    Right a -> runCatchT (k a)-#if !(MIN_VERSION_base(4,13,0))-  fail = Fail.fail-#endif--instance Monad m => Fail.MonadFail (CatchT m) where-  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!------ For example, @IO@ or @Either@ would be invalid base monads, but--- @Reader@ or @State@ would be acceptable.-instance Monad m => MonadMask (CatchT m) where-  mask a = a id-  uninterruptibleMask a = a id-  generalBracket acquire release use = CatchT $ do-    eresource <- runCatchT acquire-    case eresource of-      Left e -> return $ Left e-      Right resource -> do-        eb <- runCatchT (use resource)-        case eb of-          Left e -> runCatchT $ do-            _ <- release resource (ExitCaseException e)-            throwM e-          Right b -> runCatchT $ do-            c <- release resource (ExitCaseSuccess b)-            return (b, c)--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)+{-# 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 <ekmett@gmail.com>
+-- 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 qualified Control.Monad.Fail as Fail
+import Control.Monad.Fix (MonadFix(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad (MonadPlus(..), ap, liftM)
+import Control.Monad.Reader (MonadReader(..))
+import Control.Monad.RWS (MonadRWS)
+import Control.Monad.State (MonadState(..))
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Writer (MonadWriter(..))
+#if __GLASGOW_HASKELL__ < 710
+import Data.Foldable
+import Data.Monoid (Monoid(..))
+#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 = pure
+  CatchT m >>= k = CatchT $ m >>= \ea -> case ea of
+    Left e -> return (Left e)
+    Right a -> runCatchT (k a)
+#if !(MIN_VERSION_base(4,13,0))
+  fail = Fail.fail
+#endif
+
+instance Monad m => Fail.MonadFail (CatchT m) where
+  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!
+--
+-- For example, @IO@ or @Either@ would be invalid base monads, but
+-- @Reader@ or @State@ would be acceptable.
+instance Monad m => MonadMask (CatchT m) where
+  mask a = a id
+  uninterruptibleMask a = a id
+  generalBracket acquire release use = CatchT $ do
+    eresource <- runCatchT acquire
+    case eresource of
+      Left e -> return $ Left e
+      Right resource -> do
+        eb <- runCatchT (use resource)
+        case eb of
+          Left e -> runCatchT $ do
+            _ <- release resource (ExitCaseException e)
+            throwM e
+          Right b -> runCatchT $ do
+            c <- release resource (ExitCaseSuccess b)
+            return (b, c)
+
+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)

@@ -1,258 +1,258 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE CPP #-}--#if !(MIN_VERSION_transformers(0,6,0))-{-# OPTIONS_GHC -fno-warn-deprecations #-}-#endif--module Control.Monad.Catch.Tests (tests) where--#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)-import Prelude hiding (catch)-#endif--#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative ((<*>))-#endif-import Control.Monad (unless)-import Data.Data (Data, Typeable)-import Data.IORef (newIORef, writeIORef, readIORef)--import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Identity (IdentityT(..))-import Control.Monad.Reader (ReaderT(..))-import Control.Monad.Trans.Maybe (MaybeT(..))-import Control.Monad.Trans.Except (ExceptT(..), runExceptT)-import Control.Monad.STM (STM, atomically)---import Control.Monad.Cont (ContT(..))-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit (testCase)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Property, ioProperty, once)-import Test.QuickCheck.Monadic (monadic, run, assert)-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-#if !(MIN_VERSION_transformers(0,6,0))-import Control.Monad.Error (ErrorT(..))-import Control.Monad.List (ListT(..))-#endif--import Control.Monad.Catch-import Control.Monad.Catch.Pure--data TestException = TestException String-    deriving (Show, Eq, Data, Typeable)--instance Exception TestException--data MSpec m = MSpec-    { mspecName :: String-    , mspecRunner :: (m Property -> Property)-    }---- the @m Bool@ determines whether the @m ()@ has executed-data DetectableEffect m = DetectableEffect-    { detectableEffectMSpec :: MSpec m-    , detectableEffectEffectDetector :: m (m (), m Bool)-    }--data SomeMSpec = forall m. (MonadCatch m) => SomeMSpec (MSpec m)--data SomeDetectableEffect = forall m. (MonadMask m) => SomeDetectableEffect (DetectableEffect m)--testMonadCatch :: SomeMSpec -> Property-testMonadCatch (SomeMSpec MSpec { mspecRunner }) = monadic mspecRunner $-    run $ catch failure handler-  where-    failure = throwM (TestException "foo") >> error "testMonadCatch"-    handler (_ :: TestException) = return ()--testCatchJust :: SomeMSpec -> Property-testCatchJust (SomeMSpec 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"--testDetectableEffect :: SomeDetectableEffect -> Property-testDetectableEffect (SomeDetectableEffect (DetectableEffect mspec effectDetector)) = do-    monadic (mspecRunner mspec) $ do-        effectWasPerformed <- run $ do-          (effect, detector) <- effectDetector-          _ <- runExceptT $ ExceptT (return $ Left ()) `finally` lift effect-          detector-        assert effectWasPerformed--tests :: Test-tests = testGroup "Control.Monad.Catch.Tests" $-   ([ mkMonadCatch-    , mkCatchJust-    ] <*> mspecs) ++-   ([ mkDetectableEffect-    ] <*> detectableEffects) ++-    [ testCase "ExceptT+Left" exceptTLeft-    , testCase "release error wins" releaseErrorWins-    ]-  where-    mspecs =-        [ SomeMSpec mspecIO-        , SomeMSpec mspecIdentityTIO-        , SomeMSpec mspecLazyStateTIO-        , SomeMSpec mspecStrictStateTIO-        , SomeMSpec mspecReaderTIO-        , SomeMSpec mspecLazyWriterTIO-        , SomeMSpec mspecStrictWriterTIO-        , SomeMSpec mspecLazyRWSTIO-        , SomeMSpec mspecStrictRWSTIO--        , SomeMSpec mspecMaybeTIO-#if !(MIN_VERSION_transformers(0,6,0))-        , SomeMSpec mspecErrorTIO-        , SomeMSpec mspecListTIO-#endif-        , SomeMSpec mspecSTM-        --, SomeMSpec mspecContTIO--        , SomeMSpec mspecCatchTIdentity-        , SomeMSpec mspecEitherSomeException-        ]--    mspecIO :: MSpec IO-    mspecIO = MSpec "IO" io--    mspecIdentityTIO :: MSpec (IdentityT IO)-    mspecIdentityTIO = MSpec "IdentityT IO" $ io . runIdentityT--    mspecLazyStateTIO :: MSpec (LazyState.StateT Bool IO)-    mspecLazyStateTIO = MSpec "LazyState.StateT IO" $ io . flip LazyState.evalStateT False--    mspecStrictStateTIO :: MSpec (StrictState.StateT Bool IO)-    mspecStrictStateTIO = MSpec "StrictState.StateT IO" $ io . flip StrictState.evalStateT False--    mspecReaderTIO :: MSpec (ReaderT () IO)-    mspecReaderTIO = MSpec "ReaderT IO" $ io . flip runReaderT ()--    mspecLazyWriterTIO :: MSpec (LazyWriter.WriterT () IO)-    mspecLazyWriterTIO = MSpec "LazyWriter.WriterT IO" $ io . fmap tfst . LazyWriter.runWriterT--    mspecStrictWriterTIO :: MSpec (StrictWriter.WriterT () IO)-    mspecStrictWriterTIO = MSpec "StrictWriter.WriterT IO" $ io . fmap tfst . StrictWriter.runWriterT--    mspecLazyRWSTIO :: MSpec (LazyRWS.RWST () () Bool IO)-    mspecLazyRWSTIO = MSpec "LazyRWS.RWST IO" $ \m -> io $ fmap tfst $ LazyRWS.evalRWST m () False--    mspecStrictRWSTIO :: MSpec (StrictRWS.RWST () () Bool IO)-    mspecStrictRWSTIO = MSpec "StrictRWS.RWST IO" $ \m -> io $ fmap tfst $ StrictRWS.evalRWST m () False--    mspecMaybeTIO :: MSpec (MaybeT IO)-    mspecMaybeTIO = MSpec "MaybeT IO" $ \m -> io $ fmap (maybe undefined id) (runMaybeT m)--#if !(MIN_VERSION_transformers(0,6,0))-    mspecErrorTIO :: MSpec (ErrorT String IO)-    mspecErrorTIO = MSpec "ErrorT IO" $ \m -> io $ fmap (either error id) (runErrorT m)--    mspecListTIO :: MSpec (ListT IO)-    mspecListTIO = MSpec "ListT IO" $ \m -> io $ fmap (foldr const undefined) (runListT m)-#endif--    mspecSTM :: MSpec STM-    mspecSTM = MSpec "STM" $ io . atomically--    --mspecContTIO :: MSpec (ContT () IO)-    --mspecContTIO = MSpec "ContT IO" $ \m -> io $ runContT m return--    mspecCatchTIdentity :: MSpec Catch-    mspecCatchTIdentity = MSpec "Catch" $ fromRight . runCatch--    mspecEitherSomeException :: MSpec (Either SomeException)-    mspecEitherSomeException = MSpec "Either SomeException" fromRight--    tfst :: (Property, ()) -> Property = fst-    fromRight (Left _) = error "fromRight"-    fromRight (Right a) = a-    io = ioProperty--    detectableEffects =-        [ SomeDetectableEffect $ detectableEffectIO-        , SomeDetectableEffect detectableEffectLazyStateTIO-        , SomeDetectableEffect detectableEffectStrictStateTIO-        , SomeDetectableEffect detectableEffectLazyRWSTIO-        , SomeDetectableEffect detectableEffectStrictRWSTIO-        ]--    detectableEffectIO :: DetectableEffect IO-    detectableEffectIO = DetectableEffect-      { detectableEffectMSpec = mspecIO-      , detectableEffectEffectDetector = do-          ref <- newIORef False-          return (writeIORef ref True, readIORef ref)-      }--    detectableEffectLazyStateTIO :: DetectableEffect (LazyState.StateT Bool IO)-    detectableEffectLazyStateTIO = DetectableEffect-      { detectableEffectMSpec = mspecLazyStateTIO-      , detectableEffectEffectDetector = do-          LazyState.put False-          return (LazyState.put True, LazyState.get)-      }--    detectableEffectStrictStateTIO :: DetectableEffect (StrictState.StateT Bool IO)-    detectableEffectStrictStateTIO = DetectableEffect-      { detectableEffectMSpec = mspecStrictStateTIO-      , detectableEffectEffectDetector = do-          StrictState.put False-          return (StrictState.put True, StrictState.get)-      }--    detectableEffectLazyRWSTIO :: DetectableEffect (LazyRWS.RWST () () Bool IO)-    detectableEffectLazyRWSTIO = DetectableEffect-      { detectableEffectMSpec = mspecLazyRWSTIO-      , detectableEffectEffectDetector = do-          LazyRWS.put False-          return (LazyRWS.put True, LazyRWS.get)-      }--    detectableEffectStrictRWSTIO :: DetectableEffect (StrictRWS.RWST () () Bool IO)-    detectableEffectStrictRWSTIO = DetectableEffect-      { detectableEffectMSpec = mspecStrictRWSTIO-      , detectableEffectEffectDetector = do-          StrictRWS.put False-          return (StrictRWS.put True, StrictRWS.get)-      }--    mkMonadCatch = mkMSpecTest "MonadCatch" testMonadCatch-    mkCatchJust = mkMSpecTest "catchJust" testCatchJust-    mkDetectableEffect = mkDetectableEffectTest "effect during release" testDetectableEffect--    mkMSpecTest :: String -> (SomeMSpec -> Property) -> SomeMSpec -> Test-    mkMSpecTest name test = \someMSpec@(SomeMSpec spec) ->-        testProperty (name ++ " " ++ mspecName spec) $ once $ test someMSpec--    mkDetectableEffectTest :: String -> (SomeDetectableEffect -> Property) -> SomeDetectableEffect -> Test-    mkDetectableEffectTest name test = \someDetectableEffect@(SomeDetectableEffect detectableEffect) ->-        let testName = name ++ " " ++ mspecName (detectableEffectMSpec detectableEffect)-        in testProperty testName $ once $ test someDetectableEffect--    exceptTLeft = do-      ref <- newIORef False-      Left () <- runExceptT $ ExceptT (return $ Left ()) `finally` lift (writeIORef ref True)-      val <- readIORef ref-      unless val $ error "Looks like cleanup didn't happen"--    -- if both 'use' and 'release' abort, the 'release' error should win-    releaseErrorWins = do-      Left val <- runExceptT $ ExceptT (return $ Left False) `finally` ExceptT (return $ Left True)-      unless val $ error "Looks like the 'use' error won"+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP #-}
+
+#if !(MIN_VERSION_transformers(0,6,0))
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+#endif
+
+module Control.Monad.Catch.Tests (tests) where
+
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
+import Prelude hiding (catch)
+#endif
+
+#if !(MIN_VERSION_base(4,8,0))
+import Control.Applicative ((<*>))
+#endif
+import Control.Monad (unless)
+import Data.Data (Data, Typeable)
+import Data.IORef (newIORef, writeIORef, readIORef)
+
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Identity (IdentityT(..))
+import Control.Monad.Reader (ReaderT(..))
+import Control.Monad.Trans.Maybe (MaybeT(..))
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
+import Control.Monad.STM (STM, atomically)
+--import Control.Monad.Cont (ContT(..))
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck (Property, ioProperty, once)
+import Test.QuickCheck.Monadic (monadic, run, assert)
+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
+#if !(MIN_VERSION_transformers(0,6,0))
+import Control.Monad.Error (ErrorT(..))
+import Control.Monad.List (ListT(..))
+#endif
+
+import Control.Monad.Catch
+import Control.Monad.Catch.Pure
+
+data TestException = TestException String
+    deriving (Show, Eq, Data, Typeable)
+
+instance Exception TestException
+
+data MSpec m = MSpec
+    { mspecName :: String
+    , mspecRunner :: (m Property -> Property)
+    }
+
+-- the @m Bool@ determines whether the @m ()@ has executed
+data DetectableEffect m = DetectableEffect
+    { detectableEffectMSpec :: MSpec m
+    , detectableEffectEffectDetector :: m (m (), m Bool)
+    }
+
+data SomeMSpec = forall m. (MonadCatch m) => SomeMSpec (MSpec m)
+
+data SomeDetectableEffect = forall m. (MonadMask m) => SomeDetectableEffect (DetectableEffect m)
+
+testMonadCatch :: SomeMSpec -> Property
+testMonadCatch (SomeMSpec MSpec { mspecRunner }) = monadic mspecRunner $
+    run $ catch failure handler
+  where
+    failure = throwM (TestException "foo") >> error "testMonadCatch"
+    handler (_ :: TestException) = return ()
+
+testCatchJust :: SomeMSpec -> Property
+testCatchJust (SomeMSpec 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"
+
+testDetectableEffect :: SomeDetectableEffect -> Property
+testDetectableEffect (SomeDetectableEffect (DetectableEffect mspec effectDetector)) = do
+    monadic (mspecRunner mspec) $ do
+        effectWasPerformed <- run $ do
+          (effect, detector) <- effectDetector
+          _ <- runExceptT $ ExceptT (return $ Left ()) `finally` lift effect
+          detector
+        assert effectWasPerformed
+
+tests :: Test
+tests = testGroup "Control.Monad.Catch.Tests" $
+   ([ mkMonadCatch
+    , mkCatchJust
+    ] <*> mspecs) ++
+   ([ mkDetectableEffect
+    ] <*> detectableEffects) ++
+    [ testCase "ExceptT+Left" exceptTLeft
+    , testCase "release error wins" releaseErrorWins
+    ]
+  where
+    mspecs =
+        [ SomeMSpec mspecIO
+        , SomeMSpec mspecIdentityTIO
+        , SomeMSpec mspecLazyStateTIO
+        , SomeMSpec mspecStrictStateTIO
+        , SomeMSpec mspecReaderTIO
+        , SomeMSpec mspecLazyWriterTIO
+        , SomeMSpec mspecStrictWriterTIO
+        , SomeMSpec mspecLazyRWSTIO
+        , SomeMSpec mspecStrictRWSTIO
+
+        , SomeMSpec mspecMaybeTIO
+#if !(MIN_VERSION_transformers(0,6,0))
+        , SomeMSpec mspecErrorTIO
+        , SomeMSpec mspecListTIO
+#endif
+        , SomeMSpec mspecSTM
+        --, SomeMSpec mspecContTIO
+
+        , SomeMSpec mspecCatchTIdentity
+        , SomeMSpec mspecEitherSomeException
+        ]
+
+    mspecIO :: MSpec IO
+    mspecIO = MSpec "IO" io
+
+    mspecIdentityTIO :: MSpec (IdentityT IO)
+    mspecIdentityTIO = MSpec "IdentityT IO" $ io . runIdentityT
+
+    mspecLazyStateTIO :: MSpec (LazyState.StateT Bool IO)
+    mspecLazyStateTIO = MSpec "LazyState.StateT IO" $ io . flip LazyState.evalStateT False
+
+    mspecStrictStateTIO :: MSpec (StrictState.StateT Bool IO)
+    mspecStrictStateTIO = MSpec "StrictState.StateT IO" $ io . flip StrictState.evalStateT False
+
+    mspecReaderTIO :: MSpec (ReaderT () IO)
+    mspecReaderTIO = MSpec "ReaderT IO" $ io . flip runReaderT ()
+
+    mspecLazyWriterTIO :: MSpec (LazyWriter.WriterT () IO)
+    mspecLazyWriterTIO = MSpec "LazyWriter.WriterT IO" $ io . fmap tfst . LazyWriter.runWriterT
+
+    mspecStrictWriterTIO :: MSpec (StrictWriter.WriterT () IO)
+    mspecStrictWriterTIO = MSpec "StrictWriter.WriterT IO" $ io . fmap tfst . StrictWriter.runWriterT
+
+    mspecLazyRWSTIO :: MSpec (LazyRWS.RWST () () Bool IO)
+    mspecLazyRWSTIO = MSpec "LazyRWS.RWST IO" $ \m -> io $ fmap tfst $ LazyRWS.evalRWST m () False
+
+    mspecStrictRWSTIO :: MSpec (StrictRWS.RWST () () Bool IO)
+    mspecStrictRWSTIO = MSpec "StrictRWS.RWST IO" $ \m -> io $ fmap tfst $ StrictRWS.evalRWST m () False
+
+    mspecMaybeTIO :: MSpec (MaybeT IO)
+    mspecMaybeTIO = MSpec "MaybeT IO" $ \m -> io $ fmap (maybe undefined id) (runMaybeT m)
+
+#if !(MIN_VERSION_transformers(0,6,0))
+    mspecErrorTIO :: MSpec (ErrorT String IO)
+    mspecErrorTIO = MSpec "ErrorT IO" $ \m -> io $ fmap (either error id) (runErrorT m)
+
+    mspecListTIO :: MSpec (ListT IO)
+    mspecListTIO = MSpec "ListT IO" $ \m -> io $ fmap (foldr const undefined) (runListT m)
+#endif
+
+    mspecSTM :: MSpec STM
+    mspecSTM = MSpec "STM" $ io . atomically
+
+    --mspecContTIO :: MSpec (ContT () IO)
+    --mspecContTIO = MSpec "ContT IO" $ \m -> io $ runContT m return
+
+    mspecCatchTIdentity :: MSpec Catch
+    mspecCatchTIdentity = MSpec "Catch" $ fromRight . runCatch
+
+    mspecEitherSomeException :: MSpec (Either SomeException)
+    mspecEitherSomeException = MSpec "Either SomeException" fromRight
+
+    tfst :: (Property, ()) -> Property = fst
+    fromRight (Left _) = error "fromRight"
+    fromRight (Right a) = a
+    io = ioProperty
+
+    detectableEffects =
+        [ SomeDetectableEffect $ detectableEffectIO
+        , SomeDetectableEffect detectableEffectLazyStateTIO
+        , SomeDetectableEffect detectableEffectStrictStateTIO
+        , SomeDetectableEffect detectableEffectLazyRWSTIO
+        , SomeDetectableEffect detectableEffectStrictRWSTIO
+        ]
+
+    detectableEffectIO :: DetectableEffect IO
+    detectableEffectIO = DetectableEffect
+      { detectableEffectMSpec = mspecIO
+      , detectableEffectEffectDetector = do
+          ref <- newIORef False
+          return (writeIORef ref True, readIORef ref)
+      }
+
+    detectableEffectLazyStateTIO :: DetectableEffect (LazyState.StateT Bool IO)
+    detectableEffectLazyStateTIO = DetectableEffect
+      { detectableEffectMSpec = mspecLazyStateTIO
+      , detectableEffectEffectDetector = do
+          LazyState.put False
+          return (LazyState.put True, LazyState.get)
+      }
+
+    detectableEffectStrictStateTIO :: DetectableEffect (StrictState.StateT Bool IO)
+    detectableEffectStrictStateTIO = DetectableEffect
+      { detectableEffectMSpec = mspecStrictStateTIO
+      , detectableEffectEffectDetector = do
+          StrictState.put False
+          return (StrictState.put True, StrictState.get)
+      }
+
+    detectableEffectLazyRWSTIO :: DetectableEffect (LazyRWS.RWST () () Bool IO)
+    detectableEffectLazyRWSTIO = DetectableEffect
+      { detectableEffectMSpec = mspecLazyRWSTIO
+      , detectableEffectEffectDetector = do
+          LazyRWS.put False
+          return (LazyRWS.put True, LazyRWS.get)
+      }
+
+    detectableEffectStrictRWSTIO :: DetectableEffect (StrictRWS.RWST () () Bool IO)
+    detectableEffectStrictRWSTIO = DetectableEffect
+      { detectableEffectMSpec = mspecStrictRWSTIO
+      , detectableEffectEffectDetector = do
+          StrictRWS.put False
+          return (StrictRWS.put True, StrictRWS.get)
+      }
+
+    mkMonadCatch = mkMSpecTest "MonadCatch" testMonadCatch
+    mkCatchJust = mkMSpecTest "catchJust" testCatchJust
+    mkDetectableEffect = mkDetectableEffectTest "effect during release" testDetectableEffect
+
+    mkMSpecTest :: String -> (SomeMSpec -> Property) -> SomeMSpec -> Test
+    mkMSpecTest name test = \someMSpec@(SomeMSpec spec) ->
+        testProperty (name ++ " " ++ mspecName spec) $ once $ test someMSpec
+
+    mkDetectableEffectTest :: String -> (SomeDetectableEffect -> Property) -> SomeDetectableEffect -> Test
+    mkDetectableEffectTest name test = \someDetectableEffect@(SomeDetectableEffect detectableEffect) ->
+        let testName = name ++ " " ++ mspecName (detectableEffectMSpec detectableEffect)
+        in testProperty testName $ once $ test someDetectableEffect
+
+    exceptTLeft = do
+      ref <- newIORef False
+      Left () <- runExceptT $ ExceptT (return $ Left ()) `finally` lift (writeIORef ref True)
+      val <- readIORef ref
+      unless val $ error "Looks like cleanup didn't happen"
+
+    -- if both 'use' and 'release' abort, the 'release' error should win
+    releaseErrorWins = do
+      Left val <- runExceptT $ ExceptT (return $ Left False) `finally` ExceptT (return $ Left True)
+      unless val $ error "Looks like the 'use' error won"

@@ -1,10 +1,10 @@-module Main where--import Test.Framework (defaultMain)--import qualified Control.Monad.Catch.Tests--main :: IO ()-main = defaultMain-    [ Control.Monad.Catch.Tests.tests-    ]+module Main where
+
+import Test.Framework (defaultMain)
+
+import qualified Control.Monad.Catch.Tests
+
+main :: IO ()
+main = defaultMain
+    [ Control.Monad.Catch.Tests.tests
+    ]