exception-transformers 0.2 → 0.4.0.12
raw patch · 4 files changed
Files
- Control/Monad/Exception.hs +248/−96
- LICENSE +24/−1
- exception-transformers.cabal +39/−14
- tests/unit/Main.hs +90/−0
Control/Monad/Exception.hs view
@@ -1,101 +1,167 @@--- Copyright (c) 2008-2010--- The President and Fellows of Harvard College.------ 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 University nor the names of its contributors--- may be used to endorse or promote products derived from this software--- without specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND--- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE--- ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY 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.+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} --------------------------------------------------------------------------------- -- | -- Module : Control.Monad.Exception--- Copyright : (c) Harvard University 2008-2010+-- Copyright : (c) Harvard University 2008-2011+-- (c) Geoffrey Mainland 2011-2021 -- License : BSD-style--- Maintainer : mainland@eecs.harvard.edu--------------------------------------------------------------------------------------{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples #-}+-- Maintainer : mainland@cs.drexel.edu module Control.Monad.Exception ( E.Exception(..), E.SomeException, MonadException(..),+ onException,+ MonadAsyncException(..),+ bracket,+ bracket_, ExceptionT(..), mapExceptionT, liftException ) where +#if !MIN_VERSION_base(4,6,0) import Prelude hiding (catch)+#endif /*!MIN_VERSION_base(4,6,0) */ +import Control.Applicative import qualified Control.Exception as E (Exception(..), SomeException,- block, catch, throw,- unblock)+ finally)+import qualified Control.Exception as E (mask) import Control.Monad (MonadPlus(..))+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail+#endif /* !MIN_VERSION_base(4,13,0) */+#if !MIN_VERSION_base(4,11,0)+import qualified Control.Monad.Fail as Fail+#endif /* !MIN_VERSION_base(4,11,0) */ import Control.Monad.Fix (MonadFix(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..))++#if !MIN_VERSION_transformers(0,6,0)+import Control.Monad.Trans.Error (Error(..),+ ErrorT(..),+ mapErrorT,+ runErrorT)+#endif /* !MIN_VERSION_transformers(0,6,0) */+import Control.Monad.Trans.Except (ExceptT(..),+ mapExceptT,+ runExceptT)+import Control.Monad.Trans.Identity (IdentityT(..),+ mapIdentityT,+ runIdentityT)+#if !MIN_VERSION_transformers(0,6,0)+import Control.Monad.Trans.List (ListT(..),+ mapListT,+ runListT)+#endif /* !MIN_VERSION_transformers(0,6,0) */+import Control.Monad.Trans.Maybe (MaybeT(..),+ mapMaybeT,+ runMaybeT) import Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..),+ mapRWST, runRWST) import Control.Monad.Trans.RWS.Strict as Strict (RWST(..),+ mapRWST, runRWST)-import Control.Monad.Trans.Reader (ReaderT(..))+import Control.Monad.Trans.Reader (ReaderT(..),+ mapReaderT) import Control.Monad.Trans.State.Lazy as Lazy (StateT(..),+ mapStateT, runStateT) import Control.Monad.Trans.State.Strict as Strict (StateT(..),+ mapStateT, runStateT) import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..),+ mapWriterT, runWriterT) import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..),+ mapWriterT, runWriterT)+#if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid)-import GHC.Base (RealWorld,- State#,- catchSTM#,- raiseIO#)-import GHC.Conc (STM(..))+#endif /* !MIN_VERSION_base(4,8,0) */+import GHC.Conc.Sync (STM(..),+ catchSTM,+ throwSTM) class (Monad m) => MonadException m where- -- |Throw an exception.+ -- | Throw an exception. throw :: E.Exception e => e -> m a- -- |Catch an exception.- catch :: E.Exception e => m a -> (e -> m a) -> m a+ -- | Catch an exception.+ catch :: E.Exception e+ => m a -- ^ The computation to run+ -> (e -> m a) -- ^ Handler to invoke if an exception is raised+ -> m a+ -- | Run a computation and always perform a second, final computation even+ -- if an exception is raised. If a short-circuiting monad transformer such+ -- as ErrorT or MaybeT is used to transform a MonadException monad, then the+ -- implementation of @finally@ for the transformed monad must guarantee that+ -- the final action is also always performed when any short-circuiting+ -- occurs.+ finally :: m a -- ^ The computation to run+ -> m b -- ^ Computation to run afterward (even if an exception was+ -- raised)+ -> m a+ act `finally` sequel = do+ a <- act `onException` sequel+ _ <- sequel+ return a +-- | If an exception is raised by the computation, then perform a final action+-- and re-raise the exception.+onException :: MonadException m+ => m a -- ^ The computation to run+ -> m b -- ^ Computation to run if an exception is raised+ -> m a+onException act what =+ act `catch` \(e :: E.SomeException) -> what >> throw e+ class (MonadIO m, MonadException m) => MonadAsyncException m where- -- |Applying 'block' to a computation will execute that computation with- -- asynchronous exceptions /blocked/.- block :: m a -> m a- -- |To re-enable asynchronous exceptions inside the scope of 'block',- -- 'unblock' can be used.- unblock :: m a -> m a+ -- | Executes a computation with asynchronous exceptions /masked/. The+ -- argument passed to 'mask' is a function that takes as its argument+ -- another function, which can be used to restore the prevailing masking+ -- state within the context of the masked computation.+ mask :: ((forall a. m a -> m a) -> m b) -> m b +-- | When you want to acquire a resource, do some work with it, and then release+-- the resource, it is a good idea to use 'bracket', because 'bracket' will+-- install the necessary exception handler to release the resource in the event+-- that an exception is raised during the computation. If an exception is+-- raised, then 'bracket' will re-raise the exception (after performing the+-- release).+bracket :: MonadAsyncException m+ => m a -- ^ computation to run first (\"acquire resource\")+ -> (a -> m b) -- ^ computation to run last (\"release resource\")+ -> (a -> m c) -- ^ computation to run in-between+ -> m c -- returns the value from the in-between computation+bracket before after thing =+ mask $ \restore -> do+ a <- before+ restore (thing a) `finally` after a++-- | A variant of 'bracket' where the return value from the first computation is+-- not required.+bracket_ :: MonadAsyncException m+ => m a+ -> m b+ -> m c+ -> m c+bracket_ before after thing =+ bracket before (const after) (const thing)+ -- -- The ExceptionT monad transformer. --@@ -106,9 +172,9 @@ mapExceptionT :: (m (Either E.SomeException a) -> n (Either E.SomeException b)) -> ExceptionT m a -> ExceptionT n b-mapExceptionT f m = ExceptionT $ f (runExceptionT m)+mapExceptionT f = ExceptionT . f . runExceptionT --- |Lift the result of running a computation in a monad transformed by+-- | Lift the result of running a computation in a monad transformed by -- 'ExceptionT' into another monad that supports exceptions. liftException :: MonadException m => Either E.SomeException a -> m a liftException (Left e) = throw e@@ -119,20 +185,40 @@ a <- m return (Right a) -instance (Monad m) => Functor (ExceptionT m) where- fmap f m = ExceptionT $ do- a <- runExceptionT m- case a of- Left l -> return (Left l)- Right r -> return (Right (f r))+instance (Functor m, Monad m) => Applicative (ExceptionT m) where+ pure a = ExceptionT $ return (Right a) + f <*> v = ExceptionT $ do+ mf <- runExceptionT f+ case mf of+ Left e -> return (Left e)+ Right k -> do+ mv <- runExceptionT v+ case mv of+ Left e -> return (Left e)+ Right x -> return (Right (k x))++instance (Functor m) => Functor (ExceptionT m) where+ fmap f = ExceptionT . fmap (fmap f) . runExceptionT+ instance (Monad m) => Monad (ExceptionT m) where+#if MIN_VERSION_base(4,8,0)+ return = pure+#else /* !MIN_VERSION_base(4,8,0) */ return a = ExceptionT $ return (Right a)- m >>= k = ExceptionT $ do+#endif /* !MIN_VERSION_base(4,8,0) */++ m >>= k = ExceptionT $ do a <- runExceptionT m case a of Left l -> return (Left l) Right r -> runExceptionT (k r)++#if !MIN_VERSION_base(4,11,0)+ fail = Fail.fail+#endif /* !MIN_VERSION_base(4,11,0) */++instance (Monad m) => MonadFail (ExceptionT m) where fail msg = ExceptionT $ return (Left (E.toException (userError msg))) instance (Monad m) => MonadPlus (ExceptionT m) where@@ -143,6 +229,10 @@ Left _ -> runExceptionT n Right r -> return (Right r) +instance (Functor m, Monad m) => Alternative (ExceptionT m) where+ empty = mzero+ (<|>) = mplus+ instance (MonadFix m) => MonadFix (ExceptionT m) where mfix f = ExceptionT $ mfix $ \a -> runExceptionT $ f $ case a of Right r -> r@@ -160,24 +250,32 @@ instance (MonadIO m) => MonadIO (ExceptionT m) where liftIO m = ExceptionT $ liftIO $- (m >>= return . Right)- `E.catch` \(e :: E.SomeException) -> return (Left e)+ fmap Right m `E.catch` \(e :: E.SomeException) -> return (Left e) instance (MonadAsyncException m) => MonadAsyncException (ExceptionT m) where- block = ExceptionT . block . runExceptionT- unblock = ExceptionT . unblock . runExceptionT+ mask act = ExceptionT $ mask $ \restore ->+ runExceptionT $ act (mapExceptionT restore) -- -- Instances for the IO monad. -- instance MonadException IO where- catch = E.catch- throw = E.throw+ catch = E.catch+ throw = E.throw+ finally = E.finally +#if __GLASGOW_HASKELL__ >= 700 instance MonadAsyncException IO where- block = E.block- unblock = E.unblock+ mask = E.mask+#else /* __GLASGOW_HASKELL__ < 700 */+instance MonadAsyncException IO where+ mask act = do+ b <- E.blocked+ if b+ then act id+ else E.block $ act E.unblock+#endif /* __GLASGOW_HASKELL__ < 700 */ -- -- Instances for the STM monad.@@ -187,23 +285,48 @@ catch = catchSTM throw = throwSTM -unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))-unSTM (STM a) = a--catchSTM :: E.Exception e => STM a -> (e -> STM a) -> STM a-catchSTM (STM m) handler = STM $ catchSTM# m handler'- where- handler' e = case E.fromException e of- Just e' -> unSTM (handler e')- Nothing -> raiseIO# e--throwSTM :: E.Exception e => e -> STM a-throwSTM e = STM $ raiseIO# (E.toException e)- -- -- MonadException instances for transformers. -- +#if !MIN_VERSION_transformers(0,6,0)+instance (MonadException m, Error e) =>+ MonadException (ErrorT e m) where+ throw = lift . throw+ m `catch` h = mapErrorT (\m' -> m' `catch` \e -> runErrorT (h e)) m++ act `finally` sequel =+ mapErrorT (\act' -> act' `finally` runErrorT sequel) act+#endif /* !MIN_VERSION_transformers(0,6,0) */++instance (MonadException m) =>+ MonadException (ExceptT e' m) where+ throw = lift . throw+ m `catch` h = mapExceptT (\m' -> m' `catch` \e -> runExceptT (h e)) m++ act `finally` sequel =+ mapExceptT (\act' -> act' `finally` runExceptT sequel) act++instance (MonadException m) =>+ MonadException (IdentityT m) where+ throw = lift . throw+ m `catch` h = mapIdentityT (\m' -> m' `catch` \e -> runIdentityT (h e)) m++#if !MIN_VERSION_transformers(0,6,0)+instance MonadException m =>+ MonadException (ListT m) where+ throw = lift . throw+ m `catch` h = mapListT (\m' -> m' `catch` \e -> runListT (h e)) m+#endif /* !MIN_VERSION_transformers(0,6,0) */++instance (MonadException m) =>+ MonadException (MaybeT m) where+ throw = lift . throw+ m `catch` h = mapMaybeT (\m' -> m' `catch` \e -> runMaybeT (h e)) m++ act `finally` sequel =+ mapMaybeT (\act' -> act' `finally` runMaybeT sequel) act+ instance (Monoid w, MonadException m) => MonadException (Lazy.RWST r w s m) where throw = lift . throw@@ -250,37 +373,66 @@ -- MonadAsyncException instances for transformers. -- +#if !MIN_VERSION_transformers(0,6,0)+instance (MonadAsyncException m, Error e) =>+ MonadAsyncException (ErrorT e m) where+ mask act = ErrorT $ mask $ \restore ->+ runErrorT $ act (mapErrorT restore)+#endif /* !MIN_VERSION_transformers(0,6,0) */++instance (MonadAsyncException m) =>+ MonadAsyncException (ExceptT e' m) where+ mask act = ExceptT $ mask $ \restore ->+ runExceptT $ act (mapExceptT restore)++instance (MonadAsyncException m) =>+ MonadAsyncException (IdentityT m) where+ mask act = IdentityT $ mask $ \restore ->+ runIdentityT $ act (mapIdentityT restore)++#if !MIN_VERSION_transformers(0,6,0)+instance (MonadAsyncException m) =>+ MonadAsyncException (ListT m) where+ mask act = ListT $ mask $ \restore ->+ runListT $ act (mapListT restore)+#endif /* !MIN_VERSION_transformers(0,6,0) */++instance (MonadAsyncException m) =>+ MonadAsyncException (MaybeT m) where+ mask act = MaybeT $ mask $ \restore ->+ runMaybeT $ act (mapMaybeT restore)+ instance (Monoid w, MonadAsyncException m) => MonadAsyncException (Lazy.RWST r w s m) where- block m = Lazy.RWST $ \r s -> block (Lazy.runRWST m r s)- unblock m = Lazy.RWST $ \r s -> unblock (Lazy.runRWST m r s)+ mask act = Lazy.RWST $ \r s -> mask $ \restore ->+ Lazy.runRWST (act (Lazy.mapRWST restore)) r s instance (Monoid w, MonadAsyncException m) => MonadAsyncException (Strict.RWST r w s m) where- block m = Strict.RWST $ \r s -> block (Strict.runRWST m r s)- unblock m = Strict.RWST $ \r s -> unblock (Strict.runRWST m r s)+ mask act = Strict.RWST $ \r s -> mask $ \restore ->+ Strict.runRWST (act (Strict.mapRWST restore)) r s instance (MonadAsyncException m) => MonadAsyncException (ReaderT r m) where- block m = ReaderT $ \r -> block (runReaderT m r)- unblock m = ReaderT $ \r -> unblock (runReaderT m r)+ mask act = ReaderT $ \r -> mask $ \restore ->+ runReaderT (act (mapReaderT restore)) r instance (MonadAsyncException m) => MonadAsyncException (Lazy.StateT s m) where- block m = Lazy.StateT $ \s -> block (Lazy.runStateT m s)- unblock m = Lazy.StateT $ \s -> unblock (Lazy.runStateT m s)+ mask act = Lazy.StateT $ \s -> mask $ \restore ->+ Lazy.runStateT (act (Lazy.mapStateT restore)) s instance (MonadAsyncException m) => MonadAsyncException (Strict.StateT s m) where- block m = Strict.StateT $ \s -> block (Strict.runStateT m s)- unblock m = Strict.StateT $ \s -> unblock (Strict.runStateT m s)+ mask act = Strict.StateT $ \s -> mask $ \restore ->+ Strict.runStateT (act (Strict.mapStateT restore)) s instance (Monoid w, MonadAsyncException m) => MonadAsyncException (Lazy.WriterT w m) where- block m = Lazy.WriterT $ block (Lazy.runWriterT m)- unblock m = Lazy.WriterT $ unblock (Lazy.runWriterT m)+ mask act = Lazy.WriterT $ mask $ \restore ->+ Lazy.runWriterT $ act (Lazy.mapWriterT restore) instance (Monoid w, MonadAsyncException m) => MonadAsyncException (Strict.WriterT w m) where- block m = Strict.WriterT $ block (Strict.runWriterT m)- unblock m = Strict.WriterT $ unblock (Strict.runWriterT m)+ mask act = Strict.WriterT $ mask $ \restore ->+ Strict.runWriterT $ act (Strict.mapWriterT restore)
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2008-2010+Copyright (c) 2008-2011 The President and Fellows of Harvard College. Redistribution and use in source and binary forms, with or without@@ -24,3 +24,26 @@ 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 (c) 2011-2023, Geoffrey Mainland+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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER 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.
exception-transformers.cabal view
@@ -1,34 +1,59 @@ name: exception-transformers-version: 0.2-cabal-version: >= 1.6+version: 0.4.0.12+cabal-version: >= 1.10 license: BSD3 license-file: LICENSE-copyright: (c) 2008-2010 Harvard University-author: Geoffrey Mainland <mainland@eecs.harvard.edu>-maintainer: mainland@eecs.harvard.edu+copyright: (c) 2009-2010 Harvard University+ (c) 2011-2023 Geoffrey Mainland+author: Geoffrey Mainland <mainland@drexel.edu>+maintainer: Geoffrey Mainland <mainland@drexel.edu> stability: alpha-homepage: http://www.eecs.harvard.edu/~mainland/+bug-reports: https://github.com/mainland/exception-transformers/issues category: Control, Monad, Error Handling, Failure synopsis: Type classes and monads for unchecked extensible exceptions. description: This package provides type classes, a monad and a monad- transformer that support unchecked extensible exceptions as- well as asynchronous exceptions. It is compatible with- the transformers package.+ transformer that support unchecked extensible exceptions as+ well as asynchronous exceptions. It is compatible with+ the transformers package.+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.3, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7,+ GHC==9.0.2, GHC==9.2.8, GHC==9.4.5, GHC==9.6.2 build-type: Simple library+ default-language: Haskell98+ exposed-modules: Control.Monad.Exception build-depends:- base >=4 && <5,- stm >=2.1 && <2.2,- transformers >=0.2 && <0.3+ base >= 4 && < 5,+ fail >= 4 && < 5,+ transformers >= 0.2 && < 0.7,+ transformers-compat >= 0.3 && < 0.8 ghc-options: -Wall +test-suite unit+ type: exitcode-stdio-1.0+ hs-source-dirs: tests/unit+ main-is: Main.hs+ default-language: Haskell98++ build-depends:+ HUnit >= 1.2 && < 1.7,+ base >= 4 && < 5,+ exception-transformers,+ test-framework >= 0.8 && < 0.9,+ test-framework-hunit >= 0.3 && < 0.4,+ transformers >= 0.2 && < 0.7,+ transformers-compat >= 0.3 && < 0.8++ ghc-options:+ -Wall+ source-repository head- type: svn- location: http://senseless.eecs.harvard.edu/repos/mainland-projects/exception-transformers/trunk/+ type: git+ location: git://github.com/mainland/exception-transformers.git
+ tests/unit/Main.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}++-- |+-- Module : Main+-- Copyright : (c) Geoffrey Mainland 2011-2014+-- License : BSD-style+-- Maintainer : mainland@cs.drexel.edu++module Main where++#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)+import Prelude hiding (catch)+#endif++import Control.Monad.Exception+#if !MIN_VERSION_transformers(0,6,0)+import Control.Monad.Trans.Error+#endif /* !MIN_VERSION_transformers(0,6,0) */+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import Data.IORef+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit (Assertion, (@?=))++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests = [ exceptTests+#if !MIN_VERSION_transformers(0,6,0)+ , errorTests+#endif /* !MIN_VERSION_transformers(0,6,0) */+ ]++#if !MIN_VERSION_transformers(0,6,0)+errorTests :: Test+errorTests = testGroup "ErrorT tests"+ [testCase (conl ++ " " ++ whatl) (mkErrorTest con what) | (conl, con) <- cons, (whatl, what) <- whats]+ where+ whats :: [(String, ErrorT String IO ())]+ whats = [("return", return ()),+ ("error", error "error"),+ ("throwError", throwError "throwError")]++ cons :: [(String, ErrorT String IO () -> ErrorT String IO () -> ErrorT String IO ())]+ cons = [("finally", \what sequel -> what `finally` sequel),+ ("bracket_", \what sequel -> bracket_ (return ()) sequel what)]++ mkErrorTest :: (ErrorT String IO () -> ErrorT String IO () -> ErrorT String IO ())+ -> ErrorT String IO ()+ -> Assertion+ mkErrorTest con what = do+ ref <- newIORef "sequel not called"+ let sequel = liftIO $ writeIORef ref expected+ _ <- runErrorT (con what sequel) `catch` \(e :: SomeException) -> return (Left (show e))+ actual <- readIORef ref+ expected @?= actual+ where+ expected :: String+ expected = "sequel called"+#endif /* !MIN_VERSION_transformers(0,6,0) */++exceptTests :: Test+exceptTests = testGroup "ExceptT tests"+ [testCase (conl ++ " " ++ whatl) (mkExceptTest con what) | (conl, con) <- cons, (whatl, what) <- whats]+ where+ whats :: [(String, ExceptT String IO ())]+ whats = [("return", return ()),+ ("error", error "error"),+ ("throwE", throwE "throwE")]++ cons :: [(String, ExceptT String IO () -> ExceptT String IO () -> ExceptT String IO ())]+ cons = [("finally", \what sequel -> what `finally` sequel),+ ("bracket_", \what sequel -> bracket_ (return ()) sequel what)]++ mkExceptTest :: (ExceptT String IO () -> ExceptT String IO () -> ExceptT String IO ())+ -> ExceptT String IO ()+ -> Assertion+ mkExceptTest con what = do+ ref <- newIORef "sequel not called"+ let sequel = liftIO $ writeIORef ref expected+ _ <- runExceptT (con what sequel) `catch` \(e :: SomeException) -> return (Left (show e))+ actual <- readIORef ref+ expected @?= actual+ where+ expected :: String+ expected = "sequel called"