resourcet 1.1.2.3 → 1.3.0
raw patch · 9 files changed
Files
- ChangeLog.md +122/−0
- Control/Monad/Trans/Resource.hs +95/−119
- Control/Monad/Trans/Resource/Internal.hs +134/−63
- Data/Acquire.hs +68/−9
- Data/Acquire/Internal.hs +46/−27
- README.md +322/−0
- UnliftIO/Resource.hs +39/−0
- resourcet.cabal +14/−15
- test/main.hs +91/−36
+ ChangeLog.md view
@@ -0,0 +1,122 @@+# ChangeLog for resourcet++## 1.3.0++* Include the exception in ReleaseTypes indicating exceptional exit.++ Only backwards-incompatible in code relying on instances of ReleaseType+ other than Show, or constructing ReleaseException directly.++## 1.2.6++* Add `allocateU` [#490](https://github.com/snoyberg/conduit/pull/490)++## 1.2.5++* Support `transformers-0.6` / `mtl-2.3`++## 1.2.4.3++* Fix a space leak when using `forever` with `ResourceT`. [#470](https://github.com/snoyberg/conduit/pull/470)++## 1.2.4.2++* Mask exceptions in `Acquire` allocation action++## 1.2.4.1++* Document risk of using `forkIO` within a `ResourceT` [#441](https://github.com/snoyberg/conduit/pull/441)++## 1.2.4++* Add `allocate_` [#437](https://github.com/snoyberg/conduit/pull/437)++## 1.2.3++* Support `unliftio-core` 0.2.0.0++## 1.2.2++* Add `MonadFail` instance for `ResourceT`.++## 1.2.1++* Support `exceptions-0.10`.++## 1.2.0++* Drop `monad-control` and `mmorph` dependencies+* Change behavior of `runResourceT` to match `runResourceTChecked`++## 1.1.11++* `runResourceTChecked`, which checks if any of the cleanup actions+ threw exceptions and, if so, rethrows them. __NOTE__ This is+ probably a much better choice of function than `runResourceT`, and+ in the next major version release, will become the new behavior of+ `runResourceT`.++## 1.1.10++* Added `MonadUnliftIO` instances and `UnliftIO.Resource`++## 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.
Control/Monad/Trans/Resource.hs view
@@ -6,13 +6,10 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ImpredicativeTypes #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-}-#endif -- | Allocate resources which are guaranteed to be released. ----- For more information, see <http://www.yesodweb.com/book/conduits>.+-- For more information, see <https://github.com/snoyberg/conduit/tree/master/resourcet#readme>. -- -- 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@@ -24,13 +21,18 @@ , ReleaseKey -- * Unwrap , runResourceT+ -- ** Check cleanup exceptions+ , runResourceTChecked+ , ResourceCleanupException (..) -- * Special actions+ , resourceForkWith , resourceForkIO -- * Monad transformation , transResourceT , joinResourceT -- * Registering/releasing , allocate+ , allocate_ , register , release , unprotect@@ -41,7 +43,7 @@ -- ** Low-level , InvalidAccess (..) -- * Re-exports- , MonadBaseControl+ , MonadUnliftIO -- * Internal state -- $internalState , InternalState@@ -50,52 +52,20 @@ , withInternalState , createInternalState , closeInternalState- -- * Backwards compatibility- , ExceptionT (..)- , runExceptionT- , runExceptionT_- , runException- , runException_+ -- * Reexport , 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 Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO) import qualified Control.Exception as E-import Data.Monoid (Monoid)-import qualified Control.Exception.Lifted as L -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.Reader ( ReaderT )-import Control.Monad.Trans.State ( StateT )-import Control.Monad.Trans.Writer ( WriterT ) import Control.Monad.Trans.Resource.Internal-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.Concurrent (ThreadId, forkIO) -import Control.Monad.ST (ST)--import qualified Control.Monad.ST.Lazy as Lazy--import Data.Functor.Identity (Identity, runIdentity)-import Control.Monad.Morph import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Catch.Pure (CatchT, runCatchT) import Data.Acquire.Internal (ReleaseType (..)) @@ -112,12 +82,12 @@ -- -- Since 0.3.0 release :: MonadIO m => ReleaseKey -> m ()-release (ReleaseKey istate rk) = liftIO $ release' istate rk +release (ReleaseKey istate rk) = liftIO $ release' istate rk (maybe (return ()) id) --- | Unprotect resource from cleanup actions, this allowes you to send+-- | Unprotect resource from cleanup actions; this allows 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 +-- It returns a release action that should be run in order to clean -- resource or Nothing in case if resource is already freed. -- -- Since 0.4.5@@ -137,6 +107,22 @@ -> m (ReleaseKey, a) allocate a = liftResourceT . allocateRIO a +-- | Perform some allocation where the return value is not required, and+-- automatically register a cleanup action.+--+-- @allocate_@ is to @allocate@ as @bracket_@ is to @bracket@+--+-- This is almost identical to calling the allocation and then+-- @register@ing the release action, but this properly handles masking of+-- asynchronous exceptions.+--+-- @since 1.2.4+allocate_ :: MonadResource m+ => IO a -- ^ allocate+ -> IO () -- ^ free resource+ -> m ReleaseKey+allocate_ a = fmap fst . allocate a . const+ -- | Perform asynchronous exception masking. -- -- This is more general then @Control.Exception.mask@, yet more efficient@@ -144,11 +130,11 @@ -- -- Since 0.3.0 resourceMask :: MonadResource m => ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> m b-resourceMask = liftResourceT . resourceMaskRIO+resourceMask r = liftResourceT (resourceMaskRIO r) allocateRIO :: IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a)-allocateRIO acquire rel = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do- a <- restore acquire+allocateRIO acquire rel = ResourceT $ \istate -> liftIO $ E.mask_ $ do+ a <- acquire key <- register' istate $ rel a return (key, a) @@ -195,33 +181,41 @@ -- 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+-- /NOTE/ Since version 1.2.0, this function will throw a+-- 'ResourceCleanupException' if any of the cleanup functions throw an+-- exception.+--+-- @since 0.3.0+runResourceT :: MonadUnliftIO m => ResourceT m a -> m a+runResourceT (ResourceT r) = withRunInIO $ \run -> do istate <- createInternalState E.mask $ \restore -> do- res <- restore (run (r istate)) `E.onException`- stateCleanup ReleaseException istate- stateCleanup ReleaseNormal istate+ res <- restore (run (r istate)) `E.catch` \e -> do+ stateCleanupChecked (Just e) istate+ E.throwIO e+ stateCleanupChecked Nothing istate return res -bracket_ :: MonadBaseControl IO m+-- | Backwards compatible alias for 'runResourceT'.+--+-- @since 1.1.11+runResourceTChecked :: MonadUnliftIO m => ResourceT m a -> m a+runResourceTChecked = runResourceT+{-# INLINE runResourceTChecked #-}++bracket_ :: MonadUnliftIO m => IO () -- ^ allocate -> IO () -- ^ normal cleanup- -> IO () -- ^ exceptional cleanup+ -> (E.SomeException -> IO ()) -- ^ exceptional cleanup -> m a -> m a bracket_ alloc cleanupNormal cleanupExc inside =- control $ \run -> E.mask $ \restore -> do+ withRunInIO $ \run -> E.mask $ \restore -> do alloc- res <- restore (run inside) `E.onException` cleanupExc+ res <- restore (run inside) `E.catch` (\e -> cleanupExc e >> E.throwIO e) 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@. --@@ -230,46 +224,29 @@ -> 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 @resourceForkIO@ from there.+-- a new @ResourceT@ block and then call @resourceForkWith@ from there. ----- Since 0.3.0-resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId-resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->+-- @since 1.1.9+resourceForkWith+ :: MonadUnliftIO m+ => (IO () -> IO a)+ -> ResourceT m ()+ -> ResourceT m a+resourceForkWith g (ResourceT f) =+ ResourceT $ \r -> withRunInIO $ \run -> E.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@@ -277,41 +254,44 @@ bracket_ (stateAlloc r) (return ())- (return ())- (liftBaseDiscard forkIO $ bracket_+ (const $ return ())+ (g $ bracket_ (return ()) (stateCleanup ReleaseNormal r)- (stateCleanup ReleaseException r)- (restore $ f r))--+ (\e -> stateCleanup (ReleaseExceptionWith e) r)+ (restore $ run $ f r)) --- | A @Monad@ which can be used as a base for a @ResourceT@.+-- | Launch a new reference counted resource context using @forkIO@. ----- A @ResourceT@ has some restrictions on its base monad:+-- This is defined as @resourceForkWith forkIO@. ----- * @runResourceT@ requires an instance of @MonadBaseControl IO@.--- * @MonadResource@ requires an instance of @MonadThrow@, @MonadIO@, and @Applicative@.+-- Note: Using regular 'forkIO' inside of a 'ResourceT' is inherently unsafe,+-- since the forked thread may try access the resources of the parent after they are cleaned up.+-- When you use 'resourceForkIO' or 'resourceForkWith', 'ResourceT' is made aware of the new thread, and will only cleanup resources when all threads finish.+-- Other concurrency mechanisms, like 'concurrently' or 'race', are safe to use. ----- 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.+-- If you encounter 'InvalidAccess' exceptions ("The mutable state is being accessed after cleanup"),+-- use of 'forkIO' is a possible culprit. ----- Instead, this typeclass acts as a proxy for the other five. Its only purpose--- is to make your type signatures shorter.+-- @since 0.3.0+resourceForkIO :: MonadUnliftIO m => ResourceT m () -> ResourceT m ThreadId+resourceForkIO = resourceForkWith forkIO++-- | Just use 'MonadUnliftIO' directly now, legacy explanation continues: --+-- 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 @MonadUnliftIO@.+-- * @MonadResource@ requires an instance of @MonadIO@+-- -- 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+type MonadResourceBase = MonadUnliftIO+{-# DEPRECATED MonadResourceBase "Use MonadUnliftIO directly instead" #-} -- $internalState --@@ -327,16 +307,16 @@ -- Caveat emptor! -- -- Since 0.4.9-createInternalState :: MonadBase IO m => m InternalState-createInternalState = liftBase+createInternalState :: MonadIO m => m InternalState+createInternalState = liftIO $ 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+closeInternalState :: MonadIO m => InternalState -> m ()+closeInternalState = liftIO . stateCleanup ReleaseNormal -- | Get the internal state of the current @ResourceT@. --@@ -360,7 +340,3 @@ -- 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
Control/Monad/Trans/Resource/Internal.hs view
@@ -20,14 +20,17 @@ , transResourceT , register' , registerType+ , ResourceCleanupException (..)+ , stateCleanupChecked ) where import Control.Exception (throw,Exception,SomeException)-import Control.Applicative (Applicative (..))-import Control.Monad.Trans.Control- ( MonadTransControl (..), MonadBaseControl (..)- , ComposeSt, defaultLiftBaseWith, defaultRestoreM, control)-import Control.Monad.Base (MonadBase, liftBase)+import Control.Applicative (Applicative (..), Alternative(..))+import Control.Monad (MonadPlus(..))+import Control.Monad.Fail (MonadFail(..))+import Control.Monad.Fix (MonadFix(..))+import Control.Monad.IO.Unlift+import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) )@@ -37,9 +40,11 @@ import Control.Monad.Writer.Class ( MonadWriter (..) ) import Control.Monad.Trans.Identity ( IdentityT)+#if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.List ( ListT )+#endif 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 )@@ -50,51 +55,30 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad (liftM, ap)+import Control.Monad.Primitive (PrimMonad (..)) import qualified Control.Exception as E-import Control.Monad.ST (ST)-import Control.Monad.Catch (MonadThrow (..), MonadCatch (..)-#if MIN_VERSION_exceptions(0,6,0)- , MonadMask (..)-#endif- )++-- FIXME Do we want to only support MonadThrow?+import Control.Monad.Catch (MonadThrow (..), MonadCatch (..), MonadMask (..)) 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 (..)) -#if __GLASGOW_HASKELL__ >= 704-import Control.Monad.ST.Unsafe (unsafeIOToST)-#else-import Control.Monad.ST (unsafeIOToST)-#endif--#if __GLASGOW_HASKELL__ >= 704-import qualified Control.Monad.ST.Lazy.Unsafe as LazyUnsafe-#else-import qualified Control.Monad.ST.Lazy as LazyUnsafe-#endif--import qualified Control.Monad.ST.Lazy as Lazy--import Control.Monad.Morph- -- | A @Monad@ which allows for safe resource allocation. In theory, any monad--- transformer stack included a @ResourceT@ can be an instance of+-- transformer stack which includes a @ResourceT@ can be an instance of -- @MonadResource@. ----- Note: @runResourceT@ has a requirement for a @MonadBaseControl IO m@ monad,+-- Note: @runResourceT@ has a requirement for a @MonadUnliftIO 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+class MonadIO m => MonadResource m where -- | Lift a @ResourceT IO@ action into the current @Monad@. -- -- Since 0.4.0@@ -116,7 +100,7 @@ | ReleaseMapClosed -- | Convenient alias for @ResourceT IO@.-type ResIO a = ResourceT IO a+type ResIO = ResourceT IO instance MonadCont m => MonadCont (ResourceT m) where@@ -149,16 +133,29 @@ 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+#if MIN_VERSION_exceptions(0, 10, 0)+ generalBracket acquire release use =+ ResourceT $ \r ->+ generalBracket+ ( unResourceT acquire r )+ ( \resource exitCase ->+ unResourceT ( release resource exitCase ) r+ )+ ( \resource -> unResourceT ( use resource ) r )+#elif MIN_VERSION_exceptions(0, 9, 0)+#error exceptions 0.9.0 is not supported+#endif+instance MonadIO m => MonadResource (ResourceT m) where liftResourceT = transResourceT liftIO+instance PrimMonad m => PrimMonad (ResourceT m) where+ type PrimState (ResourceT m) = PrimState m+ primitive = lift . primitive -- | 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@.@@ -171,13 +168,6 @@ -> 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@@ -232,43 +222,58 @@ pure = ResourceT . const . pure ResourceT mf <*> ResourceT ma = ResourceT $ \r -> mf r <*> ma r+ ResourceT mf *> ResourceT ma = ResourceT $ \r ->+ mf r *> ma r+ 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- return = ResourceT . const . return+ return = pure ResourceT ma >>= f = ResourceT $ \r -> do a <- ma r let ResourceT f' = f a f' r +-- | @since 1.2.2+instance MonadFail m => MonadFail (ResourceT m) where+ fail = lift . Control.Monad.Fail.fail++-- | @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- newtype StT ResourceT a = StReader {unStReader :: a}- liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r- restoreT = ResourceT . const . liftM unStReader- {-# INLINE liftWith #-}- {-# INLINE restoreT #-}--instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where- 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+-- | @since 1.1.10+instance MonadUnliftIO m => MonadUnliftIO (ResourceT m) where+ {-# INLINE withRunInIO #-}+ withRunInIO inner =+ ResourceT $ \r ->+ withRunInIO $ \run ->+ inner (run . flip unResourceT r) #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)+#if !MIN_VERSION_transformers(0,6,0) GO(ListT)+#endif GO(MaybeT)-GOX(Error e, ErrorT e)+GO(ExceptT e) GO(ReaderT r) GO(ContT r) GO(StateT s)@@ -330,3 +335,69 @@ , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'"++-- | Thrown when one or more cleanup functions themselves throw an+-- exception during cleanup.+--+-- @since 1.1.11+data ResourceCleanupException = ResourceCleanupException+ { rceOriginalException :: !(Maybe SomeException)+ -- ^ If the 'ResourceT' block exited due to an exception, this is+ -- that exception.+ --+ -- @since 1.1.11+ , rceFirstCleanupException :: !SomeException+ -- ^ The first cleanup exception. We keep this separate from+ -- 'rceOtherCleanupExceptions' to prove that there's at least one+ -- (i.e., a non-empty list).+ --+ -- @since 1.1.11+ , rceOtherCleanupExceptions :: ![SomeException]+ -- ^ All other exceptions in cleanups.+ --+ -- @since 1.1.11+ }+ deriving (Show, Typeable)+instance Exception ResourceCleanupException++-- | Clean up a release map, but throw a 'ResourceCleanupException' if+-- anything goes wrong in the cleanup handlers.+--+-- @since 1.1.11+stateCleanupChecked+ :: Maybe SomeException -- ^ exception that killed the 'ResourceT', if present+ -> I.IORef ReleaseMap -> IO ()+stateCleanupChecked morig 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 "stateCleanupChecked"+ case mm of+ Just m -> do+ res <- mapMaybeReverseM (\x -> try (x rtype)) $ IntMap.elems m+ case res of+ [] -> return () -- nothing went wrong+ e:es -> E.throwIO $ ResourceCleanupException morig e es+ Nothing -> return ()+ where+ try :: IO () -> IO (Maybe SomeException)+ try io = fmap (either Just (\() -> Nothing)) (E.try io)++ rtype = maybe ReleaseNormal ReleaseExceptionWith morig++-- Note that this returns values in reverse order, which is what we+-- want in the specific case of this function.+mapMaybeReverseM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeReverseM f =+ go []+ where+ go bs [] = return bs+ go bs (a:as) = do+ mb <- f a+ case mb of+ Nothing -> go bs as+ Just b -> go (b:bs) as
Data/Acquire.hs view
@@ -1,8 +1,66 @@+{-# LANGUAGE CPP #-} -- | 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+-- * Example usage of 'Acquire' for allocating a resource and freeing it up.+--+-- | The code makes use of 'mkAcquire' to create an 'Acquire' and uses 'allocateAcquire' to allocate the resource and register an action to free up the resource.+--+-- === __Reproducible Stack code snippet__+--+-- > #!/usr/bin/env stack+-- > {- stack+-- > --resolver lts-10.0+-- > --install-ghc+-- > runghc+-- > --package resourcet+-- > -}+-- > +-- > {-#LANGUAGE ScopedTypeVariables#-}+-- > +-- > import Data.Acquire+-- > import Control.Monad.Trans.Resource+-- > import Control.Monad.IO.Class+-- > +-- > main :: IO ()+-- > main = runResourceT $ do+-- > let (ack :: Acquire Int) = mkAcquire (do+-- > putStrLn "Enter some number"+-- > readLn) (\i -> putStrLn $ "Freeing scarce resource: " ++ show i)+-- > (releaseKey, resource) <- allocateAcquire ack+-- > doSomethingDangerous resource+-- > liftIO $ putStrLn $ "Going to release resource immediately: " ++ show resource+-- > release releaseKey+-- > somethingElse+-- > +-- > doSomethingDangerous :: Int -> ResourceT IO ()+-- > doSomethingDangerous i =+-- > liftIO $ putStrLn $ "5 divided by " ++ show i ++ " is " ++ show (5 `div` i)+-- > +-- > somethingElse :: ResourceT IO () +-- > somethingElse = liftIO $ putStrLn+-- > "This could take a long time, don't delay releasing the resource!"+--+-- Execution output:+--+-- > ~ $ stack code.hs+-- > Enter some number+-- > 3+-- > 5 divided by 3 is 1+-- > Going to release resource immediately: 3+-- > Freeing scarce resource: 3+-- > This could take a long time, don't delay releasing the resource!+-- >+-- > ~ $ stack code.hs+-- > Enter some number+-- > 0+-- > 5 divided by 0 is Freeing scarce resource: 0+-- > code.hs: divide by zero+-- , with+ , withAcquire , mkAcquire , mkAcquireType , allocateAcquire@@ -10,20 +68,14 @@ ) 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)+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO)+import qualified Control.Exception as E -- | Allocate a resource and register an action with the @MonadResource@ to -- free the resource. ----- Since 1.1.0+-- @since 1.1.0 allocateAcquire :: MonadResource m => Acquire a -> m (ReleaseKey, a) allocateAcquire = liftResourceT . allocateAcquireRIO @@ -32,3 +84,10 @@ Allocated a free <- f restore key <- registerType istate free return (key, a)++-- | Longer name for 'with', in case @with@ is not obvious enough in context.+--+-- @since 1.2.0+withAcquire :: MonadUnliftIO m => Acquire a -> (a -> m b) -> m b+withAcquire = with+{-# INLINE withAcquire #-}
Data/Acquire/Internal.hs view
@@ -1,38 +1,44 @@ {-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-} module Data.Acquire.Internal ( Acquire (..) , Allocated (..) , with , mkAcquire- , ReleaseType (..)+ , ReleaseType (.., ReleaseException) , 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 Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)+import qualified Control.Exception as E import Data.Typeable (Typeable) import Control.Monad (liftM, ap)+import qualified Control.Monad.Catch as C () -- | The way in which a release is called. ----- Since 1.1.2+-- @since 1.1.2 data ReleaseType = ReleaseEarly | ReleaseNormal- | ReleaseException- deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable)+ | ReleaseExceptionWith E.SomeException+ deriving (Show, Typeable) +{-# COMPLETE ReleaseEarly, ReleaseNormal, ReleaseException #-}+{-# DEPRECATED ReleaseException "Use `ReleaseExceptionWith`, which has the exception in the constructor. This pattern synonym hides the exception and can obscure problems." #-}+pattern ReleaseException :: ReleaseType+pattern ReleaseException <- ReleaseExceptionWith _+ 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+-- @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@). --@@ -41,22 +47,22 @@ -- implementation in this package is slightly different, due to taking a -- different approach to async exception safety. ----- Since 1.1.0+-- @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 = return+ pure a = Acquire (\_ -> return (Allocated a (const $ return ()))) (<*>) = ap instance Monad Acquire where- return a = Acquire (\_ -> return (Allocated a (const $ return ())))+ 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+ Allocated y free2 <- g restore `E.catch` (\e -> free1 (ReleaseExceptionWith e) >> E.throwIO e) return $! Allocated y (\rt -> free2 rt `E.finally` free1 rt) instance MonadIO Acquire where@@ -64,30 +70,43 @@ 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+-- To acquire and free the resource in an arbitrary monad with `MonadUnliftIO`,+-- do the following:+--+-- > acquire <- withRunInIO $ \runInIO ->+-- > return $ mkAcquire (runInIO create) (runInIO . free)+--+-- Note that this is only safe if the Acquire is run and freed within the same+-- monadic scope it was created in.+--+-- @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)+mkAcquire create free = mkAcquireType create (\a _ -> free a) -- | 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+-- To acquire and free the resource in an arbitrary monad with `MonadUnliftIO`,+-- do the following:+--+-- > acquire <- withRunInIO $ \runInIO ->+-- > return $ mkAcquireType (runInIO create) (\a -> runInIO . free a)+--+-- Note that this is only safe if the Acquire is run and freed within the same+-- monadic scope it was created in.+--+-- @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+mkAcquireType create free = Acquire $ \_ -> do+ x <- create return $! Allocated x (free x) -- | Allocate the given resource and provide it to the provided function. The@@ -95,13 +114,13 @@ -- normally or via an exception. This function is similar in function to -- @bracket@. ----- Since 1.1.0-with :: MonadBaseControl IO m+-- @since 1.1.0+with :: MonadUnliftIO m => Acquire a -> (a -> m b) -> m b-with (Acquire f) g = control $ \run -> E.mask $ \restore -> do+with (Acquire f) g = withRunInIO $ \run -> E.mask $ \restore -> do Allocated x free <- f restore- res <- run (g x) `E.onException` free ReleaseException+ res <- restore (run (g x)) `E.catch` (\e -> free (ReleaseExceptionWith e) >> E.throwIO e) free ReleaseNormal return res
+ README.md view
@@ -0,0 +1,322 @@+## 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+#!/usr/bin/env stack+{- stack+ --resolver lts-9.0+ --install-ghc+ runghc+ --package resourcet+-}++import Control.Monad.Trans.Resource+import Control.Monad.IO.Class++main :: IO ()+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 :: Int -> ResourceT IO ()+doSomethingDangerous i =+ liftIO $ putStrLn $ "5 divided by " ++ show i ++ " is " ++ show (5 `div` i)++somethingElse :: ResourceT IO () +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 is printed. ++``` shellsession+~ $ stack code.hs+Enter some number+3+5 divided by 3 is 1+Going to release resource immediately: 3+Freeing scarce resource: 3+This could take a long time, don't delay releasing the resource!++~ $ stack code.hs+Enter some number+0+5 divided by 0 is Freeing scarce resource: 0+code.hs: divide by zero+```++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 :: IO ()+main = do+ bracket+ (do+ putStrLn "Enter some number"+ readLn)+ (\i -> putStrLn $ "Freeing scarce resource: " ++ show i)+ doSomethingDangerous+ somethingElse++doSomethingDangerous :: Int -> IO ()+doSomethingDangerous i =+ putStrLn $ "5 divided by " ++ show i ++ " is " ++ show (5 `div` i)++somethingElse :: IO ()+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+#!/usr/bin/env stack+{- stack+ --resolver lts-9.0+ --install-ghc+ runghc+ --package resourcet+-}++{-# LANGUAGE FlexibleContexts #-}++import Control.Monad.Trans.Resource+import Control.Monad.Trans.Class+import Control.Monad.IO.Class (MonadIO)++bracket ::+ (MonadThrow m, MonadBaseControl IO m,+ MonadIO m) =>+ IO t -> (t -> IO ()) -> (t -> m a) -> m a+bracket alloc free inside = runResourceT $ do+ (releaseKey, resource) <- allocate alloc free+ lift $ inside resource++main :: IO ()+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+#!/usr/bin/env stack+{- stack+ --resolver lts-10.0+ --install-ghc+ runghc+ --package resourcet+ --package conduit+ --package directory+-}++{-#LANGUAGE FlexibleContexts#-}+{-#LANGUAGE RankNTypes#-}++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource (runResourceT, ResourceT, MonadResource)+import Data.Conduit (Producer, Consumer,addCleanup, (.|))+import Conduit (runConduitRes)+import Data.Conduit.Binary (isolate, sinkFile, sourceFile)+import Data.Conduit.List (peek)+import Data.Conduit.Zlib (gzip)+import System.Directory (createDirectoryIfMissing)+import qualified Data.ByteString as B++-- show all of the files we'll read from+infiles :: [String]+infiles = map (\i -> "input/" ++ show i ++ ".bin") [1..10]++-- Generate a filename to write to+outfile :: Int -> String+outfile i = "output/" ++ show i ++ ".gz"++-- Modified sourceFile and sinkFile that print when they are opening and+-- closing file handles, to demonstrate interleaved allocation.+sourceFileTrace :: (MonadResource m) => FilePath -> Producer m B.ByteString+sourceFileTrace fp = do+ liftIO $ putStrLn $ "Opening: " ++ fp+ addCleanup (const $ liftIO $ putStrLn $ "Closing: " ++ fp) (sourceFile fp)++sinkFileTrace :: (MonadResource m) => FilePath -> Consumer B.ByteString m ()+sinkFileTrace fp = do+ liftIO $ putStrLn $ "Opening: " ++ fp+ addCleanup (const $ liftIO $ putStrLn $ "Closing: " ++ fp) (sinkFile fp)++-- Monad instance of Producer allows us to simply mapM_ to create a single Source+-- for reading all of the files sequentially.+source :: (MonadResource m) => Producer m B.ByteString+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 :: (MonadResource m) => Consumer B.ByteString m ()+sink =+ loop 1+ where+ loop i = do+ isolate (30 * 1024) .| sinkFileTrace (outfile i)+ mx <- peek+ case mx of+ Nothing -> return ()+ Just _ -> loop (i + 1)++fillRandom :: FilePath -> IO ()+fillRandom fp = runConduitRes $ + sourceFile "/dev/urandom" + .| isolate (50 * 1024) + .| sinkFile fp++-- Putting it all together is trivial. ResourceT guarantees we have exception+-- safety.+transform :: IO ()+transform = runConduitRes $ source .| gzip .| sink+-- /show++-- Just some setup for running our test.+main :: IO ()+main = do+ createDirectoryIfMissing True "input"+ createDirectoryIfMissing True "output"+ mapM_ fillRandom infiles+ transform+```++## 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+#!/usr/bin/env stack+{- stack+ --resolver lts-10.0+ --install-ghc+ runghc+ --package conduit+ --package resourcet+-}++{-#LANGUAGE FlexibleContexts#-}++import Data.Conduit+import Data.Conduit.Binary++fileCopy :: FilePath -> FilePath -> IO ()+fileCopy src dst = runConduitRes $ sourceFile src .| sinkFile dst++main :: IO ()+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+#!/usr/bin/env stack+{- stack+ --resolver lts-10.0+ --install-ghc+ runghc+ --package conduit+-}++import Data.Conduit+import Data.Conduit.Binary+import System.IO++fileCopy :: FilePath -> FilePath -> IO ()+fileCopy src dst = withFile src ReadMode $ \srcH ->+ withFile dst WriteMode $ \dstH ->+ sourceHandle srcH $$ sinkHandle dstH++main :: IO ()+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. For understanding how it works under the hood, refer [here](https://www.fpcomplete.com/blog/2017/06/understanding-resourcet).
+ UnliftIO/Resource.hs view
@@ -0,0 +1,39 @@+-- | Unlifted "Control.Monad.Trans.Resource".+--+-- @since 1.1.10+module UnliftIO.Resource+ ( -- * UnliftIO variants+ runResourceT+ , liftResourceT+ , allocateU+ -- * Reexports+ , module Control.Monad.Trans.Resource+ ) where++import qualified Control.Monad.Trans.Resource as Res+import Control.Monad.Trans.Resource.Internal (ResourceT (..))+import Control.Monad.IO.Unlift+import Control.Monad.Trans.Resource (ResourceT, ReleaseKey, allocate, register, release, unprotect, MonadResource)++-- | Unlifted version of 'Res.runResourceT'.+--+-- @since 1.1.10+runResourceT :: MonadUnliftIO m => ResourceT m a -> m a+runResourceT m = withRunInIO $ \run -> Res.runResourceT $ Res.transResourceT run m++-- | Lifted version of 'Res.liftResourceT'.+--+-- @since 1.1.10+liftResourceT :: MonadIO m => ResourceT IO a -> ResourceT m a+liftResourceT (ResourceT f) = ResourceT $ liftIO . f++-- | Unlifted 'allocate'.+--+-- @since 1.2.6+allocateU+ :: (MonadUnliftIO m, MonadResource m)+ => m a+ -> (a -> m ())+ -> m (ReleaseKey, a)+allocateU alloc free = withRunInIO $ \run ->+ run $ allocate (run alloc) (run . free)
resourcet.cabal view
@@ -1,44 +1,43 @@ Name: resourcet-Version: 1.1.2.3+Version: 1.3.0 Synopsis: Deterministic allocation and freeing of scarce resources.-Description:- A full tutorial is available at <https://www.fpcomplete.com/user/snoyberg/library-documentation/resourcet>.- .- This package was originally included with the conduit package, but has existed as a separate package for quite a while. It is fully usable outside of conduit.+description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/resourcet>. License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit Build-type: Simple-Cabal-version: >=1.8+Cabal-version: >=1.10 Homepage: http://github.com/snoyberg/conduit+extra-source-files: ChangeLog.md, README.md Library+ default-language: Haskell2010 Exposed-modules: Control.Monad.Trans.Resource Control.Monad.Trans.Resource.Internal Data.Acquire Data.Acquire.Internal- Build-depends: base >= 4.3 && < 5- , lifted-base >= 0.1- , transformers-base >= 0.4.1 && < 0.5- , monad-control >= 0.3.1 && < 0.4+ UnliftIO.Resource+ Build-depends: base >= 4.12 && < 5 , containers- , transformers >= 0.2.2 && < 0.5- , mtl >= 2.0 && < 2.3- , mmorph- , exceptions >= 0.5+ , transformers >= 0.4+ , mtl >= 2.0 && < 2.4+ , exceptions (== 0.8.* || == 0.10.*)+ , unliftio-core >= 0.1.1.0+ , primitive ghc-options: -Wall test-suite test+ default-language: Haskell2010 hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: resourcet , base+ , exceptions , hspec >= 1.3- , lifted-base , transformers ghc-options: -Wall
test/main.hs view
@@ -2,11 +2,11 @@ {-# LANGUAGE ScopedTypeVariables #-} import Control.Concurrent-import Control.Concurrent.Lifted (fork) import Control.Exception (Exception, MaskingState (MaskedInterruptible),- getMaskingState, throwIO, try)+ getMaskingState, throwIO, try, fromException) import Control.Exception (SomeException, handle)-import Control.Monad (unless)+import Control.Monad (unless, void)+import qualified Control.Monad.Catch import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource import Data.IORef@@ -18,7 +18,7 @@ main = hspec $ do describe "general" $ do it "survives releasing bottom" $ do- x <- newIORef 0+ x <- newIORef (0 :: Int) handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do _ <- register $ writeIORef x 1 release undefined@@ -26,19 +26,44 @@ x' `shouldBe` 1 describe "early release" $ do it "works from a different context" $ do- x <- newIORef 0+ x <- newIORef (0 :: Int) runResourceT $ do key <- register $ writeIORef x 1 runResourceT $ release key y <- liftIO $ readIORef x liftIO $ y `shouldBe` 1- describe "forking" $ do- forkHelper "resourceForkIO" resourceForkIO- --forkHelper "lifted fork" fork+ describe "resourceForkIO" $ do+ it "waits for all threads" $ do+ x <- newEmptyMVar+ y <- newIORef (0 :: Int)+ 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+ x <- newIORef (0 :: Int)+ _ <- runResourceT $ do key <- register $ writeIORef x 1 unprotect key y <- readIORef x@@ -48,11 +73,11 @@ ms <- getMaskingState unless (ms == MaskedInterruptible) $ error $ show (name, ms)- runResourceT $ do+ _ <- runResourceT $ do register (checkMasked "release") >>= release register (checkMasked "normal") Left Dummy <- try $ runResourceT $ do- register (checkMasked "exception")+ _ <- register (checkMasked "exception") liftIO $ throwIO Dummy return () describe "mkAcquireType" $ do@@ -63,57 +88,87 @@ runResourceT $ do (releaseKey, ()) <- allocateAcquire acq release releaseKey- readIORef ref >>= (`shouldBe` Just ReleaseEarly)+ readIORef ref >>= (`shouldSatisfy` 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)+ readIORef ref >>= (`shouldSatisfy` 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)+ readIORef ref >>= (`shouldSatisfy` just (releaseException dummy)) 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)+ readIORef ref >>= (`shouldSatisfy` 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)+ readIORef ref >>= (`shouldSatisfy` just (releaseException dummy))+ describe "runResourceTChecked" $ do+ it "catches exceptions" $ do+ eres <- try $ runResourceTChecked $ void $ register $ throwIO Dummy+ case eres of+ Right () -> error "Expected an exception"+ Left (ResourceCleanupException Nothing ex []) ->+ case fromException ex of+ Just Dummy -> return ()+ Nothing -> error "It wasn't Dummy"+ Left (ResourceCleanupException (Just _) _ []) -> error "Got a ResourceT exception"+ Left (ResourceCleanupException _ _ (_:_)) -> error "Got more than one"+ it "no exception is fine" $ (runResourceTChecked $ void $ register $ return () :: IO ())+ it "catches multiple exceptions" $ do+ eres <- try $ runResourceTChecked $ do+ void $ register $ throwIO Dummy+ void $ register $ throwIO Dummy2+ case eres of+ Right () -> error "Expected an exception"+ Left (ResourceCleanupException Nothing ex1 [ex2]) ->+ case (fromException ex1, fromException ex2) of+ (Just Dummy, Just Dummy2) -> return ()+ _ -> error $ "It wasn't Dummy, Dummy2: " ++ show (ex1, ex2)+ Left (ResourceCleanupException (Just _) _ [_]) -> error "Got a ResourceT exception"+ Left (ResourceCleanupException _ _ []) -> error "Only got 1"+ Left (ResourceCleanupException _ _ (_:_:_)) -> error "Got more than 2"+ describe "MonadMask" $+ it "works" (runResourceT $ Control.Monad.Catch.bracket (return ()) (const (return ())) (const (return ())) :: IO ()) data Dummy = Dummy deriving (Show, Typeable) instance Exception Dummy -forkHelper s fork' = describe s $ do- it "waits for all threads" $ do- x <- newEmptyMVar- y <- newIORef 0- z <- newEmptyMVar- runResourceT $ do- _ <- register $ writeIORef y 1- fork' $ do- () <- liftIO $ takeMVar x- y' <- liftIO $ readIORef y- _ <- register $ putMVar z y'- return ()+data Dummy2 = Dummy2+ deriving (Show, Typeable)+instance Exception Dummy2 - y1 <- readIORef y- y1 `shouldBe` 0+-- Helpers needed due to lack of 'Eq' on 'ReleaseType' - putMVar x ()+releaseEarly :: ReleaseType -> Bool+releaseEarly ReleaseEarly = True+releaseEarly _ = False - z' <- takeMVar z- z' `shouldBe` 0+releaseNormal :: ReleaseType -> Bool+releaseNormal ReleaseNormal = True+releaseNormal _ = False - y2 <- readIORef y- Just y2 `shouldBe` Just 1+releaseException :: (Exception e) => Selector e -> ReleaseType -> Bool+releaseException sel (ReleaseExceptionWith se) = case fromException se of+ Just e -> sel e+ Nothing -> False+releaseException _ _ = False++just :: (a -> Bool) -> Maybe a -> Bool+just sel (Just x) = sel x+just _ Nothing = False++dummy :: Selector Dummy+dummy Dummy = True