resourcet 0.4.10.2 → 1.3.0
raw patch · 9 files changed
Files
- ChangeLog.md +122/−0
- Control/Monad/Trans/Resource.hs +106/−177
- Control/Monad/Trans/Resource/Internal.hs +171/−257
- Data/Acquire.hs +93/−0
- Data/Acquire/Internal.hs +126/−0
- README.md +322/−0
- UnliftIO/Resource.hs +39/−0
- resourcet.cabal +16/−12
- test/main.hs +121/−31
+ 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,32 +21,29 @@ , ReleaseKey -- * Unwrap , runResourceT+ -- ** Check cleanup exceptions+ , runResourceTChecked+ , ResourceCleanupException (..) -- * Special actions+ , resourceForkWith , resourceForkIO -- * Monad transformation , transResourceT , joinResourceT- -- * A specific Exception transformer- , ExceptionT (..)- , runExceptionT_- , runException- , runException_ -- * Registering/releasing , allocate+ , allocate_ , register , release , unprotect , resourceMask -- * Type class/associated types , MonadResource (..)- , MonadUnsafeIO (..)- , MonadThrow (..)- , MonadActive (..) , MonadResourceBase -- ** Low-level , InvalidAccess (..) -- * Re-exports- , MonadBaseControl+ , MonadUnliftIO -- * Internal state -- $internalState , InternalState@@ -58,48 +52,21 @@ , withInternalState , createInternalState , closeInternalState- -- * Resource- , Resource- , mkResource- , with- , allocateResource+ -- * Reexport+ , 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 Data.Acquire.Internal (ReleaseType (..)) @@ -115,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@@ -140,12 +107,21 @@ -> m (ReleaseKey, a) allocate a = liftResourceT . allocateRIO a --- | Allocate a resource and register an action with the @MonadResource@ to--- free the resource.+-- | Perform some allocation where the return value is not required, and+-- automatically register a cleanup action. ----- Since 0.4.10-allocateResource :: MonadResource m => Resource a -> m (ReleaseKey, a)-allocateResource = liftResourceT . allocateResourceRIO+-- @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. --@@ -154,20 +130,14 @@ -- -- 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) -allocateResourceRIO :: Resource a -> ResourceT IO (ReleaseKey, a)-allocateResourceRIO (Resource f) = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do- Allocated a free <- f restore- key <- register' istate free- return (key, a)- registerRIO :: IO () -> ResourceT IO ReleaseKey registerRIO rel = ResourceT $ \istate -> liftIO $ register' istate rel @@ -179,19 +149,8 @@ go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a) go r (ResourceT g) = ResourceT (\i -> r (g i)) -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 rel m)- , ReleaseKey istate key- )- ReleaseMapClosed -> throw $ InvalidAccess "register'" - release' :: I.IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a)@@ -205,7 +164,7 @@ Nothing -> (rm, Nothing) Just action -> ( ReleaseMap next rf $ IntMap.delete key m- , Just action+ , 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,@@ -222,19 +181,40 @@ -- 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) = 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- r istate `finally` stateCleanup istate+ E.mask $ \restore -> do+ 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 => IO () -> IO () -> m a -> m a-bracket_ alloc cleanup inside =- control $ \run -> E.bracket_ alloc cleanup (run inside)+-- | Backwards compatible alias for 'runResourceT'.+--+-- @since 1.1.11+runResourceTChecked :: MonadUnliftIO m => ResourceT m a -> m a+runResourceTChecked = runResourceT+{-# INLINE runResourceTChecked #-} -finally :: MonadBaseControl IO m => m a -> IO () -> m a-finally action cleanup =- control $ \run -> E.finally (run action) cleanup+bracket_ :: MonadUnliftIO m+ => IO () -- ^ allocate+ -> IO () -- ^ normal cleanup+ -> (E.SomeException -> IO ()) -- ^ exceptional cleanup+ -> m a+ -> m a+bracket_ alloc cleanupNormal cleanupExc inside =+ withRunInIO $ \run -> E.mask $ \restore -> do+ alloc+ res <- restore (run inside) `E.catch` (\e -> cleanupExc e >> E.throwIO e)+ cleanupNormal+ return res -- | This function mirrors @join@ at the transformer level: it will collapse -- two levels of @ResourceT@ into a single @ResourceT@.@@ -244,41 +224,29 @@ -> ResourceT m a joinResourceT (ResourceT f) = ResourceT $ \r -> unResourceT (f r) r ----- | 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@@ -286,83 +254,44 @@ bracket_ (stateAlloc r) (return ())- (liftBaseDiscard forkIO $ bracket_+ (const $ return ())+ (g $ bracket_ (return ())- (stateCleanup r)- (restore $ f r))--+ (stateCleanup ReleaseNormal r)+ (\e -> stateCleanup (ReleaseExceptionWith e) r)+ (restore $ run $ f r)) --- | Determine if some monad is still active. This is intended to prevent usage--- of a monadic state after it has been closed. This is necessary for such--- cases as lazy I\/O, where an unevaluated thunk may still refer to a--- closed @ResourceT@.+-- | Launch a new reference counted resource context using @forkIO@. ----- Since 0.3.0-class Monad m => MonadActive m where- monadActive :: m Bool--instance (MonadIO m, MonadActive m) => MonadActive (ResourceT m) where- monadActive = ResourceT $ \rmMap -> do- rm <- liftIO $ I.readIORef rmMap- case rm of- ReleaseMapClosed -> return False- _ -> monadActive -- recurse--instance MonadActive Identity where- monadActive = return True--instance MonadActive IO where- monadActive = return True--instance MonadActive (ST s) where- monadActive = return True--instance MonadActive (Lazy.ST s) where- monadActive = return True--#define GO(T) instance MonadActive m => MonadActive (T m) where monadActive = lift monadActive-#define GOX(X, T) instance (X, MonadActive m) => MonadActive (T m) where monadActive = lift monadActive-GO(IdentityT)-GO(ListT)-GO(MaybeT)-GOX(Error e, ErrorT e)-GO(ReaderT 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---- | A @Monad@ which can be used as a base for a @ResourceT@.+-- This is defined as @resourceForkWith forkIO@. ----- A @ResourceT@ has some restrictions on its base monad:+-- 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. ----- * @runResourceT@ requires an instance of @MonadBaseControl IO@.--- * @MonadResource@ requires an instance of @MonadThrow@, @MonadUnsafeIO@, @MonadIO@, and @Applicative@.+-- If you encounter 'InvalidAccess' exceptions ("The mutable state is being accessed after cleanup"),+-- use of 'forkIO' is a possible culprit. ----- 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.+-- @since 0.3.0+resourceForkIO :: MonadUnliftIO m => ResourceT m () -> ResourceT m ThreadId+resourceForkIO = resourceForkWith forkIO++-- | Just use 'MonadUnliftIO' directly now, legacy explanation continues: ----- Instead, this typeclass acts as a proxy for the other five. Its only purpose--- is to make your type signatures shorter.+-- 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, MonadUnsafeIO m, MonadIO m, Applicative m)-#else-class (MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResourceBase m-instance (MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResourceBase m-#endif+type MonadResourceBase = MonadUnliftIO+{-# DEPRECATED MonadResourceBase "Use MonadUnliftIO directly instead" #-} -- $internalState --@@ -378,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+closeInternalState :: MonadIO m => InternalState -> m ()+closeInternalState = liftIO . stateCleanup ReleaseNormal -- | Get the internal state of the current @ResourceT@. --
Control/Monad/Trans/Resource/Internal.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-}@@ -8,11 +9,8 @@ {-# LANGUAGE RankNTypes #-} module Control.Monad.Trans.Resource.Internal(- ExceptionT(..)- , InvalidAccess(..)+ InvalidAccess(..) , MonadResource(..)- , MonadThrow(..)- , MonadUnsafeIO(..) , ReleaseKey(..) , ReleaseMap(..) , ResIO@@ -20,18 +18,19 @@ , stateAlloc , stateCleanup , transResourceT- , Resource (..)- , Allocated (..)- , with- , mkResource+ , 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 (..) )@@ -41,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 )@@ -54,44 +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)++-- 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)--#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+import Data.Acquire.Internal (ReleaseType (..)) -- | 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, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResource m where+class MonadIO m => MonadResource m where -- | Lift a @ResourceT IO@ action into the current @Monad@. -- -- Since 0.4.0@@ -109,11 +96,11 @@ type NextKey = Int data ReleaseMap =- ReleaseMap !NextKey !RefCount !(IntMap (IO ()))+ ReleaseMap !NextKey !RefCount !(IntMap (ReleaseType -> IO ())) | ReleaseMapClosed -- | Convenient alias for @ResourceT IO@.-type ResIO a = ResourceT IO a+type ResIO = ResourceT IO instance MonadCont m => MonadCont (ResourceT m) where@@ -141,44 +128,34 @@ listen = mapResourceT listen pass = mapResourceT pass --- | A @Monad@ which can throw exceptions. Note that this does not work in a--- vanilla @ST@ or @Identity@ monad. Instead, you should use the 'ExceptionT'--- transformer in your stack if you are dealing with a non-@IO@ base monad.------ Since 0.3.0-class Monad m => MonadThrow m where- monadThrow :: E.Exception e => e -> m a--instance MonadThrow IO where- monadThrow = E.throwIO--instance MonadThrow Maybe where- monadThrow _ = Nothing-instance MonadThrow (Either SomeException) where- monadThrow = Left . E.toException-instance MonadThrow [] where- monadThrow _ = []--#define GO(T) instance (MonadThrow m) => MonadThrow (T m) where monadThrow = lift . monadThrow-#define GOX(X, T) instance (X, MonadThrow m) => MonadThrow (T m) where monadThrow = lift . monadThrow-GO(IdentityT)-GO(ListT)-GO(MaybeT)-GOX(Error e, ErrorT e)-GO(ReaderT r)-GO(ContT r)-GO(ResourceT)-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--instance (MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResource (ResourceT m) where+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+instance MonadMask m => MonadMask (ResourceT m) where+ 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)+#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@.@@ -191,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@@ -252,49 +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-instance Monad m => MonadThrow (ExceptionT m) where- monadThrow = ExceptionT . return . Left . E.toException-instance MonadResource m => MonadResource (ExceptionT m) where- liftResourceT = lift . liftResourceT-instance MonadIO m => MonadIO (ExceptionT m) where- liftIO = lift . liftIO+-- | @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)@@ -306,13 +285,6 @@ #undef GO #undef GOX ---- | The express purpose of this transformer is to allow non-@IO@-based monad--- stacks to catch exceptions via the 'MonadThrow' typeclass.------ Since 0.3.0-newtype ExceptionT m a = ExceptionT { runExceptionT :: m (Either SomeException a) }- stateAlloc :: I.IORef ReleaseMap -> IO () stateAlloc istate = do I.atomicModifyIORef istate $ \rm ->@@ -321,8 +293,8 @@ (ReleaseMap nk (rf + 1) m, ()) ReleaseMapClosed -> throw $ InvalidAccess "stateAlloc" -stateCleanup :: I.IORef ReleaseMap -> IO ()-stateCleanup istate = E.mask_ $ do+stateCleanup :: ReleaseType -> I.IORef ReleaseMap -> IO ()+stateCleanup rtype istate = E.mask_ $ do mm <- I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m ->@@ -333,157 +305,99 @@ ReleaseMapClosed -> throw $ InvalidAccess "stateCleanup" case mm of Just m ->- mapM_ (\x -> try x >> return ()) $ IntMap.elems 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'" --- | A @Monad@ based on some monad which allows running of some 'IO' actions,--- via unsafe calls. This applies to 'IO' and 'ST', for instance.+-- | ----- Since 0.3.0-class Monad m => MonadUnsafeIO m where- unsafeLiftIO :: IO a -> m a--instance MonadUnsafeIO IO where- unsafeLiftIO = id--instance MonadUnsafeIO (ST s) where- unsafeLiftIO = unsafeIOToST--instance MonadUnsafeIO (Lazy.ST s) where- unsafeLiftIO = LazyUnsafe.unsafeIOToST--instance (MonadTrans t, MonadUnsafeIO m, Monad (t m)) => MonadUnsafeIO (t m) where- unsafeLiftIO = lift . unsafeLiftIO--instance Monad m => Functor (ExceptionT m) where- fmap f = ExceptionT . (liftM . fmap) f . runExceptionT-instance Monad m => Applicative (ExceptionT m) where- pure = ExceptionT . return . Right- ExceptionT mf <*> ExceptionT ma = ExceptionT $ do- ef <- mf- case ef of- Left e -> return (Left e)- Right f -> do- ea <- ma- case ea of- Left e -> return (Left e)- Right x -> return (Right (f x))-instance Monad m => Monad (ExceptionT m) where- return = pure- ExceptionT ma >>= f = ExceptionT $ do- ea <- ma- case ea of- Left e -> return (Left e)- Right a -> runExceptionT (f a)-instance MonadBase b m => MonadBase b (ExceptionT m) where- liftBase = lift . liftBase-instance MonadTrans ExceptionT where- lift = ExceptionT . liftM Right-instance MonadTransControl ExceptionT where- newtype StT ExceptionT a = StExc { unStExc :: Either SomeException a }- liftWith f = ExceptionT $ liftM return $ f $ liftM StExc . runExceptionT- restoreT = ExceptionT . liftM unStExc-instance MonadBaseControl b m => MonadBaseControl b (ExceptionT m) where- newtype StM (ExceptionT m) a = StE { unStE :: ComposeSt ExceptionT m a }- liftBaseWith = defaultLiftBaseWith StE- restoreM = defaultRestoreM unStE--instance MonadCont m => MonadCont (ExceptionT m) where- callCC f = ExceptionT $- callCC $ \c ->- runExceptionT (f (\a -> ExceptionT $ c (Right a)))--instance MonadError e m => MonadError e (ExceptionT m) where- throwError = lift . throwError- catchError r h = ExceptionT $ runExceptionT r `catchError` (runExceptionT . h)--instance MonadRWS r w s m => MonadRWS r w s (ExceptionT m)--instance MonadReader r m => MonadReader r (ExceptionT m) where- ask = lift ask- local = mapExceptionT . local--mapExceptionT :: (m (Either SomeException a) -> n (Either SomeException b)) -> ExceptionT m a -> ExceptionT n b-mapExceptionT f = ExceptionT . f . runExceptionT--instance MonadState s m => MonadState s (ExceptionT m) where- get = lift get- put = lift . put--instance MonadWriter w m => MonadWriter w (ExceptionT m) where- tell = lift . tell- listen = mapExceptionT $ \ m -> do- (a, w) <- listen m- return $! fmap (\ r -> (r, w)) a- pass = mapExceptionT $ \ m -> pass $ do- a <- m- return $! case a of- Left l -> (Left l, id)- Right (r, f) -> (Right r, f)--data Allocated a = Allocated !a !(IO ())+-- 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'" --- | A method for allocating 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 @allocateResource@).------ This concept was originally introduced by Gabriel Gonzalez and described at:--- <http://www.haskellforall.com/2013/06/the-resource-applicative.html>. The--- implementation in this package is slightly different, due to taking a--- different approach to async exception safety.+-- | Thrown when one or more cleanup functions themselves throw an+-- exception during cleanup. ----- Since 0.4.10-newtype Resource a = Resource ((forall b. IO b -> IO b) -> IO (Allocated a))- deriving Typeable--instance Functor Resource where- fmap = liftM-instance Applicative Resource where- pure = return- (<*>) = ap--instance Monad Resource where- return a = Resource (\_ -> return (Allocated a (return ())))- Resource f >>= g' = Resource $ \restore -> do- Allocated x free1 <- f restore- let Resource g = g' x- Allocated y free2 <- g restore `E.onException` free1- return $! Allocated y (free2 `E.finally` free1)--instance MonadIO Resource where- liftIO f = Resource $ \restore -> do- x <- restore f- return $! Allocated x (return ())--instance MonadBase IO Resource where- liftBase = liftIO+-- @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 --- | Create a @Resource@ value using the given allocate and free functions.+-- | Clean up a release map, but throw a 'ResourceCleanupException' if+-- anything goes wrong in the cleanup handlers. ----- Since 0.4.10-mkResource :: IO a -- ^ allocate the resource- -> (a -> IO ()) -- ^ free the resource- -> Resource a-mkResource create free = Resource $ \restore -> do- x <- restore create- return $! Allocated x (free x)+-- @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) --- | 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 0.4.10-with :: MonadBaseControl IO m- => Resource a- -> (a -> m b)- -> m b-with (Resource f) g = control $ \run -> E.mask $ \restore -> do- Allocated x free <- f restore- run (g x) `E.finally` free+ 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
@@ -0,0 +1,93 @@+{-# 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+ , ReleaseType (..)+ ) where++import Control.Monad.Trans.Resource.Internal+import Data.Acquire.Internal+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+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)++-- | 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
@@ -0,0 +1,126 @@+{-# 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 (.., ReleaseException)+ , mkAcquireType+ ) where++import Control.Applicative (Applicative (..))+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+data ReleaseType = ReleaseEarly+ | ReleaseNormal+ | 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+-- 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:+-- <http://www.haskellforall.com/2013/06/the-resource-applicative.html>. 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.catch` (\e -> free1 (ReleaseExceptionWith e) >> E.throwIO e)+ 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 ())++-- | Create an @Acquire@ value using the given allocate and free functions.+--+-- 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 = 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.+--+-- 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 $ \_ -> do+ x <- 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 :: MonadUnliftIO m+ => Acquire a+ -> (a -> m b)+ -> m b+with (Acquire f) g = withRunInIO $ \run -> E.mask $ \restore -> do+ Allocated x free <- f restore+ 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,39 +1,43 @@ Name: resourcet-Version: 0.4.10.2+Version: 1.3.0 Synopsis: Deterministic allocation and freeing of scarce resources.-Description:- This package was originally included with the conduit package, and has since been split off. For more information, please see <http://www.yesodweb.com/book/conduits>.+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- Build-depends: base >= 4.3 && < 5- , lifted-base >= 0.1- , transformers-base >= 0.4.1 && < 0.5- , monad-control >= 0.3.1 && < 0.4+ Data.Acquire+ Data.Acquire.Internal+ UnliftIO.Resource+ Build-depends: base >= 4.12 && < 5 , containers- , transformers >= 0.2.2 && < 0.4- , mtl >= 2.0 && < 2.2- , mmorph+ , 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,22 +2,23 @@ {-# 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 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+ x <- newIORef (0 :: Int) handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do _ <- register $ writeIORef x 1 release undefined@@ -25,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@@ -47,38 +73,102 @@ 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+ 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 >>= (`shouldSatisfy` just releaseEarly)+ it "normal" $ do+ ref <- newIORef Nothing+ let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just+ runResourceT $ do+ (_releaseKey, ()) <- allocateAcquire acq+ return ()+ 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 >>= (`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 >>= (`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 >>= (`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