resourcet-1.2.6/Control/0000755000000000000000000000000014171736563013356 5ustar0000000000000000resourcet-1.2.6/Control/Monad/0000755000000000000000000000000014171736563014414 5ustar0000000000000000resourcet-1.2.6/Control/Monad/Trans/0000755000000000000000000000000014171736563015503 5ustar0000000000000000resourcet-1.2.6/Control/Monad/Trans/Resource/0000755000000000000000000000000014236462236017265 5ustar0000000000000000resourcet-1.2.6/Data/0000755000000000000000000000000014171736563012607 5ustar0000000000000000resourcet-1.2.6/Data/Acquire/0000755000000000000000000000000014171736563014200 5ustar0000000000000000resourcet-1.2.6/UnliftIO/0000755000000000000000000000000014257237611013422 5ustar0000000000000000resourcet-1.2.6/test/0000755000000000000000000000000014171736563012715 5ustar0000000000000000resourcet-1.2.6/Control/Monad/Trans/Resource.hs0000644000000000000000000002730114171736563017631 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ConstraintKinds #-} -- | Allocate resources which are guaranteed to be released. -- -- For more information, see . -- -- One point to note: all register cleanup actions live in the @IO@ monad, not -- the main monad. This allows both more efficient code, and for monads to be -- transformed. module Control.Monad.Trans.Resource ( -- * Data types ResourceT , ResIO , ReleaseKey -- * Unwrap , runResourceT -- ** Check cleanup exceptions , runResourceTChecked , ResourceCleanupException (..) -- * Special actions , resourceForkWith , resourceForkIO -- * Monad transformation , transResourceT , joinResourceT -- * Registering/releasing , allocate , allocate_ , register , release , unprotect , resourceMask -- * Type class/associated types , MonadResource (..) , MonadResourceBase -- ** Low-level , InvalidAccess (..) -- * Re-exports , MonadUnliftIO -- * Internal state -- $internalState , InternalState , getInternalState , runInternalState , withInternalState , createInternalState , closeInternalState -- * Reexport , MonadThrow (..) ) where import qualified Data.IntMap as IntMap import qualified Data.IORef as I import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO) import qualified Control.Exception as E import Control.Monad.Trans.Resource.Internal import Control.Concurrent (ThreadId, forkIO) import Control.Monad.Catch (MonadThrow, throwM) import Data.Acquire.Internal (ReleaseType (..)) -- | Register some action that will be called precisely once, either when -- 'runResourceT' is called, or when the 'ReleaseKey' is passed to 'release'. -- -- Since 0.3.0 register :: MonadResource m => IO () -> m ReleaseKey register = liftResourceT . registerRIO -- | Call a release action early, and deregister it from the list of cleanup -- actions to be performed. -- -- Since 0.3.0 release :: MonadIO m => ReleaseKey -> m () release (ReleaseKey istate rk) = liftIO $ release' istate rk (maybe (return ()) id) -- | Unprotect resource from cleanup actions; this allows you to send -- resource into another resourcet process and reregister it there. -- 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 unprotect :: MonadIO m => ReleaseKey -> m (Maybe (IO ())) unprotect (ReleaseKey istate rk) = liftIO $ release' istate rk return -- | Perform some allocation, and automatically register a cleanup action. -- -- This is almost identical to calling the allocation and then -- @register@ing the release action, but this properly handles masking of -- asynchronous exceptions. -- -- Since 0.3.0 allocate :: MonadResource m => IO a -- ^ allocate -> (a -> IO ()) -- ^ free resource -> m (ReleaseKey, a) allocate a = liftResourceT . allocateRIO a -- | Perform 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 -- than @Control.Exception.Lifted.mask@. -- -- Since 0.3.0 resourceMask :: MonadResource m => ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> m b resourceMask r = liftResourceT (resourceMaskRIO r) allocateRIO :: IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a) allocateRIO acquire rel = ResourceT $ \istate -> liftIO $ E.mask_ $ do a <- acquire key <- register' istate $ rel a return (key, a) registerRIO :: IO () -> ResourceT IO ReleaseKey registerRIO rel = ResourceT $ \istate -> liftIO $ register' istate rel resourceMaskRIO :: ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> ResourceT IO b resourceMaskRIO f = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> let ResourceT f' = f (go restore) in f' istate where go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a) go r (ResourceT g) = ResourceT (\i -> r (g i)) release' :: I.IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a) -> IO a release' istate key act = E.mask_ $ do maction <- I.atomicModifyIORef istate lookupAction act maction where lookupAction rm@(ReleaseMap next rf m) = case IntMap.lookup key m of Nothing -> (rm, Nothing) Just action -> ( ReleaseMap next rf $ IntMap.delete key m , Just (action ReleaseEarly) ) -- We tried to call release, but since the state is already closed, we -- can assume that the release action was already called. Previously, -- this threw an exception, though given that @release@ can be called -- from outside the context of a @ResourceT@ starting with version -- 0.4.4, it's no longer a library misuse or a library bug. lookupAction ReleaseMapClosed = (ReleaseMapClosed, Nothing) -- | Unwrap a 'ResourceT' transformer, and call all registered release actions. -- -- Note that there is some reference counting involved due to 'resourceForkIO'. -- If multiple threads are sharing the same collection of resources, only the -- last call to @runResourceT@ will deallocate the resources. -- -- /NOTE/ Since version 1.2.0, this function will throw a -- 'ResourceCleanupException' if any of the cleanup functions throw an -- exception. -- -- @since 0.3.0 runResourceT :: MonadUnliftIO m => ResourceT m a -> m a runResourceT (ResourceT r) = withRunInIO $ \run -> do istate <- createInternalState E.mask $ \restore -> do res <- restore (run (r istate)) `E.catch` \e -> do stateCleanupChecked (Just e) istate E.throwIO e stateCleanupChecked Nothing istate return res -- | 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 -> m a -> m a bracket_ alloc cleanupNormal cleanupExc inside = withRunInIO $ \run -> E.mask $ \restore -> do alloc res <- restore (run inside) `E.onException` cleanupExc cleanupNormal return res -- | This function mirrors @join@ at the transformer level: it will collapse -- two levels of @ResourceT@ into a single @ResourceT@. -- -- Since 0.4.6 joinResourceT :: ResourceT (ResourceT m) a -> ResourceT m a joinResourceT (ResourceT f) = ResourceT $ \r -> unResourceT (f r) r -- | Introduce a reference-counting scheme to allow a resource context to be -- shared by multiple threads. Once the last thread exits, all remaining -- resources will be released. -- -- The first parameter is a function which will be used to create the -- thread, such as @forkIO@ or @async@. -- -- Note that abuse of this function will greatly delay the deallocation of -- registered resources. This function should be used with care. A general -- guideline: -- -- If you are allocating a resource that should be shared by multiple threads, -- and will be held for a long time, you should allocate it at the beginning of -- a new @ResourceT@ block and then call @resourceForkWith@ from there. -- -- @since 1.1.9 resourceForkWith :: 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 -- before the child gets called. bracket_ (stateAlloc r) (return ()) (return ()) (g $ bracket_ (return ()) (stateCleanup ReleaseNormal r) (stateCleanup ReleaseException 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 :: MonadUnliftIO m => ResourceT m () -> ResourceT m ThreadId resourceForkIO = resourceForkWith forkIO -- | Just use 'MonadUnliftIO' directly now, legacy explanation continues: -- -- A @Monad@ which can be used as a base for a @ResourceT@. -- -- A @ResourceT@ has some restrictions on its base monad: -- -- * @runResourceT@ requires an instance of @MonadUnliftIO@. -- * @MonadResource@ requires an instance of @MonadIO@ -- -- Note that earlier versions of @conduit@ had a typeclass @ResourceIO@. This -- fulfills much the same role. -- -- Since 0.3.2 type MonadResourceBase = MonadUnliftIO {-# DEPRECATED MonadResourceBase "Use MonadUnliftIO directly instead" #-} -- $internalState -- -- A @ResourceT@ internally is a modified @ReaderT@ monad transformer holding -- onto a mutable reference to all of the release actions still remaining to be -- performed. If you are building up a custom application monad, it may be more -- efficient to embed this @ReaderT@ functionality directly in your own monad -- instead of wrapping around @ResourceT@ itself. This section provides you the -- means of doing so. -- | Create a new internal state. This state must be closed with -- @closeInternalState@. It is your responsibility to ensure exception safety. -- Caveat emptor! -- -- Since 0.4.9 createInternalState :: 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 :: MonadIO m => InternalState -> m () closeInternalState = liftIO . stateCleanup ReleaseNormal -- | Get the internal state of the current @ResourceT@. -- -- Since 0.4.6 getInternalState :: Monad m => ResourceT m InternalState getInternalState = ResourceT return -- | The internal state held by a @ResourceT@ transformer. -- -- Since 0.4.6 type InternalState = I.IORef ReleaseMap -- | Unwrap a @ResourceT@ using the given @InternalState@. -- -- Since 0.4.6 runInternalState :: ResourceT m a -> InternalState -> m a runInternalState = unResourceT -- | Run an action in the underlying monad, providing it the @InternalState@. -- -- Since 0.4.6 withInternalState :: (InternalState -> m a) -> ResourceT m a withInternalState = ResourceT resourcet-1.2.6/Control/Monad/Trans/Resource/Internal.hs0000644000000000000000000003277314236462236021411 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RankNTypes #-} module Control.Monad.Trans.Resource.Internal( InvalidAccess(..) , MonadResource(..) , ReleaseKey(..) , ReleaseMap(..) , ResIO , ResourceT(..) , stateAlloc , stateCleanup , transResourceT , register' , registerType , ResourceCleanupException (..) , stateCleanupChecked ) where 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.Class (MonadTrans (..)) import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) ) import Control.Monad.RWS.Class ( MonadRWS ) import Control.Monad.Reader.Class ( MonadReader (..) ) import Control.Monad.State.Class ( MonadState (..) ) import Control.Monad.Writer.Class ( MonadWriter (..) ) import Control.Monad.Trans.Identity ( IdentityT) #if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.List ( ListT ) #endif import Control.Monad.Trans.Maybe ( MaybeT ) import Control.Monad.Trans.Except ( ExceptT ) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.State ( StateT ) import Control.Monad.Trans.Writer ( WriterT ) import Control.Monad.Trans.RWS ( RWST ) import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST ) import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Primitive (PrimMonad (..)) import qualified Control.Exception as E -- 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.Typeable import Data.Word(Word) import Data.Acquire.Internal (ReleaseType (..)) -- | 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 @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 MonadIO m => MonadResource m where -- | Lift a @ResourceT IO@ action into the current @Monad@. -- -- Since 0.4.0 liftResourceT :: ResourceT IO a -> m a -- | A lookup key for a specific release action. This value is returned by -- 'register' and 'allocate', and is passed to 'release'. -- -- Since 0.3.0 data ReleaseKey = ReleaseKey !(I.IORef ReleaseMap) !Int deriving Typeable type RefCount = Word type NextKey = Int data ReleaseMap = ReleaseMap !NextKey !RefCount !(IntMap (ReleaseType -> IO ())) | ReleaseMapClosed -- | Convenient alias for @ResourceT IO@. type ResIO = ResourceT IO instance MonadCont m => MonadCont (ResourceT m) where callCC f = ResourceT $ \i -> callCC $ \c -> unResourceT (f (ResourceT . const . c)) i instance MonadError e m => MonadError e (ResourceT m) where throwError = lift . throwError catchError r h = ResourceT $ \i -> unResourceT r i `catchError` \e -> unResourceT (h e) i instance MonadRWS r w s m => MonadRWS r w s (ResourceT m) instance MonadReader r m => MonadReader r (ResourceT m) where ask = lift ask local = mapResourceT . local mapResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b mapResourceT f = ResourceT . (f .) . unResourceT instance MonadState s m => MonadState s (ResourceT m) where get = lift get put = lift . put instance MonadWriter w m => MonadWriter w (ResourceT m) where tell = lift . tell listen = mapResourceT listen pass = mapResourceT pass instance MonadThrow m => MonadThrow (ResourceT m) where throwM = lift . throwM instance MonadCatch m => MonadCatch (ResourceT m) where catch (ResourceT m) c = ResourceT $ \r -> m r `catch` \e -> unResourceT (c e) r 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@. -- -- Note that this function is a slight generalization of 'hoist'. -- -- Since 0.3.0 transResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b transResourceT f (ResourceT mx) = ResourceT (\r -> f (mx r)) -- | The Resource transformer. This transformer keeps track of all registered -- actions, and calls them upon exit (via 'runResourceT'). Actions may be -- registered via 'register', or resources may be allocated atomically via -- 'allocate'. @allocate@ corresponds closely to @bracket@. -- -- Releasing may be performed before exit via the 'release' function. This is a -- highly recommended optimization, as it will ensure that scarce resources are -- freed early. Note that calling @release@ will deregister the action, so that -- a release action will only ever be called once. -- -- Since 0.3.0 newtype ResourceT m a = ResourceT { unResourceT :: I.IORef ReleaseMap -> m a } #if __GLASGOW_HASKELL__ >= 707 deriving Typeable #else instance Typeable1 m => Typeable1 (ResourceT m) where typeOf1 = goType undefined where goType :: Typeable1 m => m a -> ResourceT m a -> TypeRep goType m _ = mkTyConApp #if __GLASGOW_HASKELL__ >= 704 (mkTyCon3 "resourcet" "Control.Monad.Trans.Resource" "ResourceT") #else (mkTyCon "Control.Monad.Trans.Resource.ResourceT") #endif [ typeOf1 m ] #endif -- | Indicates either an error in the library, or misuse of it (e.g., a -- @ResourceT@'s state is accessed after being released). -- -- Since 0.3.0 data InvalidAccess = InvalidAccess { functionName :: String } deriving Typeable instance Show InvalidAccess where show (InvalidAccess f) = concat [ "Control.Monad.Trans.Resource." , f , ": The mutable state is being accessed after cleanup. Please contact the maintainers." ] instance Exception InvalidAccess -------- All of our monad et al instances instance Functor m => Functor (ResourceT m) where fmap f (ResourceT m) = ResourceT $ \r -> fmap f (m r) instance Applicative m => Applicative (ResourceT m) where pure = ResourceT . const . pure ResourceT mf <*> ResourceT ma = ResourceT $ \r -> mf r <*> ma r 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 = 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 -- | @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) GO(ExceptT e) GO(ReaderT r) GO(ContT r) GO(StateT s) GOX(Monoid w, WriterT w) GOX(Monoid w, RWST r w s) GOX(Monoid w, Strict.RWST r w s) GO(Strict.StateT s) GOX(Monoid w, Strict.WriterT w) #undef GO #undef GOX stateAlloc :: I.IORef ReleaseMap -> IO () stateAlloc istate = do I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> (ReleaseMap nk (rf + 1) m, ()) ReleaseMapClosed -> throw $ InvalidAccess "stateAlloc" stateCleanup :: ReleaseType -> I.IORef ReleaseMap -> IO () stateCleanup rtype istate = E.mask_ $ do mm <- I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> let rf' = rf - 1 in if rf' == minBound then (ReleaseMapClosed, Just m) else (ReleaseMap nk rf' m, Nothing) ReleaseMapClosed -> throw $ InvalidAccess "stateCleanup" case mm of Just m -> mapM_ (\x -> try (x rtype) >> return ()) $ IntMap.elems m Nothing -> return () where try :: IO a -> IO (Either SomeException a) try = E.try register' :: I.IORef ReleaseMap -> IO () -> IO ReleaseKey register' istate rel = I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap key rf m -> ( ReleaseMap (key - 1) rf (IntMap.insert key (const rel) m) , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'" -- | -- -- Since 1.1.2 registerType :: I.IORef ReleaseMap -> (ReleaseType -> IO ()) -> IO ReleaseKey registerType istate rel = I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap key rf m -> ( ReleaseMap (key - 1) rf (IntMap.insert key rel m) , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'" -- | Thrown when one or more cleanup functions themselves throw an -- exception during cleanup. -- -- @since 1.1.11 data ResourceCleanupException = ResourceCleanupException { rceOriginalException :: !(Maybe SomeException) -- ^ If the 'ResourceT' block exited due to an exception, this is -- that exception. -- -- @since 1.1.11 , rceFirstCleanupException :: !SomeException -- ^ The first cleanup exception. We keep this separate from -- 'rceOtherCleanupExceptions' to prove that there's at least one -- (i.e., a non-empty list). -- -- @since 1.1.11 , rceOtherCleanupExceptions :: ![SomeException] -- ^ All other exceptions in cleanups. -- -- @since 1.1.11 } deriving (Show, Typeable) instance Exception ResourceCleanupException -- | Clean up a release map, but throw a 'ResourceCleanupException' if -- anything goes wrong in the cleanup handlers. -- -- @since 1.1.11 stateCleanupChecked :: Maybe SomeException -- ^ exception that killed the 'ResourceT', if present -> I.IORef ReleaseMap -> IO () stateCleanupChecked morig istate = E.mask_ $ do mm <- I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> let rf' = rf - 1 in if rf' == minBound then (ReleaseMapClosed, Just m) else (ReleaseMap nk rf' m, Nothing) ReleaseMapClosed -> throw $ InvalidAccess "stateCleanupChecked" case mm of Just m -> do res <- mapMaybeReverseM (\x -> try (x rtype)) $ IntMap.elems m case res of [] -> return () -- nothing went wrong e:es -> E.throwIO $ ResourceCleanupException morig e es Nothing -> return () where try :: IO () -> IO (Maybe SomeException) try io = fmap (either Just (\() -> Nothing)) (E.try io) rtype = maybe ReleaseNormal (const ReleaseException) 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 resourcet-1.2.6/Data/Acquire.hs0000644000000000000000000000570314171736563014541 0ustar0000000000000000{-# 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 #-} resourcet-1.2.6/Data/Acquire/Internal.hs0000644000000000000000000001013114171736563016304 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} module Data.Acquire.Internal ( Acquire (..) , Allocated (..) , with , mkAcquire , ReleaseType (..) , 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 | ReleaseException deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) data Allocated a = Allocated !a !(ReleaseType -> IO ()) -- | A method for acquiring a scarce resource, providing the means of freeing -- it when no longer needed. This data type provides -- @Functor@\/@Applicative@\/@Monad@ instances for composing different resources -- together. You can allocate these resources using either the @bracket@ -- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@). -- -- This concept was originally introduced by Gabriel Gonzalez and described at: -- . The -- implementation in this package is slightly different, due to taking a -- different approach to async exception safety. -- -- @since 1.1.0 newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a)) deriving Typeable instance Functor Acquire where fmap = liftM instance Applicative Acquire where pure a = Acquire (\_ -> return (Allocated a (const $ return ()))) (<*>) = ap instance Monad Acquire where return = pure Acquire f >>= g' = Acquire $ \restore -> do Allocated x free1 <- f restore let Acquire g = g' x Allocated y free2 <- g restore `E.onException` free1 ReleaseException return $! Allocated y (\rt -> free2 rt `E.finally` free1 rt) instance MonadIO Acquire where liftIO f = Acquire $ \restore -> do x <- restore f return $! Allocated x (const $ return ()) -- | 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.onException` free ReleaseException free ReleaseNormal return res resourcet-1.2.6/UnliftIO/Resource.hs0000644000000000000000000000213314257237611015544 0ustar0000000000000000-- | 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-1.2.6/test/main.hs0000644000000000000000000001456114171736563014204 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} import Control.Concurrent 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 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 :: Int) handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do _ <- register $ writeIORef x 1 release undefined x' <- readIORef x x' `shouldBe` 1 describe "early release" $ do it "works from a different context" $ do x <- newIORef (0 :: Int) runResourceT $ do key <- register $ writeIORef x 1 runResourceT $ release key y <- liftIO $ readIORef x liftIO $ y `shouldBe` 1 describe "resourceForkIO" $ do it "waits for all threads" $ do x <- newEmptyMVar y <- newIORef (0 :: 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 :: Int) _ <- runResourceT $ do key <- register $ writeIORef x 1 unprotect key y <- readIORef x y `shouldBe` 0 it "cleanup actions are masked #144" $ do let checkMasked name = do ms <- getMaskingState unless (ms == MaskedInterruptible) $ error $ show (name, ms) _ <- runResourceT $ do register (checkMasked "release") >>= release register (checkMasked "normal") Left Dummy <- try $ runResourceT $ do _ <- register (checkMasked "exception") liftIO $ throwIO Dummy return () describe "mkAcquireType" $ do describe "ResourceT" $ do it "early" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just runResourceT $ do (releaseKey, ()) <- allocateAcquire acq release releaseKey readIORef ref >>= (`shouldBe` Just ReleaseEarly) it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just runResourceT $ do (_releaseKey, ()) <- allocateAcquire acq return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ runResourceT $ do (_releaseKey, ()) <- allocateAcquire acq liftIO $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) describe "with" $ do it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just with acq $ const $ return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ with acq $ const $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) describe "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 data Dummy2 = Dummy2 deriving (Show, Typeable) instance Exception Dummy2 resourcet-1.2.6/ChangeLog.md0000644000000000000000000000441014257237611014101 0ustar0000000000000000# ChangeLog for resourcet ## 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. resourcet-1.2.6/README.md0000644000000000000000000002774314171736563013232 0ustar0000000000000000## resourcet Proper exception handling, especially in the presence of asynchronous exceptions, is a non-trivial task. But such proper handling is absolutely vital to any large scale application. Leaked file descriptors or database connections will simply not be an option when writing a popular web application, or a high concurrency data processing tool. So the question is, how do you deal with it? The standard approach is the bracket pattern, which appears throughout much of the standard libraries. `withFile` uses the bracket pattern to safely wrap up `openFile` and `closeFile`, guaranteeing that the file handle will be closed no matter what. This approach works well, and I highly recommend using it. However, there's another approach available: the [resourcet package](https://www.stackage.org/package/resourcet). If the bracket pattern is so good, why do we need another one? The goal of this post is to answer that question. ## What is ResourceT ResourceT is a monad transformer which creates a region of code where you can safely allocate resources. Let's write a simple example program: we'll ask the user for some input and pretend like it's a scarce resource that must be released. We'll then do something dangerous (potentially introducing a divide-by-zero error). We then want to immediately release our scarce resource and perform some long-running computation. ```haskell #!/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). resourcet-1.2.6/LICENSE0000644000000000000000000000276714171736563012757 0ustar0000000000000000Copyright (c)2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. resourcet-1.2.6/Setup.lhs0000755000000000000000000000016214171736563013550 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain resourcet-1.2.6/resourcet.cabal0000644000000000000000000000331314257237611014730 0ustar0000000000000000Name: resourcet Version: 1.2.6 Synopsis: Deterministic allocation and freeing of scarce resources. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit Build-type: Simple Cabal-version: >=1.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.12 && < 5 , containers , 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 , transformers ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/conduit.git