resourcet-1.1.9/0000755000000000000000000000000013026200545011720 5ustar0000000000000000resourcet-1.1.9/ChangeLog.md0000644000000000000000000000214613026200545014074 0ustar0000000000000000## 1.1.9 * Add generalized version of resourceForkIO ## 1.1.8.1 * Allocation actions should be masked ## 1.1.8 * Add `instance MonadFix ResourceT` [#281](https://github.com/snoyberg/conduit/pull/281) ## 1.1.7.5 * Inline the tutorial from SoH ## 1.1.7.4 * Make test suite slightly more robust ## 1.1.7.3 * Doc tweak ## 1.1.7.2 * Remove upper bound on transformers [#249](https://github.com/snoyberg/conduit/issues/249) ## 1.1.7.1 * transformers-compat 0.5 ## 1.1.7 * Canonicalise Monad instances [#237](https://github.com/snoyberg/conduit/pull/237) ## 1.1.6 * Safe/Trustworthy for resourcet [#220](https://github.com/snoyberg/conduit/pull/220) ## 1.1.5 * Add pass-through instances for Alternative and MonadPlus [#214](https://github.com/snoyberg/conduit/pull/214) ## 1.1.4.1 * Allow older `exceptions` version again ## 1.1.4 * Add `MonadResource ExceptT` instance [#198](https://github.com/snoyberg/conduit/pull/198) ## 1.1.3.2 monad-control-1.0 support [#191](https://github.com/snoyberg/conduit/pull/191) ## 1.1.3 Provide the `withEx` function to interact nicely with the exceptions package. resourcet-1.1.9/LICENSE0000644000000000000000000000276713026200545012741 0ustar0000000000000000Copyright (c)2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. 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 OWNER 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. resourcet-1.1.9/README.md0000644000000000000000000002351013026200545013200 0ustar0000000000000000## resourcet Proper exception handling, especially in the presence of asynchronous exceptions, is a non-trivial task. But such proper handling is absolutely vital to any large scale application. Leaked file descriptors or database connections will simply not be an option when writing a popular web application, or a high concurrency data processing tool. So the question is, how do you deal with it? The standard approach is the bracket pattern, which appears throughout much of the standard libraries. `withFile` uses the bracket pattern to safely wrap up `openFile` and `closeFile`, guaranteeing that the file handle will be closed no matter what. This approach works well, and I highly recommend using it. However, there's another approach available: the [resourcet package](https://www.stackage.org/package/resourcet). If the bracket pattern is so good, why do we need another one? The goal of this post is to answer that question. ## What is ResourceT ResourceT is a monad transformer which creates a region of code where you can safely allocate resources. Let's write a simple example program: we'll ask the user for some input and pretend like it's a scarce resource that must be released. We'll then do something dangerous (potentially introducing a divide-by-zero error). We then want to immediately release our scarce resource and perform some long-running computation. ```haskell import Control.Monad.Trans.Resource import Control.Monad.IO.Class main = runResourceT $ do (releaseKey, resource) <- allocate (do putStrLn "Enter some number" readLn) (\i -> putStrLn $ "Freeing scarce resource: " ++ show i) doSomethingDangerous resource liftIO $ putStrLn $ "Going to release resource immediately: " ++ show resource release releaseKey somethingElse doSomethingDangerous i = liftIO $ putStrLn $ "5 divided by " ++ show i ++ " is " ++ show (5 `div` i) somethingElse = liftIO $ putStrLn "This could take a long time, don't delay releasing the resource!" ``` Try entering a valid value, such as 3, and then enter 0. Notice that in both cases the "Freeing scarce resource" message it printed. And by using `release` before `somethingElse`, we guarantee that the resource is freed *before* running the potentially long process. In this specific case, we could easily represent our code in terms of bracket with a little refactoring. ```haskell import Control.Exception (bracket) main = do bracket (do putStrLn "Enter some number" readLn) (\i -> putStrLn $ "Freeing scarce resource: " ++ show i) doSomethingDangerous somethingElse doSomethingDangerous i = putStrLn $ "5 divided by " ++ show i ++ " is " ++ show (5 `div` i) somethingElse = putStrLn "This could take a long time, don't delay releasing the resource!" ``` In fact, the `bracket` version is cleaner than the resourcet version. If so, why bother with resourcet at all? Let's build up to the more complicated cases. ## bracket in terms of ResourceT The first thing to demonstrate is that `ResourceT` is strictly more powerful than `bracket`, in the sense that: 1. `bracket` can be implemented in terms of `ResourceT`. 2. `ResourceT` cannot be implemented in terms of `bracket`. The first one is pretty easy to demonstrate: ```haskell import Control.Monad.Trans.Resource import Control.Monad.Trans.Class bracket alloc free inside = runResourceT $ do (_releaseKey, resource) <- allocate alloc free lift $ inside resource main = bracket (putStrLn "Allocating" >> return 5) (\i -> putStrLn $ "Freeing: " ++ show i) (\i -> putStrLn $ "Using: " ++ show i) ``` Now let's analyze why the second statement is true. ## What ResourceT adds The `bracket` pattern is designed with nested resource allocations. For example, consider the following program which copies data from one file to another. We'll open up the source file using `withFile`, and then nest within it another `withFile` to open the destination file, and finally do the copying with both file handles. ```haskell {-# START_FILE main.hs #-} import System.IO import qualified Data.ByteString as S main = do withFile "input.txt" ReadMode $ \input -> withFile "output.txt" WriteMode $ \output -> do bs <- S.hGetContents input S.hPutStr output bs S.readFile "output.txt" >>= S.putStr {-# START_FILE input.txt #-} This is the input file. ``` But now, let's tweak this a bit. Instead of reading from a single file, we want to read from two files and concatenate them. We could just have three nested `withFile` calls, but that would be inefficient: we'd have two `Handle`s open for reading at once, even though we'll only ever need one. We could restructure our program a bit instead: put the `withFile` for the output file on the outside, and then have two calls to `withFile` for the input files on the inside. But consider a more complicated example. Instead of just a single destination file, let's say we want to break up our input stream into chunks of, say, 50 bytes each, and write each chunk to successive output files. We now need to __interleave__ allocations and freeings of both the source and destination files, and we cannot statically know exactly how the interleaving will look, since we don't know the size of the files at compile time. This is the kind of situation that `resourcet` solves well (we'll demonstrate in the next section). As an extension of this, we can write library functions which allow user code to request arbitrary resource allocations, and we can guarantee that they will be cleaned up. A prime example of this is in WAI (Web Application Interface). The user application may wish to allocate some scarce resources (such as database statements) and use them in the generation of the response body. Using `ResourceT`, the web server can guarantee that these resources will be cleaned up. ## Interleaving with conduit Let's demonstrate the interleaving example described above. To simplify the code, we'll use the conduit package for the actual chunking implementation. Notice when you run the program that there are never more than two file handles open at the same time. ```haskell import Control.Monad.IO.Class (liftIO) import Data.Conduit (addCleanup, runResourceT, ($$), (=$)) import Data.Conduit.Binary (isolate, sinkFile, sourceFile) import Data.Conduit.List (peek) import Data.Conduit.Zlib (gzip) import System.Directory (createDirectoryIfMissing) -- show -- All of the files we'll read from infiles = map (\i -> "input/" ++ show i ++ ".bin") [1..10] -- Generate a filename to write to outfile i = "output/" ++ show i ++ ".gz" -- Monad instance of Source allows us to simply mapM_ to create a single Source -- for reading all of the files sequentially. source = mapM_ sourceFileTrace infiles -- The Sink is a bit more complicated: we keep reading 30kb chunks of data into -- new files. We then use peek to check if there is any data left in the -- stream. If there is, we continue the process. sink = loop 1 where loop i = do isolate (30 * 1024) =$ sinkFileTrace (outfile i) mx <- peek case mx of Nothing -> return () Just _ -> loop (i + 1) -- Putting it all together is trivial. ResourceT guarantees we have exception -- safety. transform = runResourceT $ source $$ gzip =$ sink -- /show -- Just some setup for running our test. main = do createDirectoryIfMissing True "input" createDirectoryIfMissing True "output" mapM_ fillRandom infiles transform fillRandom fp = runResourceT $ sourceFile "/dev/urandom" $$ isolate (50 * 1024) =$ sinkFile fp -- Modified sourceFile and sinkFile that print when they are opening and -- closing file handles, to demonstrate interleaved allocation. sourceFileTrace fp = do liftIO $ putStrLn $ "Opening: " ++ fp addCleanup (const $ liftIO $ putStrLn $ "Closing: " ++ fp) (sourceFile fp) sinkFileTrace fp = do liftIO $ putStrLn $ "Opening: " ++ fp addCleanup (const $ liftIO $ putStrLn $ "Closing: " ++ fp) (sinkFile fp) ``` ## resourcet is not conduit resourcet was originally created in the process of writing the conduit package. As a result, many people have the impression that these two concepts are intrinsically linked. In fact, this is not true: each can be used separately from the other. The canonical demonstration of resourcet combined with conduit is the file copy function: ```haskell import Data.Conduit import Data.Conduit.Binary fileCopy src dst = runResourceT $ sourceFile src $$ sinkFile dst main = do writeFile "input.txt" "Hello" fileCopy "input.txt" "output.txt" readFile "output.txt" >>= putStrLn ``` However, since this function does not actually use any of ResourceT's added functionality, it can easily be implemented with the bracket pattern instead: ```haskell import Data.Conduit import Data.Conduit.Binary import System.IO fileCopy src dst = withFile src ReadMode $ \srcH -> withFile dst WriteMode $ \dstH -> sourceHandle srcH $$ sinkHandle dstH main = do writeFile "input.txt" "Hello" fileCopy "input.txt" "output.txt" readFile "output.txt" >>= putStrLn ``` Likewise, resourcet can be freely used for more flexible resource management without touching conduit. In other words, these two libraries are completely orthogonal and, while they complement each other nicely, can certainly be used separately. ## Conclusion ResourceT provides you with a flexible means of allocating resources in an exception safe manner. Its main advantage over the simpler bracket pattern is that it allows interleaving of allocations, allowing for more complicated programs to be created efficiently. If your needs are simple, stick with bracket. If you have need of something more complex, resourcet may be your answer. resourcet-1.1.9/resourcet.cabal0000644000000000000000000000345213026200545014723 0ustar0000000000000000Name: resourcet Version: 1.1.9 Synopsis: Deterministic allocation and freeing of scarce resources. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit extra-source-files: ChangeLog.md, README.md Library Exposed-modules: Control.Monad.Trans.Resource Control.Monad.Trans.Resource.Internal Data.Acquire Data.Acquire.Internal Build-depends: base >= 4.5 && < 5 , lifted-base >= 0.1 , transformers-base >= 0.4.4 && < 0.5 , monad-control >= 0.3.1 && < 1.1 , containers , transformers >= 0.2.2 , transformers-compat >= 0.3 && < 0.6 , mtl >= 2.0 && < 2.3 , mmorph , exceptions >= 0.5 ghc-options: -Wall test-suite test hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: resourcet , base , hspec >= 1.3 , lifted-base , transformers ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/conduit.git resourcet-1.1.9/Setup.lhs0000644000000000000000000000016213026200545013527 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain resourcet-1.1.9/Control/0000755000000000000000000000000013026200545013340 5ustar0000000000000000resourcet-1.1.9/Control/Monad/0000755000000000000000000000000013026200545014376 5ustar0000000000000000resourcet-1.1.9/Control/Monad/Trans/0000755000000000000000000000000013026200545015465 5ustar0000000000000000resourcet-1.1.9/Control/Monad/Trans/Resource.hs0000644000000000000000000003061013026200545017610 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-} #endif {-# LANGUAGE Safe #-} -- | Allocate resources which are guaranteed to be released. -- -- For more information, see . -- -- One point to note: all register cleanup actions live in the @IO@ monad, not -- the main monad. This allows both more efficient code, and for monads to be -- transformed. module Control.Monad.Trans.Resource ( -- * Data types ResourceT , ResIO , ReleaseKey -- * Unwrap , runResourceT -- * Special actions , resourceForkWith , resourceForkIO -- * Monad transformation , transResourceT , joinResourceT -- * Registering/releasing , allocate , register , release , unprotect , resourceMask -- * Type class/associated types , MonadResource (..) , MonadResourceBase -- ** Low-level , InvalidAccess (..) -- * Re-exports , MonadBaseControl -- * Internal state -- $internalState , InternalState , getInternalState , runInternalState , withInternalState , createInternalState , closeInternalState -- * Backwards compatibility , ExceptionT (..) , runExceptionT , runExceptionT_ , runException , runException_ , MonadThrow (..) , monadThrow ) where import qualified Data.IntMap as IntMap import Control.Exception (SomeException, throw) import Control.Monad.Trans.Control ( MonadBaseControl (..), liftBaseDiscard, control ) import qualified Data.IORef as I import Control.Monad.Base (MonadBase, liftBase) import Control.Applicative (Applicative (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad (liftM) import qualified Control.Exception as E import Data.Monoid (Monoid) import qualified Control.Exception.Lifted as L import Control.Monad.Trans.Resource.Internal import Control.Concurrent (ThreadId, forkIO) import Data.Functor.Identity (Identity, runIdentity) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.Catch.Pure (CatchT, runCatchT) import Data.Acquire.Internal (ReleaseType (..)) -- | Register some action that will be called precisely once, either when -- 'runResourceT' is called, or when the 'ReleaseKey' is passed to 'release'. -- -- Since 0.3.0 register :: MonadResource m => IO () -> m ReleaseKey register = liftResourceT . registerRIO -- | Call a release action early, and deregister it from the list of cleanup -- actions to be performed. -- -- Since 0.3.0 release :: MonadIO m => ReleaseKey -> m () release (ReleaseKey istate rk) = liftIO $ release' istate rk (maybe (return ()) id) -- | Unprotect resource from cleanup actions, this allowes you to send -- resource into another resourcet process and reregister it there. -- It returns an release action that should be run in order to clean -- resource or Nothing in case if resource is already freed. -- -- Since 0.4.5 unprotect :: MonadIO m => ReleaseKey -> m (Maybe (IO ())) unprotect (ReleaseKey istate rk) = liftIO $ release' istate rk return -- | Perform some allocation, and automatically register a cleanup action. -- -- This is almost identical to calling the allocation and then -- @register@ing the release action, but this properly handles masking of -- asynchronous exceptions. -- -- Since 0.3.0 allocate :: MonadResource m => IO a -- ^ allocate -> (a -> IO ()) -- ^ free resource -> m (ReleaseKey, a) allocate a = liftResourceT . allocateRIO a -- | Perform asynchronous exception masking. -- -- This is more general then @Control.Exception.mask@, yet more efficient -- than @Control.Exception.Lifted.mask@. -- -- Since 0.3.0 resourceMask :: MonadResource m => ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> m b resourceMask r = liftResourceT (resourceMaskRIO r) allocateRIO :: IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a) allocateRIO acquire rel = ResourceT $ \istate -> liftIO $ E.mask_ $ do a <- acquire key <- register' istate $ rel a return (key, a) registerRIO :: IO () -> ResourceT IO ReleaseKey registerRIO rel = ResourceT $ \istate -> liftIO $ register' istate rel resourceMaskRIO :: ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> ResourceT IO b resourceMaskRIO f = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> let ResourceT f' = f (go restore) in f' istate where go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a) go r (ResourceT g) = ResourceT (\i -> r (g i)) release' :: I.IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a) -> IO a release' istate key act = E.mask_ $ do maction <- I.atomicModifyIORef istate lookupAction act maction where lookupAction rm@(ReleaseMap next rf m) = case IntMap.lookup key m of Nothing -> (rm, Nothing) Just action -> ( ReleaseMap next rf $ IntMap.delete key m , Just (action ReleaseEarly) ) -- We tried to call release, but since the state is already closed, we -- can assume that the release action was already called. Previously, -- this threw an exception, though given that @release@ can be called -- from outside the context of a @ResourceT@ starting with version -- 0.4.4, it's no longer a library misuse or a library bug. lookupAction ReleaseMapClosed = (ReleaseMapClosed, Nothing) -- | Unwrap a 'ResourceT' transformer, and call all registered release actions. -- -- Note that there is some reference counting involved due to 'resourceForkIO'. -- If multiple threads are sharing the same collection of resources, only the -- last call to @runResourceT@ will deallocate the resources. -- -- Since 0.3.0 runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a runResourceT (ResourceT r) = control $ \run -> do istate <- createInternalState E.mask $ \restore -> do res <- restore (run (r istate)) `E.onException` stateCleanup ReleaseException istate stateCleanup ReleaseNormal istate return res bracket_ :: MonadBaseControl IO m => IO () -- ^ allocate -> IO () -- ^ normal cleanup -> IO () -- ^ exceptional cleanup -> m a -> m a bracket_ alloc cleanupNormal cleanupExc inside = control $ \run -> E.mask $ \restore -> do alloc res <- restore (run inside) `E.onException` cleanupExc cleanupNormal return res finally :: MonadBaseControl IO m => m a -> IO () -> m a finally action cleanup = control $ \run -> E.finally (run action) cleanup -- | This function mirrors @join@ at the transformer level: it will collapse -- two levels of @ResourceT@ into a single @ResourceT@. -- -- Since 0.4.6 joinResourceT :: ResourceT (ResourceT m) a -> ResourceT m a joinResourceT (ResourceT f) = ResourceT $ \r -> unResourceT (f r) r -- | For backwards compatibility. type ExceptionT = CatchT -- | For backwards compatibility. runExceptionT :: ExceptionT m a -> m (Either SomeException a) runExceptionT = runCatchT -- | Same as 'runExceptionT', but immediately 'E.throw' any exception returned. -- -- Since 0.3.0 runExceptionT_ :: Monad m => ExceptionT m a -> m a runExceptionT_ = liftM (either E.throw id) . runExceptionT -- | Run an @ExceptionT Identity@ stack. -- -- Since 0.4.2 runException :: ExceptionT Identity a -> Either SomeException a runException = runIdentity . runExceptionT -- | Run an @ExceptionT Identity@ stack, but immediately 'E.throw' any exception returned. -- -- Since 0.4.2 runException_ :: ExceptionT Identity a -> a runException_ = runIdentity . runExceptionT_ -- | Introduce a reference-counting scheme to allow a resource context to be -- shared by multiple threads. Once the last thread exits, all remaining -- resources will be released. -- -- The first parameter is a function which will be used to create the -- thread, such as @forkIO@ or @async@. -- -- Note that abuse of this function will greatly delay the deallocation of -- registered resources. This function should be used with care. A general -- guideline: -- -- If you are allocating a resource that should be shared by multiple threads, -- and will be held for a long time, you should allocate it at the beginning of -- a new @ResourceT@ block and then call @resourceForkWith@ from there. -- -- @since 1.1.9 resourceForkWith :: MonadBaseControl IO m => (IO () -> IO a) -> ResourceT m () -> ResourceT m a resourceForkWith g (ResourceT f) = ResourceT $ \r -> L.mask $ \restore -> -- We need to make sure the counter is incremented before this call -- returns. Otherwise, the parent thread may call runResourceT before -- the child thread increments, and all resources will be freed -- before the child gets called. bracket_ (stateAlloc r) (return ()) (return ()) (liftBaseDiscard g $ bracket_ (return ()) (stateCleanup ReleaseNormal r) (stateCleanup ReleaseException r) (restore $ f r)) -- | Launch a new reference counted resource context using @forkIO@. -- -- This is defined as @resourceForkWith forkIO@. -- -- @since 0.3.0 resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId resourceForkIO = resourceForkWith forkIO -- | A @Monad@ which can be used as a base for a @ResourceT@. -- -- A @ResourceT@ has some restrictions on its base monad: -- -- * @runResourceT@ requires an instance of @MonadBaseControl IO@. -- * @MonadResource@ requires an instance of @MonadThrow@, @MonadIO@, and @Applicative@. -- -- While any instance of @MonadBaseControl IO@ should be an instance of the -- other classes, this is not guaranteed by the type system (e.g., you may have -- a transformer in your stack with does not implement @MonadThrow@). Ideally, -- we would like to simply create an alias for the five type classes listed, -- but this is not possible with GHC currently. -- -- Instead, this typeclass acts as a proxy for the other five. Its only purpose -- is to make your type signatures shorter. -- -- Note that earlier versions of @conduit@ had a typeclass @ResourceIO@. This -- fulfills much the same role. -- -- Since 0.3.2 #if __GLASGOW_HASKELL__ >= 704 type MonadResourceBase m = (MonadBaseControl IO m, MonadThrow m, MonadBase IO m, MonadIO m, Applicative m) #else class (MonadBaseControl IO m, MonadThrow m, MonadIO m, Applicative m) => MonadResourceBase m instance (MonadBaseControl IO m, MonadThrow m, MonadIO m, Applicative m) => MonadResourceBase m #endif -- $internalState -- -- A @ResourceT@ internally is a modified @ReaderT@ monad transformer holding -- onto a mutable reference to all of the release actions still remaining to be -- performed. If you are building up a custom application monad, it may be more -- efficient to embed this @ReaderT@ functionality directly in your own monad -- instead of wrapping around @ResourceT@ itself. This section provides you the -- means of doing so. -- | Create a new internal state. This state must be closed with -- @closeInternalState@. It is your responsibility to ensure exception safety. -- Caveat emptor! -- -- Since 0.4.9 createInternalState :: MonadBase IO m => m InternalState createInternalState = liftBase $ I.newIORef $ ReleaseMap maxBound (minBound + 1) IntMap.empty -- | Close an internal state created by @createInternalState@. -- -- Since 0.4.9 closeInternalState :: MonadBase IO m => InternalState -> m () closeInternalState = liftBase . stateCleanup ReleaseNormal -- | Get the internal state of the current @ResourceT@. -- -- Since 0.4.6 getInternalState :: Monad m => ResourceT m InternalState getInternalState = ResourceT return -- | The internal state held by a @ResourceT@ transformer. -- -- Since 0.4.6 type InternalState = I.IORef ReleaseMap -- | Unwrap a @ResourceT@ using the given @InternalState@. -- -- Since 0.4.6 runInternalState :: ResourceT m a -> InternalState -> m a runInternalState = unResourceT -- | Run an action in the underlying monad, providing it the @InternalState@. -- -- Since 0.4.6 withInternalState :: (InternalState -> m a) -> ResourceT m a withInternalState = ResourceT -- | Backwards compatibility monadThrow :: (E.Exception e, MonadThrow m) => e -> m a monadThrow = throwM resourcet-1.1.9/Control/Monad/Trans/Resource/0000755000000000000000000000000013026200545017254 5ustar0000000000000000resourcet-1.1.9/Control/Monad/Trans/Resource/Internal.hs0000644000000000000000000003021513026200545021365 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RankNTypes #-} -- Can only mark as Safe when using a newer GHC, otherwise we get build -- failures due to the manual Typeable instance below. #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE Safe #-} #else {-# LANGUAGE Trustworthy #-} #endif module Control.Monad.Trans.Resource.Internal( InvalidAccess(..) , MonadResource(..) , ReleaseKey(..) , ReleaseMap(..) , ResIO , ResourceT(..) , stateAlloc , stateCleanup , transResourceT , register' , registerType ) where import Control.Exception (throw,Exception,SomeException) import Control.Applicative (Applicative (..), Alternative(..)) import Control.Monad (MonadPlus(..)) import Control.Monad.Fix (MonadFix(..)) import Control.Monad.Trans.Control ( MonadTransControl (..), MonadBaseControl (..) ) import Control.Monad.Base (MonadBase, liftBase) import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) ) import Control.Monad.RWS.Class ( MonadRWS ) import Control.Monad.Reader.Class ( MonadReader (..) ) import Control.Monad.State.Class ( MonadState (..) ) import Control.Monad.Writer.Class ( MonadWriter (..) ) import Control.Monad.Trans.Identity ( IdentityT) import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT ) import Control.Monad.Trans.Error ( ErrorT, Error) import Control.Monad.Trans.Except ( ExceptT ) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.State ( StateT ) import Control.Monad.Trans.Writer ( WriterT ) import Control.Monad.Trans.RWS ( RWST ) import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST ) import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) import Control.Monad.IO.Class (MonadIO (..)) #if !(MIN_VERSION_monad_control(1,0,0)) import Control.Monad (liftM) #endif import qualified Control.Exception as E import Control.Monad.Catch (MonadThrow (..), MonadCatch (..) #if MIN_VERSION_exceptions(0,6,0) , MonadMask (..) #endif ) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import qualified Data.IORef as I import Data.Monoid import Data.Typeable import Data.Word(Word) import Prelude hiding (catch) import Data.Acquire.Internal (ReleaseType (..)) import Control.Monad.Morph -- | A @Monad@ which allows for safe resource allocation. In theory, any monad -- transformer stack which includes a @ResourceT@ can be an instance of -- @MonadResource@. -- -- Note: @runResourceT@ has a requirement for a @MonadBaseControl IO m@ monad, -- which allows control operations to be lifted. A @MonadResource@ does not -- have this requirement. This means that transformers such as @ContT@ can be -- an instance of @MonadResource@. However, the @ContT@ wrapper will need to be -- unwrapped before calling @runResourceT@. -- -- Since 0.3.0 class (MonadThrow m, MonadIO m, Applicative m, MonadBase IO m) => MonadResource m where -- | Lift a @ResourceT IO@ action into the current @Monad@. -- -- Since 0.4.0 liftResourceT :: ResourceT IO a -> m a -- | A lookup key for a specific release action. This value is returned by -- 'register' and 'allocate', and is passed to 'release'. -- -- Since 0.3.0 data ReleaseKey = ReleaseKey !(I.IORef ReleaseMap) !Int deriving Typeable type RefCount = Word type NextKey = Int data ReleaseMap = ReleaseMap !NextKey !RefCount !(IntMap (ReleaseType -> IO ())) | ReleaseMapClosed -- | Convenient alias for @ResourceT IO@. type ResIO a = ResourceT IO a instance MonadCont m => MonadCont (ResourceT m) where callCC f = ResourceT $ \i -> callCC $ \c -> unResourceT (f (ResourceT . const . c)) i instance MonadError e m => MonadError e (ResourceT m) where throwError = lift . throwError catchError r h = ResourceT $ \i -> unResourceT r i `catchError` \e -> unResourceT (h e) i instance MonadRWS r w s m => MonadRWS r w s (ResourceT m) instance MonadReader r m => MonadReader r (ResourceT m) where ask = lift ask local = mapResourceT . local mapResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b mapResourceT f = ResourceT . (f .) . unResourceT instance MonadState s m => MonadState s (ResourceT m) where get = lift get put = lift . put instance MonadWriter w m => MonadWriter w (ResourceT m) where tell = lift . tell listen = mapResourceT listen pass = mapResourceT pass instance MonadThrow m => MonadThrow (ResourceT m) where throwM = lift . throwM instance MonadCatch m => MonadCatch (ResourceT m) where catch (ResourceT m) c = ResourceT $ \r -> m r `catch` \e -> unResourceT (c e) r #if MIN_VERSION_exceptions(0,6,0) instance MonadMask m => MonadMask (ResourceT m) where #endif mask a = ResourceT $ \e -> mask $ \u -> unResourceT (a $ q u) e where q u (ResourceT b) = ResourceT (u . b) uninterruptibleMask a = ResourceT $ \e -> uninterruptibleMask $ \u -> unResourceT (a $ q u) e where q u (ResourceT b) = ResourceT (u . b) instance (MonadThrow m, MonadBase IO m, MonadIO m, Applicative m) => MonadResource (ResourceT m) where liftResourceT = transResourceT liftIO -- | Transform the monad a @ResourceT@ lives in. This is most often used to -- strip or add new transformers to a stack, e.g. to run a @ReaderT@. -- -- Note that this function is a slight generalization of 'hoist'. -- -- Since 0.3.0 transResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b transResourceT f (ResourceT mx) = ResourceT (\r -> f (mx r)) -- | Since 0.4.7 instance MFunctor ResourceT where hoist f (ResourceT mx) = ResourceT (\r -> f (mx r)) -- | Since 0.4.7 instance MMonad ResourceT where embed f m = ResourceT (\i -> unResourceT (f (unResourceT m i)) i) -- | The Resource transformer. This transformer keeps track of all registered -- actions, and calls them upon exit (via 'runResourceT'). Actions may be -- registered via 'register', or resources may be allocated atomically via -- 'allocate'. @allocate@ corresponds closely to @bracket@. -- -- Releasing may be performed before exit via the 'release' function. This is a -- highly recommended optimization, as it will ensure that scarce resources are -- freed early. Note that calling @release@ will deregister the action, so that -- a release action will only ever be called once. -- -- Since 0.3.0 newtype ResourceT m a = ResourceT { unResourceT :: I.IORef ReleaseMap -> m a } #if __GLASGOW_HASKELL__ >= 707 deriving Typeable #else instance Typeable1 m => Typeable1 (ResourceT m) where typeOf1 = goType undefined where goType :: Typeable1 m => m a -> ResourceT m a -> TypeRep goType m _ = mkTyConApp #if __GLASGOW_HASKELL__ >= 704 (mkTyCon3 "resourcet" "Control.Monad.Trans.Resource" "ResourceT") #else (mkTyCon "Control.Monad.Trans.Resource.ResourceT") #endif [ typeOf1 m ] #endif -- | Indicates either an error in the library, or misuse of it (e.g., a -- @ResourceT@'s state is accessed after being released). -- -- Since 0.3.0 data InvalidAccess = InvalidAccess { functionName :: String } deriving Typeable instance Show InvalidAccess where show (InvalidAccess f) = concat [ "Control.Monad.Trans.Resource." , f , ": The mutable state is being accessed after cleanup. Please contact the maintainers." ] instance Exception InvalidAccess -------- All of our monad et al instances instance Functor m => Functor (ResourceT m) where fmap f (ResourceT m) = ResourceT $ \r -> fmap f (m r) instance Applicative m => Applicative (ResourceT m) where pure = ResourceT . const . pure ResourceT mf <*> ResourceT ma = ResourceT $ \r -> mf r <*> ma r -- | Since 1.1.5 instance Alternative m => Alternative (ResourceT m) where empty = ResourceT $ \_ -> empty (ResourceT mf) <|> (ResourceT ma) = ResourceT $ \r -> mf r <|> ma r -- | Since 1.1.5 instance MonadPlus m => MonadPlus (ResourceT m) where mzero = ResourceT $ \_ -> mzero (ResourceT mf) `mplus` (ResourceT ma) = ResourceT $ \r -> mf r `mplus` ma r instance Monad m => Monad (ResourceT m) where #if !MIN_VERSION_base(4,8,0) return = ResourceT . const . return #endif ResourceT ma >>= f = ResourceT $ \r -> do a <- ma r let ResourceT f' = f a f' r -- | @since 1.1.8 instance MonadFix m => MonadFix (ResourceT m) where mfix f = ResourceT $ \r -> mfix $ \a -> unResourceT (f a) r instance MonadTrans ResourceT where lift = ResourceT . const instance MonadIO m => MonadIO (ResourceT m) where liftIO = lift . liftIO instance MonadBase b m => MonadBase b (ResourceT m) where liftBase = lift . liftBase instance MonadTransControl ResourceT where #if MIN_VERSION_monad_control(1,0,0) type StT ResourceT a = a liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> t r restoreT = ResourceT . const #else newtype StT ResourceT a = StReader {unStReader :: a} liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r restoreT = ResourceT . const . liftM unStReader #endif {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where #if MIN_VERSION_monad_control(1,0,0) type StM (ResourceT m) a = StM m a liftBaseWith f = ResourceT $ \reader' -> liftBaseWith $ \runInBase -> f $ runInBase . (\(ResourceT r) -> r reader' ) restoreM = ResourceT . const . restoreM #else newtype StM (ResourceT m) a = StMT (StM m a) liftBaseWith f = ResourceT $ \reader' -> liftBaseWith $ \runInBase -> f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader' ) restoreM (StMT base) = ResourceT $ const $ restoreM base #endif #define GO(T) instance (MonadResource m) => MonadResource (T m) where liftResourceT = lift . liftResourceT #define GOX(X, T) instance (X, MonadResource m) => MonadResource (T m) where liftResourceT = lift . liftResourceT GO(IdentityT) GO(ListT) GO(MaybeT) GOX(Error e, ErrorT e) #if MIN_VERSION_exceptions(0, 8, 0) GO(ExceptT e) #endif GO(ReaderT r) GO(ContT r) GO(StateT s) GOX(Monoid w, WriterT w) GOX(Monoid w, RWST r w s) GOX(Monoid w, Strict.RWST r w s) GO(Strict.StateT s) GOX(Monoid w, Strict.WriterT w) #undef GO #undef GOX stateAlloc :: I.IORef ReleaseMap -> IO () stateAlloc istate = do I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> (ReleaseMap nk (rf + 1) m, ()) ReleaseMapClosed -> throw $ InvalidAccess "stateAlloc" stateCleanup :: ReleaseType -> I.IORef ReleaseMap -> IO () stateCleanup rtype istate = E.mask_ $ do mm <- I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> let rf' = rf - 1 in if rf' == minBound then (ReleaseMapClosed, Just m) else (ReleaseMap nk rf' m, Nothing) ReleaseMapClosed -> throw $ InvalidAccess "stateCleanup" case mm of Just m -> mapM_ (\x -> try (x rtype) >> return ()) $ IntMap.elems m Nothing -> return () where try :: IO a -> IO (Either SomeException a) try = E.try register' :: I.IORef ReleaseMap -> IO () -> IO ReleaseKey register' istate rel = I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap key rf m -> ( ReleaseMap (key - 1) rf (IntMap.insert key (const rel) m) , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'" -- | -- -- Since 1.1.2 registerType :: I.IORef ReleaseMap -> (ReleaseType -> IO ()) -> IO ReleaseKey registerType istate rel = I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap key rf m -> ( ReleaseMap (key - 1) rf (IntMap.insert key rel m) , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'" resourcet-1.1.9/Data/0000755000000000000000000000000013026200545012571 5ustar0000000000000000resourcet-1.1.9/Data/Acquire.hs0000644000000000000000000000233513026200545014521 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | This was previously known as the Resource monad. However, that term is -- confusing next to the ResourceT transformer, so it has been renamed. module Data.Acquire ( Acquire , with , withEx , mkAcquire , mkAcquireType , allocateAcquire , ReleaseType (..) ) where import Control.Monad.Trans.Resource.Internal import Control.Monad.Trans.Resource import Data.Acquire.Internal import Control.Applicative (Applicative (..)) import Control.Monad.Base (MonadBase (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Control (MonadBaseControl, control) import qualified Control.Exception.Lifted as E import Data.Typeable (Typeable) import Control.Monad (liftM, ap) -- | Allocate a resource and register an action with the @MonadResource@ to -- free the resource. -- -- Since 1.1.0 allocateAcquire :: MonadResource m => Acquire a -> m (ReleaseKey, a) allocateAcquire = liftResourceT . allocateAcquireRIO allocateAcquireRIO :: Acquire a -> ResourceT IO (ReleaseKey, a) allocateAcquireRIO (Acquire f) = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do Allocated a free <- f restore key <- registerType istate free return (key, a) resourcet-1.1.9/Data/Acquire/0000755000000000000000000000000013026200545014162 5ustar0000000000000000resourcet-1.1.9/Data/Acquire/Internal.hs0000644000000000000000000001114313026200545016272 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} module Data.Acquire.Internal ( Acquire (..) , Allocated (..) , with , withEx , mkAcquire , ReleaseType (..) , mkAcquireType ) where import Control.Applicative (Applicative (..)) import Control.Monad.Base (MonadBase (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Control (MonadBaseControl, control) import qualified Control.Exception.Lifted as E import Data.Typeable (Typeable) import Control.Monad (liftM, ap) import qualified Control.Monad.Catch as C import GHC.IO (unsafeUnmask) -- | The way in which a release is called. -- -- Since 1.1.2 data ReleaseType = ReleaseEarly | ReleaseNormal | ReleaseException deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) data Allocated a = Allocated !a !(ReleaseType -> IO ()) -- | A method for acquiring a scarce resource, providing the means of freeing -- it when no longer needed. This data type provides -- @Functor@/@Applicative@/@Monad@ instances for composing different resources -- together. You can allocate these resources using either the @bracket@ -- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@). -- -- This concept was originally introduced by Gabriel Gonzalez and described at: -- . The -- implementation in this package is slightly different, due to taking a -- different approach to async exception safety. -- -- Since 1.1.0 newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a)) deriving Typeable instance Functor Acquire where fmap = liftM instance Applicative Acquire where pure a = Acquire (\_ -> return (Allocated a (const $ return ()))) (<*>) = ap instance Monad Acquire where return = pure Acquire f >>= g' = Acquire $ \restore -> do Allocated x free1 <- f restore let Acquire g = g' x Allocated y free2 <- g restore `E.onException` free1 ReleaseException return $! Allocated y (\rt -> free2 rt `E.finally` free1 rt) instance MonadIO Acquire where liftIO f = Acquire $ \restore -> do x <- restore f return $! Allocated x (const $ return ()) instance MonadBase IO Acquire where liftBase = liftIO -- | Create an @Acquire@ value using the given allocate and free functions. -- -- Since 1.1.0 mkAcquire :: IO a -- ^ acquire the resource -> (a -> IO ()) -- ^ free the resource -> Acquire a mkAcquire create free = Acquire $ \restore -> do x <- restore create return $! Allocated x (const $ free x) -- | Same as 'mkAcquire', but the cleanup function will be informed of /how/ -- cleanup was initiated. This allows you to distinguish, for example, between -- normal and exceptional exits. -- -- Since 1.1.2 mkAcquireType :: IO a -- ^ acquire the resource -> (a -> ReleaseType -> IO ()) -- ^ free the resource -> Acquire a mkAcquireType create free = Acquire $ \restore -> do x <- restore create return $! Allocated x (free x) -- | Allocate the given resource and provide it to the provided function. The -- resource will be freed as soon as the inner block is exited, whether -- normally or via an exception. This function is similar in function to -- @bracket@. -- -- Since 1.1.0 with :: MonadBaseControl IO m => Acquire a -> (a -> m b) -> m b with (Acquire f) g = control $ \run -> E.mask $ \restore -> do Allocated x free <- f restore res <- restore (run (g x)) `E.onException` free ReleaseException free ReleaseNormal return res -- | Same as @with@, but uses the @MonadMask@ typeclass from exceptions instead -- of @MonadBaseControl@ from exceptions. -- -- Since 1.1.3 #if MIN_VERSION_exceptions(0,6,0) withEx :: (C.MonadMask m, MonadIO m) #else withEx :: (C.MonadCatch m, MonadIO m) #endif => Acquire a -> (a -> m b) -> m b withEx (Acquire f) g = do -- We need to do some funny business, since the restore we get below is -- specialized to the m from the result, whereas we need a restore function -- in IO. Checking the current masking state is exactly how mask is -- implemented in base. origMS <- liftIO E.getMaskingState C.mask $ \restore -> do Allocated x free <- liftIO $ f $ case origMS of E.Unmasked -> unsafeUnmask _ -> id res <- restore (g x) `C.onException` liftIO (free ReleaseException) liftIO $ free ReleaseNormal return res resourcet-1.1.9/test/0000755000000000000000000000000013026200545012677 5ustar0000000000000000resourcet-1.1.9/test/main.hs0000644000000000000000000001226713026200545014167 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} import Control.Concurrent import Control.Concurrent.Lifted (fork) import Control.Exception (Exception, MaskingState (MaskedInterruptible), getMaskingState, throwIO, try) import Control.Exception (SomeException, handle) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource import Data.IORef import Data.Typeable (Typeable) import Test.Hspec import Data.Acquire main :: IO () main = hspec $ do describe "general" $ do it "survives releasing bottom" $ do x <- newIORef 0 handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do _ <- register $ writeIORef x 1 release undefined x' <- readIORef x x' `shouldBe` 1 describe "early release" $ do it "works from a different context" $ do x <- newIORef 0 runResourceT $ do key <- register $ writeIORef x 1 runResourceT $ release key y <- liftIO $ readIORef x liftIO $ y `shouldBe` 1 describe "resourceForkIO" $ do it "waits for all threads" $ do x <- newEmptyMVar y <- newIORef 0 z <- newEmptyMVar w <- newEmptyMVar runResourceT $ do _ <- register $ do writeIORef y 1 putMVar w () resourceForkIO $ do () <- liftIO $ takeMVar x y' <- liftIO $ readIORef y _ <- register $ putMVar z y' return () y1 <- readIORef y y1 `shouldBe` 0 putMVar x () z' <- takeMVar z z' `shouldBe` 0 takeMVar w y2 <- readIORef y Just y2 `shouldBe` Just 1 describe "unprotecting" $ do it "unprotect keeps resource from being cleared" $ do x <- newIORef 0 runResourceT $ do key <- register $ writeIORef x 1 unprotect key y <- readIORef x y `shouldBe` 0 it "cleanup actions are masked #144" $ do let checkMasked name = do ms <- getMaskingState unless (ms == MaskedInterruptible) $ error $ show (name, ms) runResourceT $ do register (checkMasked "release") >>= release register (checkMasked "normal") Left Dummy <- try $ runResourceT $ do register (checkMasked "exception") liftIO $ throwIO Dummy return () describe "mkAcquireType" $ do describe "ResourceT" $ do it "early" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just runResourceT $ do (releaseKey, ()) <- allocateAcquire acq release releaseKey readIORef ref >>= (`shouldBe` Just ReleaseEarly) it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just runResourceT $ do (_releaseKey, ()) <- allocateAcquire acq return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ runResourceT $ do (_releaseKey, ()) <- allocateAcquire acq liftIO $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) describe "with" $ do it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just with acq $ const $ return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ with acq $ const $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) describe "withEx" $ do it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just withEx acq $ const $ return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ withEx acq $ const $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) data Dummy = Dummy deriving (Show, Typeable) instance Exception Dummy