resourcet 1.1.11 → 1.3.0
raw patch · 9 files changed
Files
- ChangeLog.md +50/−0
- Control/Monad/Trans/Resource.hs +69/−110
- Control/Monad/Trans/Resource/Internal.hs +43/−76
- Data/Acquire.hs +10/−10
- Data/Acquire/Internal.hs +38/−51
- README.md +1/−1
- UnliftIO/Resource.hs +12/−0
- resourcet.cabal +11/−13
- test/main.hs +39/−25
ChangeLog.md view
@@ -1,3 +1,53 @@+# 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
Control/Monad/Trans/Resource.hs view
@@ -6,13 +6,10 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-}-#endif-{-# LANGUAGE Safe #-} -- | Allocate resources which are guaranteed to be released. ----- For more information, see <https://www.fpcomplete.com/user/snoyberg/library-documentation/resourcet>.+-- 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@@ -35,6 +32,7 @@ , joinResourceT -- * Registering/releasing , allocate+ , allocate_ , register , release , unprotect@@ -45,7 +43,7 @@ -- ** Low-level , InvalidAccess (..) -- * Re-exports- , MonadBaseControl+ , MonadUnliftIO -- * Internal state -- $internalState , InternalState@@ -54,36 +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.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)-import Control.Monad (liftM) import qualified Control.Exception as E-import Data.Monoid (Monoid)-import qualified Control.Exception.Lifted as L import Control.Monad.Trans.Resource.Internal import Control.Concurrent (ThreadId, forkIO) -import Data.Functor.Identity (Identity, runIdentity) import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Catch.Pure (CatchT, runCatchT) import Data.Acquire.Internal (ReleaseType (..)) @@ -105,7 +87,7 @@ -- | 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@@ -125,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@@ -183,28 +181,13 @@ -- If multiple threads are sharing the same collection of resources, only the -- last call to @runResourceT@ will deallocate the resources. ----- /NOTE/ Since version 1.1.11, this module has also provided--- `runResourceTChecked`, which is a safer version of this--- function. In the next major release of this library, it will become--- the behavior of this function.------ Since 0.3.0-runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a-runResourceT (ResourceT r) = control $ \run -> do- istate <- createInternalState- E.mask $ \restore -> do- res <- restore (run (r istate)) `E.onException`- stateCleanup ReleaseException istate- stateCleanup ReleaseNormal istate- return res---- | Like 'runResourceT', but checks whether the cleanup functions--- throw any exceptions. If they do, they are rethrown inside a--- 'ResourceCleanupException'.+-- /NOTE/ Since version 1.2.0, this function will throw a+-- 'ResourceCleanupException' if any of the cleanup functions throw an+-- exception. ----- @since 1.1.11-runResourceTChecked :: MonadUnliftIO m => ResourceT m a -> m a-runResourceTChecked (ResourceT r) = withRunInIO $ \run -> do+-- @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.catch` \e -> do@@ -213,23 +196,26 @@ 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@. --@@ -238,31 +224,6 @@ -> 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.@@ -279,8 +240,13 @@ -- a new @ResourceT@ block and then call @resourceForkWith@ from there. -- -- @since 1.1.9-resourceForkWith :: MonadBaseControl IO m => (IO () -> IO a) -> ResourceT m () -> ResourceT m a-resourceForkWith g (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->+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@@ -288,47 +254,44 @@ bracket_ (stateAlloc r) (return ())- (return ())- (liftBaseDiscard g $ bracket_+ (const $ return ())+ (g $ bracket_ (return ()) (stateCleanup ReleaseNormal r)- (stateCleanup ReleaseException r)- (restore $ f r))+ (\e -> stateCleanup (ReleaseExceptionWith e) r)+ (restore $ run $ f r)) -- | Launch a new reference counted resource context using @forkIO@. -- -- This is defined as @resourceForkWith forkIO@. --+-- 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.+--+-- If you encounter 'InvalidAccess' exceptions ("The mutable state is being accessed after cleanup"),+-- use of 'forkIO' is a possible culprit.+-- -- @since 0.3.0-resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId+resourceForkIO :: MonadUnliftIO m => ResourceT m () -> ResourceT m ThreadId resourceForkIO = resourceForkWith forkIO --- | A @Monad@ which can be used as a base for a @ResourceT@.------ A @ResourceT@ has some restrictions on its base monad:+-- | Just use 'MonadUnliftIO' directly now, legacy explanation continues: ----- * @runResourceT@ requires an instance of @MonadBaseControl IO@.--- * @MonadResource@ requires an instance of @MonadThrow@, @MonadIO@, and @Applicative@.+-- A @Monad@ which can be used as a base for a @ResourceT@. ----- 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.+-- A @ResourceT@ has some restrictions on its base monad: ----- Instead, this typeclass acts as a proxy for the other five. Its only purpose--- is to make your type signatures shorter.+-- * @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 --@@ -344,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@. --@@ -377,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
@@ -7,13 +7,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RankNTypes #-}--- Can only mark as Safe when using a newer GHC, otherwise we get build--- failures due to the manual Typeable instance below.-#if __GLASGOW_HASKELL__ >= 707-{-# LANGUAGE Safe #-}-#else-{-# LANGUAGE Trustworthy #-}-#endif module Control.Monad.Trans.Resource.Internal( InvalidAccess(..)@@ -34,11 +27,10 @@ import Control.Exception (throw,Exception,SomeException) 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.Control- ( MonadTransControl (..), MonadBaseControl (..) )-import Control.Monad.Base (MonadBase, liftBase)+import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) )@@ -48,9 +40,10 @@ 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 )@@ -62,38 +55,30 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) import Control.Monad.IO.Class (MonadIO (..))-#if !(MIN_VERSION_monad_control(1,0,0))-import Control.Monad (liftM)-#endif+import Control.Monad.Primitive (PrimMonad (..)) import qualified Control.Exception as E-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 (..)) -import Control.Monad.Morph- -- | A @Monad@ which allows for safe resource allocation. In theory, any monad -- transformer stack which includes a @ResourceT@ can be an instance of -- @MonadResource@. ----- Note: @runResourceT@ has a requirement for a @MonadBaseControl IO m@ monad,+-- 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@@ -148,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@.@@ -170,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@@ -231,6 +222,10 @@ 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@@ -243,14 +238,16 @@ (ResourceT mf) `mplus` (ResourceT ma) = ResourceT $ \r -> mf r `mplus` ma r instance Monad m => Monad (ResourceT m) where-#if !MIN_VERSION_base(4,8,0)- return = ResourceT . const . return-#endif+ 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@@ -261,52 +258,22 @@ instance MonadIO m => MonadIO (ResourceT m) where liftIO = lift . liftIO -instance MonadBase b m => MonadBase b (ResourceT m) where- liftBase = lift . liftBase--instance MonadTransControl ResourceT where-#if MIN_VERSION_monad_control(1,0,0)- type StT ResourceT a = a- liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> t r- restoreT = ResourceT . const-#else- newtype StT ResourceT a = StReader {unStReader :: a}- liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r- restoreT = ResourceT . const . liftM unStReader-#endif- {-# INLINE liftWith #-}- {-# INLINE restoreT #-}--instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where-#if MIN_VERSION_monad_control(1,0,0)- type StM (ResourceT m) a = StM m a- liftBaseWith f = ResourceT $ \reader' ->- liftBaseWith $ \runInBase ->- f $ runInBase . (\(ResourceT r) -> r reader' )- restoreM = ResourceT . const . restoreM-#else- newtype StM (ResourceT m) a = StMT (StM m a)- liftBaseWith f = ResourceT $ \reader' ->- liftBaseWith $ \runInBase ->- f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader' )- restoreM (StMT base) = ResourceT $ const $ restoreM base-#endif- -- | @since 1.1.10 instance MonadUnliftIO m => MonadUnliftIO (ResourceT m) where- askUnliftIO = ResourceT $ \r ->- withUnliftIO $ \u ->- return (UnliftIO (unliftIO u . flip unResourceT r))+ {-# 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)-#if MIN_VERSION_exceptions(0, 8, 0) GO(ExceptT e)-#endif GO(ReaderT r) GO(ContT r) GO(StateT s)@@ -420,7 +387,7 @@ try :: IO () -> IO (Maybe SomeException) try io = fmap (either Just (\() -> Nothing)) (E.try io) - rtype = maybe ReleaseNormal (const ReleaseException) morig+ 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.
Data/Acquire.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE Safe #-} -- | This was previously known as the Resource monad. However, that term is -- confusing next to the ResourceT transformer, so it has been renamed. @@ -61,7 +60,7 @@ -- > code.hs: divide by zero -- , with- , withEx+ , withAcquire , mkAcquire , mkAcquireType , allocateAcquire@@ -69,15 +68,9 @@ ) 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.@@ -91,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
@@ -4,40 +4,41 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE PatternSynonyms #-} module Data.Acquire.Internal ( Acquire (..) , Allocated (..) , with- , withEx , 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-import GHC.IO (unsafeUnmask)+import qualified Control.Monad.Catch as C () -- | The way in which a release is called. -- -- @since 1.1.2 data ReleaseType = ReleaseEarly | ReleaseNormal- | ReleaseException- deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable)+ | 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@). --@@ -61,7 +62,7 @@ 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@@ -69,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. --+-- 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. --+-- 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@@ -101,39 +115,12 @@ -- @bracket@. -- -- @since 1.1.0-with :: MonadBaseControl IO m+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 <- restore (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---- | Same as @with@, but uses the @MonadMask@ typeclass from exceptions instead--- of @MonadBaseControl@ from exceptions.------ @since 1.1.3-#if MIN_VERSION_exceptions(0,6,0)-withEx :: (C.MonadMask m, MonadIO m)-#else-withEx :: (C.MonadCatch m, MonadIO m)-#endif- => Acquire a- -> (a -> m b)- -> m b-withEx (Acquire f) g = do- -- We need to do some funny business, since the restore we get below is- -- specialized to the m from the result, whereas we need a restore function- -- in IO. Checking the current masking state is exactly how mask is- -- implemented in base.- origMS <- liftIO E.getMaskingState-- C.mask $ \restore -> do- Allocated x free <- liftIO $ f $ case origMS of- E.Unmasked -> unsafeUnmask- _ -> id- res <- restore (g x) `C.onException` liftIO (free ReleaseException)- liftIO $ free ReleaseNormal- return res
README.md view
@@ -319,4 +319,4 @@ ## 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 hook, refer [here](https://www.fpcomplete.com/blog/2017/06/understanding-resourcet).+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
@@ -5,6 +5,7 @@ ( -- * UnliftIO variants runResourceT , liftResourceT+ , allocateU -- * Reexports , module Control.Monad.Trans.Resource ) where@@ -25,3 +26,14 @@ -- @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,5 +1,5 @@ Name: resourcet-Version: 1.1.11+Version: 1.3.0 Synopsis: Deterministic allocation and freeing of scarce resources. description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/resourcet>. License: BSD3@@ -8,38 +8,36 @@ 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 UnliftIO.Resource- Build-depends: base >= 4.5 && < 5- , lifted-base >= 0.1- , transformers-base >= 0.4.4 && < 0.5- , monad-control >= 0.3.1 && < 1.1+ Build-depends: base >= 4.12 && < 5 , containers- , transformers >= 0.2.2- , transformers-compat >= 0.3 && < 0.6- , mtl >= 2.0 && < 2.3- , mmorph- , exceptions >= 0.5- , unliftio-core+ , 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, fromException) import Control.Exception (SomeException, handle) 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,7 +26,7 @@ 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@@ -35,11 +35,11 @@ describe "resourceForkIO" $ do it "waits for all threads" $ do x <- newEmptyMVar- y <- newIORef 0+ y <- newIORef (0 :: Int) z <- newEmptyMVar w <- newEmptyMVar - runResourceT $ do+ _ <- runResourceT $ do _ <- register $ do writeIORef y 1 putMVar w ()@@ -62,8 +62,8 @@ 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@@ -73,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@@ -88,43 +88,32 @@ 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)- describe "withEx" $ do- it "normal" $ do- ref <- newIORef Nothing- let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just- withEx acq $ const $ return ()- readIORef ref >>= (`shouldBe` Just ReleaseNormal)- it "exception" $ do- ref <- newIORef Nothing- let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just- Left Dummy <- try $ withEx acq $ const $ throwIO Dummy- readIORef ref >>= (`shouldBe` Just ReleaseException)+ readIORef ref >>= (`shouldSatisfy` just (releaseException dummy)) describe "runResourceTChecked" $ do it "catches exceptions" $ do eres <- try $ runResourceTChecked $ void $ register $ throwIO Dummy@@ -150,6 +139,8 @@ 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)@@ -158,3 +149,26 @@ data Dummy2 = Dummy2 deriving (Show, Typeable) instance Exception Dummy2++-- Helpers needed due to lack of 'Eq' on 'ReleaseType'++releaseEarly :: ReleaseType -> Bool+releaseEarly ReleaseEarly = True+releaseEarly _ = False++releaseNormal :: ReleaseType -> Bool+releaseNormal ReleaseNormal = True+releaseNormal _ = False++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