resourcet-1.1.7/0000755000000000000000000000000012626621735011733 5ustar0000000000000000resourcet-1.1.7/ChangeLog.md0000644000000000000000000000121512626621735014103 0ustar0000000000000000## 1.1.7 * Canonicalise Monad instances [#237](https://github.com/snoyberg/conduit/pull/237) ## 1.1.6 * Safe/Trustworthy for resourcet [#220](https://github.com/snoyberg/conduit/pull/220) ## 1.1.5 * Add pass-through instances for Alternative and MonadPlus [#214](https://github.com/snoyberg/conduit/pull/214) ## 1.1.4.1 * Allow older `exceptions` version again ## 1.1.4 * Add `MonadResource ExceptT` instance [#198](https://github.com/snoyberg/conduit/pull/198) ## 1.1.3.2 monad-control-1.0 support [#191](https://github.com/snoyberg/conduit/pull/191) ## 1.1.3 Provide the `withEx` function to interact nicely with the exceptions package. resourcet-1.1.7/LICENSE0000644000000000000000000000276712626621735012754 0ustar0000000000000000Copyright (c)2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. resourcet-1.1.7/README.md0000644000000000000000000000045512626621735013216 0ustar0000000000000000## resourcet Please see [the full tutorial on School of Haskell](https://www.fpcomplete.com/user/snoyberg/library-documentation/resourcet). This package was originally included with the conduit package, but has existed as a separate package for quite a while. It is fully usable outside of conduit. resourcet-1.1.7/resourcet.cabal0000644000000000000000000000347212626621735014740 0ustar0000000000000000Name: resourcet Version: 1.1.7 Synopsis: Deterministic allocation and freeing of scarce resources. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit extra-source-files: ChangeLog.md, README.md Library Exposed-modules: Control.Monad.Trans.Resource Control.Monad.Trans.Resource.Internal Data.Acquire Data.Acquire.Internal Build-depends: base >= 4.5 && < 5 , lifted-base >= 0.1 , transformers-base >= 0.4.4 && < 0.5 , monad-control >= 0.3.1 && < 1.1 , containers , transformers >= 0.2.2 && < 0.5 , transformers-compat >= 0.3 && < 0.5 , mtl >= 2.0 && < 2.3 , mmorph , exceptions >= 0.5 ghc-options: -Wall test-suite test hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: resourcet , base , hspec >= 1.3 , lifted-base , transformers ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/conduit.git resourcet-1.1.7/Setup.lhs0000644000000000000000000000016212626621735013542 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain resourcet-1.1.7/Control/0000755000000000000000000000000012626621735013353 5ustar0000000000000000resourcet-1.1.7/Control/Monad/0000755000000000000000000000000012626621735014411 5ustar0000000000000000resourcet-1.1.7/Control/Monad/Trans/0000755000000000000000000000000012626621735015500 5ustar0000000000000000resourcet-1.1.7/Control/Monad/Trans/Resource.hs0000644000000000000000000003004012626621735017620 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ImpredicativeTypes #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-} #endif {-# LANGUAGE Safe #-} -- | Allocate resources which are guaranteed to be released. -- -- For more information, see . -- -- One point to note: all register cleanup actions live in the @IO@ monad, not -- the main monad. This allows both more efficient code, and for monads to be -- transformed. module Control.Monad.Trans.Resource ( -- * Data types ResourceT , ResIO , ReleaseKey -- * Unwrap , runResourceT -- * Special actions , resourceForkIO -- * Monad transformation , transResourceT , joinResourceT -- * Registering/releasing , allocate , register , release , unprotect , resourceMask -- * Type class/associated types , MonadResource (..) , MonadResourceBase -- ** Low-level , InvalidAccess (..) -- * Re-exports , MonadBaseControl -- * Internal state -- $internalState , InternalState , getInternalState , runInternalState , withInternalState , createInternalState , closeInternalState -- * Backwards compatibility , ExceptionT (..) , runExceptionT , runExceptionT_ , runException , runException_ , MonadThrow (..) , monadThrow ) where import qualified Data.IntMap as IntMap import Control.Exception (SomeException, throw) import Control.Monad.Trans.Control ( MonadBaseControl (..), liftBaseDiscard, control ) import qualified Data.IORef as I import Control.Monad.Base (MonadBase, liftBase) import Control.Applicative (Applicative (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad (liftM) import qualified Control.Exception as E import Data.Monoid (Monoid) import qualified Control.Exception.Lifted as L import Control.Monad.Trans.Resource.Internal import Control.Concurrent (ThreadId, forkIO) import Data.Functor.Identity (Identity, runIdentity) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.Catch.Pure (CatchT, runCatchT) import Data.Acquire.Internal (ReleaseType (..)) -- | Register some action that will be called precisely once, either when -- 'runResourceT' is called, or when the 'ReleaseKey' is passed to 'release'. -- -- Since 0.3.0 register :: MonadResource m => IO () -> m ReleaseKey register = liftResourceT . registerRIO -- | Call a release action early, and deregister it from the list of cleanup -- actions to be performed. -- -- Since 0.3.0 release :: MonadIO m => ReleaseKey -> m () release (ReleaseKey istate rk) = liftIO $ release' istate rk (maybe (return ()) id) -- | Unprotect resource from cleanup actions, this allowes you to send -- resource into another resourcet process and reregister it there. -- It returns an release action that should be run in order to clean -- resource or Nothing in case if resource is already freed. -- -- Since 0.4.5 unprotect :: MonadIO m => ReleaseKey -> m (Maybe (IO ())) unprotect (ReleaseKey istate rk) = liftIO $ release' istate rk return -- | Perform some allocation, and automatically register a cleanup action. -- -- This is almost identical to calling the allocation and then -- @register@ing the release action, but this properly handles masking of -- asynchronous exceptions. -- -- Since 0.3.0 allocate :: MonadResource m => IO a -- ^ allocate -> (a -> IO ()) -- ^ free resource -> m (ReleaseKey, a) allocate a = liftResourceT . allocateRIO a -- | Perform asynchronous exception masking. -- -- This is more general then @Control.Exception.mask@, yet more efficient -- than @Control.Exception.Lifted.mask@. -- -- Since 0.3.0 resourceMask :: MonadResource m => ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> m b resourceMask = liftResourceT . resourceMaskRIO allocateRIO :: IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a) allocateRIO acquire rel = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do a <- restore acquire key <- register' istate $ rel a return (key, a) registerRIO :: IO () -> ResourceT IO ReleaseKey registerRIO rel = ResourceT $ \istate -> liftIO $ register' istate rel resourceMaskRIO :: ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> ResourceT IO b resourceMaskRIO f = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> let ResourceT f' = f (go restore) in f' istate where go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a) go r (ResourceT g) = ResourceT (\i -> r (g i)) release' :: I.IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a) -> IO a release' istate key act = E.mask_ $ do maction <- I.atomicModifyIORef istate lookupAction act maction where lookupAction rm@(ReleaseMap next rf m) = case IntMap.lookup key m of Nothing -> (rm, Nothing) Just action -> ( ReleaseMap next rf $ IntMap.delete key m , Just (action ReleaseEarly) ) -- We tried to call release, but since the state is already closed, we -- can assume that the release action was already called. Previously, -- this threw an exception, though given that @release@ can be called -- from outside the context of a @ResourceT@ starting with version -- 0.4.4, it's no longer a library misuse or a library bug. lookupAction ReleaseMapClosed = (ReleaseMapClosed, Nothing) -- | Unwrap a 'ResourceT' transformer, and call all registered release actions. -- -- Note that there is some reference counting involved due to 'resourceForkIO'. -- If multiple threads are sharing the same collection of resources, only the -- last call to @runResourceT@ will deallocate the resources. -- -- Since 0.3.0 runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a runResourceT (ResourceT r) = control $ \run -> do istate <- createInternalState E.mask $ \restore -> do res <- restore (run (r istate)) `E.onException` stateCleanup ReleaseException istate stateCleanup ReleaseNormal istate return res bracket_ :: MonadBaseControl IO m => IO () -- ^ allocate -> IO () -- ^ normal cleanup -> IO () -- ^ exceptional cleanup -> m a -> m a bracket_ alloc cleanupNormal cleanupExc inside = control $ \run -> E.mask $ \restore -> do alloc res <- restore (run inside) `E.onException` cleanupExc cleanupNormal return res finally :: MonadBaseControl IO m => m a -> IO () -> m a finally action cleanup = control $ \run -> E.finally (run action) cleanup -- | This function mirrors @join@ at the transformer level: it will collapse -- two levels of @ResourceT@ into a single @ResourceT@. -- -- Since 0.4.6 joinResourceT :: ResourceT (ResourceT m) a -> ResourceT m a joinResourceT (ResourceT f) = ResourceT $ \r -> unResourceT (f r) r -- | For backwards compatibility. type ExceptionT = CatchT -- | For backwards compatibility. runExceptionT :: ExceptionT m a -> m (Either SomeException a) runExceptionT = runCatchT -- | Same as 'runExceptionT', but immediately 'E.throw' any exception returned. -- -- Since 0.3.0 runExceptionT_ :: Monad m => ExceptionT m a -> m a runExceptionT_ = liftM (either E.throw id) . runExceptionT -- | Run an @ExceptionT Identity@ stack. -- -- Since 0.4.2 runException :: ExceptionT Identity a -> Either SomeException a runException = runIdentity . runExceptionT -- | Run an @ExceptionT Identity@ stack, but immediately 'E.throw' any exception returned. -- -- Since 0.4.2 runException_ :: ExceptionT Identity a -> a runException_ = runIdentity . runExceptionT_ -- | Introduce a reference-counting scheme to allow a resource context to be -- shared by multiple threads. Once the last thread exits, all remaining -- resources will be released. -- -- 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. -- -- Since 0.3.0 resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore -> -- We need to make sure the counter is incremented before this call -- returns. Otherwise, the parent thread may call runResourceT before -- the child thread increments, and all resources will be freed -- before the child gets called. bracket_ (stateAlloc r) (return ()) (return ()) (liftBaseDiscard forkIO $ bracket_ (return ()) (stateCleanup ReleaseNormal r) (stateCleanup ReleaseException r) (restore $ f r)) -- | A @Monad@ which can be used as a base for a @ResourceT@. -- -- A @ResourceT@ has some restrictions on its base monad: -- -- * @runResourceT@ requires an instance of @MonadBaseControl IO@. -- * @MonadResource@ requires an instance of @MonadThrow@, @MonadIO@, and @Applicative@. -- -- While any instance of @MonadBaseControl IO@ should be an instance of the -- other classes, this is not guaranteed by the type system (e.g., you may have -- a transformer in your stack with does not implement @MonadThrow@). Ideally, -- we would like to simply create an alias for the five type classes listed, -- but this is not possible with GHC currently. -- -- Instead, this typeclass acts as a proxy for the other five. Its only purpose -- is to make your type signatures shorter. -- -- Note that earlier versions of @conduit@ had a typeclass @ResourceIO@. This -- fulfills much the same role. -- -- Since 0.3.2 #if __GLASGOW_HASKELL__ >= 704 type MonadResourceBase m = (MonadBaseControl IO m, MonadThrow m, MonadBase IO m, MonadIO m, Applicative m) #else class (MonadBaseControl IO m, MonadThrow m, MonadIO m, Applicative m) => MonadResourceBase m instance (MonadBaseControl IO m, MonadThrow m, MonadIO m, Applicative m) => MonadResourceBase m #endif -- $internalState -- -- A @ResourceT@ internally is a modified @ReaderT@ monad transformer holding -- onto a mutable reference to all of the release actions still remaining to be -- performed. If you are building up a custom application monad, it may be more -- efficient to embed this @ReaderT@ functionality directly in your own monad -- instead of wrapping around @ResourceT@ itself. This section provides you the -- means of doing so. -- | Create a new internal state. This state must be closed with -- @closeInternalState@. It is your responsibility to ensure exception safety. -- Caveat emptor! -- -- Since 0.4.9 createInternalState :: MonadBase IO m => m InternalState createInternalState = liftBase $ I.newIORef $ ReleaseMap maxBound (minBound + 1) IntMap.empty -- | Close an internal state created by @createInternalState@. -- -- Since 0.4.9 closeInternalState :: MonadBase IO m => InternalState -> m () closeInternalState = liftBase . stateCleanup ReleaseNormal -- | Get the internal state of the current @ResourceT@. -- -- Since 0.4.6 getInternalState :: Monad m => ResourceT m InternalState getInternalState = ResourceT return -- | The internal state held by a @ResourceT@ transformer. -- -- Since 0.4.6 type InternalState = I.IORef ReleaseMap -- | Unwrap a @ResourceT@ using the given @InternalState@. -- -- Since 0.4.6 runInternalState :: ResourceT m a -> InternalState -> m a runInternalState = unResourceT -- | Run an action in the underlying monad, providing it the @InternalState@. -- -- Since 0.4.6 withInternalState :: (InternalState -> m a) -> ResourceT m a withInternalState = ResourceT -- | Backwards compatibility monadThrow :: (E.Exception e, MonadThrow m) => e -> m a monadThrow = throwM resourcet-1.1.7/Control/Monad/Trans/Resource/0000755000000000000000000000000012626621735017267 5ustar0000000000000000resourcet-1.1.7/Control/Monad/Trans/Resource/Internal.hs0000644000000000000000000002773212626621735021412 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RankNTypes #-} -- Can only mark as Safe when using a newer GHC, otherwise we get build -- failures due to the manual Typeable instance below. #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE Safe #-} #else {-# LANGUAGE Trustworthy #-} #endif module Control.Monad.Trans.Resource.Internal( InvalidAccess(..) , MonadResource(..) , ReleaseKey(..) , ReleaseMap(..) , ResIO , ResourceT(..) , stateAlloc , stateCleanup , transResourceT , register' , registerType ) where import Control.Exception (throw,Exception,SomeException) import Control.Applicative (Applicative (..), Alternative(..)) import Control.Monad (MonadPlus(..)) import Control.Monad.Trans.Control ( MonadTransControl (..), MonadBaseControl (..) ) import Control.Monad.Base (MonadBase, liftBase) import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) ) import Control.Monad.RWS.Class ( MonadRWS ) import Control.Monad.Reader.Class ( MonadReader (..) ) import Control.Monad.State.Class ( MonadState (..) ) import Control.Monad.Writer.Class ( MonadWriter (..) ) import Control.Monad.Trans.Identity ( IdentityT) import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT ) import Control.Monad.Trans.Error ( ErrorT, Error) import Control.Monad.Trans.Except ( ExceptT ) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.State ( StateT ) import Control.Monad.Trans.Writer ( WriterT ) import Control.Monad.Trans.RWS ( RWST ) import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST ) import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) import Control.Monad.IO.Class (MonadIO (..)) #if !(MIN_VERSION_monad_control(1,0,0)) import Control.Monad (liftM) #endif import qualified Control.Exception as E import Control.Monad.Catch (MonadThrow (..), MonadCatch (..) #if MIN_VERSION_exceptions(0,6,0) , MonadMask (..) #endif ) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import qualified Data.IORef as I import Data.Monoid import Data.Typeable import Data.Word(Word) import Prelude hiding (catch) import Data.Acquire.Internal (ReleaseType (..)) import Control.Monad.Morph -- | A @Monad@ which allows for safe resource allocation. In theory, any monad -- transformer stack included a @ResourceT@ can be an instance of -- @MonadResource@. -- -- Note: @runResourceT@ has a requirement for a @MonadBaseControl IO m@ monad, -- which allows control operations to be lifted. A @MonadResource@ does not -- have this requirement. This means that transformers such as @ContT@ can be -- an instance of @MonadResource@. However, the @ContT@ wrapper will need to be -- unwrapped before calling @runResourceT@. -- -- Since 0.3.0 class (MonadThrow m, MonadIO m, Applicative m, MonadBase IO m) => MonadResource m where -- | Lift a @ResourceT IO@ action into the current @Monad@. -- -- Since 0.4.0 liftResourceT :: ResourceT IO a -> m a -- | A lookup key for a specific release action. This value is returned by -- 'register' and 'allocate', and is passed to 'release'. -- -- Since 0.3.0 data ReleaseKey = ReleaseKey !(I.IORef ReleaseMap) !Int deriving Typeable type RefCount = Word type NextKey = Int data ReleaseMap = ReleaseMap !NextKey !RefCount !(IntMap (ReleaseType -> IO ())) | ReleaseMapClosed -- | Convenient alias for @ResourceT IO@. type ResIO a = ResourceT IO a instance MonadCont m => MonadCont (ResourceT m) where callCC f = ResourceT $ \i -> callCC $ \c -> unResourceT (f (ResourceT . const . c)) i instance MonadError e m => MonadError e (ResourceT m) where throwError = lift . throwError catchError r h = ResourceT $ \i -> unResourceT r i `catchError` \e -> unResourceT (h e) i instance MonadRWS r w s m => MonadRWS r w s (ResourceT m) instance MonadReader r m => MonadReader r (ResourceT m) where ask = lift ask local = mapResourceT . local mapResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b mapResourceT f = ResourceT . (f .) . unResourceT instance MonadState s m => MonadState s (ResourceT m) where get = lift get put = lift . put instance MonadWriter w m => MonadWriter w (ResourceT m) where tell = lift . tell listen = mapResourceT listen pass = mapResourceT pass instance MonadThrow m => MonadThrow (ResourceT m) where throwM = lift . throwM instance MonadCatch m => MonadCatch (ResourceT m) where catch (ResourceT m) c = ResourceT $ \r -> m r `catch` \e -> unResourceT (c e) r #if MIN_VERSION_exceptions(0,6,0) instance MonadMask m => MonadMask (ResourceT m) where #endif mask a = ResourceT $ \e -> mask $ \u -> unResourceT (a $ q u) e where q u (ResourceT b) = ResourceT (u . b) uninterruptibleMask a = ResourceT $ \e -> uninterruptibleMask $ \u -> unResourceT (a $ q u) e where q u (ResourceT b) = ResourceT (u . b) instance (MonadThrow m, MonadBase IO m, MonadIO m, Applicative m) => MonadResource (ResourceT m) where liftResourceT = transResourceT liftIO -- | Transform the monad a @ResourceT@ lives in. This is most often used to -- strip or add new transformers to a stack, e.g. to run a @ReaderT@. -- -- Note that this function is a slight generalization of 'hoist'. -- -- Since 0.3.0 transResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b transResourceT f (ResourceT mx) = ResourceT (\r -> f (mx r)) -- | Since 0.4.7 instance MFunctor ResourceT where hoist f (ResourceT mx) = ResourceT (\r -> f (mx r)) -- | Since 0.4.7 instance MMonad ResourceT where embed f m = ResourceT (\i -> unResourceT (f (unResourceT m i)) i) -- | The Resource transformer. This transformer keeps track of all registered -- actions, and calls them upon exit (via 'runResourceT'). Actions may be -- registered via 'register', or resources may be allocated atomically via -- 'allocate'. @allocate@ corresponds closely to @bracket@. -- -- Releasing may be performed before exit via the 'release' function. This is a -- highly recommended optimization, as it will ensure that scarce resources are -- freed early. Note that calling @release@ will deregister the action, so that -- a release action will only ever be called once. -- -- Since 0.3.0 newtype ResourceT m a = ResourceT { unResourceT :: I.IORef ReleaseMap -> m a } #if __GLASGOW_HASKELL__ >= 707 deriving Typeable #else instance Typeable1 m => Typeable1 (ResourceT m) where typeOf1 = goType undefined where goType :: Typeable1 m => m a -> ResourceT m a -> TypeRep goType m _ = mkTyConApp #if __GLASGOW_HASKELL__ >= 704 (mkTyCon3 "resourcet" "Control.Monad.Trans.Resource" "ResourceT") #else (mkTyCon "Control.Monad.Trans.Resource.ResourceT") #endif [ typeOf1 m ] #endif -- | Indicates either an error in the library, or misuse of it (e.g., a -- @ResourceT@'s state is accessed after being released). -- -- Since 0.3.0 data InvalidAccess = InvalidAccess { functionName :: String } deriving Typeable instance Show InvalidAccess where show (InvalidAccess f) = concat [ "Control.Monad.Trans.Resource." , f , ": The mutable state is being accessed after cleanup. Please contact the maintainers." ] instance Exception InvalidAccess -------- All of our monad et al instances instance Functor m => Functor (ResourceT m) where fmap f (ResourceT m) = ResourceT $ \r -> fmap f (m r) instance Applicative m => Applicative (ResourceT m) where pure = ResourceT . const . pure ResourceT mf <*> ResourceT ma = ResourceT $ \r -> mf r <*> ma r -- | Since 1.1.5 instance Alternative m => Alternative (ResourceT m) where empty = ResourceT $ \_ -> empty (ResourceT mf) <|> (ResourceT ma) = ResourceT $ \r -> mf r <|> ma r -- | Since 1.1.5 instance MonadPlus m => MonadPlus (ResourceT m) where mzero = ResourceT $ \_ -> mzero (ResourceT mf) `mplus` (ResourceT ma) = ResourceT $ \r -> mf r `mplus` ma r instance Monad m => Monad (ResourceT m) where #if !MIN_VERSION_base(4,8,0) return = ResourceT . const . return #endif ResourceT ma >>= f = ResourceT $ \r -> do a <- ma r let ResourceT f' = f a f' r instance MonadTrans ResourceT where lift = ResourceT . const instance MonadIO m => MonadIO (ResourceT m) where liftIO = lift . liftIO instance MonadBase b m => MonadBase b (ResourceT m) where liftBase = lift . liftBase instance MonadTransControl ResourceT where #if MIN_VERSION_monad_control(1,0,0) type StT ResourceT a = a liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> t r restoreT = ResourceT . const #else newtype StT ResourceT a = StReader {unStReader :: a} liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r restoreT = ResourceT . const . liftM unStReader #endif {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where #if MIN_VERSION_monad_control(1,0,0) type StM (ResourceT m) a = StM m a liftBaseWith f = ResourceT $ \reader' -> liftBaseWith $ \runInBase -> f $ runInBase . (\(ResourceT r) -> r reader' ) restoreM = ResourceT . const . restoreM #else newtype StM (ResourceT m) a = StMT (StM m a) liftBaseWith f = ResourceT $ \reader' -> liftBaseWith $ \runInBase -> f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader' ) restoreM (StMT base) = ResourceT $ const $ restoreM base #endif #define GO(T) instance (MonadResource m) => MonadResource (T m) where liftResourceT = lift . liftResourceT #define GOX(X, T) instance (X, MonadResource m) => MonadResource (T m) where liftResourceT = lift . liftResourceT GO(IdentityT) GO(ListT) GO(MaybeT) GOX(Error e, ErrorT e) #if MIN_VERSION_exceptions(0, 8, 0) GO(ExceptT e) #endif GO(ReaderT r) GO(ContT r) GO(StateT s) GOX(Monoid w, WriterT w) GOX(Monoid w, RWST r w s) GOX(Monoid w, Strict.RWST r w s) GO(Strict.StateT s) GOX(Monoid w, Strict.WriterT w) #undef GO #undef GOX stateAlloc :: I.IORef ReleaseMap -> IO () stateAlloc istate = do I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> (ReleaseMap nk (rf + 1) m, ()) ReleaseMapClosed -> throw $ InvalidAccess "stateAlloc" stateCleanup :: ReleaseType -> I.IORef ReleaseMap -> IO () stateCleanup rtype istate = E.mask_ $ do mm <- I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap nk rf m -> let rf' = rf - 1 in if rf' == minBound then (ReleaseMapClosed, Just m) else (ReleaseMap nk rf' m, Nothing) ReleaseMapClosed -> throw $ InvalidAccess "stateCleanup" case mm of Just m -> mapM_ (\x -> try (x rtype) >> return ()) $ IntMap.elems m Nothing -> return () where try :: IO a -> IO (Either SomeException a) try = E.try register' :: I.IORef ReleaseMap -> IO () -> IO ReleaseKey register' istate rel = I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap key rf m -> ( ReleaseMap (key - 1) rf (IntMap.insert key (const rel) m) , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'" -- | -- -- Since 1.1.2 registerType :: I.IORef ReleaseMap -> (ReleaseType -> IO ()) -> IO ReleaseKey registerType istate rel = I.atomicModifyIORef istate $ \rm -> case rm of ReleaseMap key rf m -> ( ReleaseMap (key - 1) rf (IntMap.insert key rel m) , ReleaseKey istate key ) ReleaseMapClosed -> throw $ InvalidAccess "register'" resourcet-1.1.7/Data/0000755000000000000000000000000012626621735012604 5ustar0000000000000000resourcet-1.1.7/Data/Acquire.hs0000644000000000000000000000233512626621735014534 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | This was previously known as the Resource monad. However, that term is -- confusing next to the ResourceT transformer, so it has been renamed. module Data.Acquire ( Acquire , with , withEx , mkAcquire , mkAcquireType , allocateAcquire , ReleaseType (..) ) where import Control.Monad.Trans.Resource.Internal import Control.Monad.Trans.Resource import Data.Acquire.Internal import Control.Applicative (Applicative (..)) import Control.Monad.Base (MonadBase (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Control (MonadBaseControl, control) import qualified Control.Exception.Lifted as E import Data.Typeable (Typeable) import Control.Monad (liftM, ap) -- | Allocate a resource and register an action with the @MonadResource@ to -- free the resource. -- -- Since 1.1.0 allocateAcquire :: MonadResource m => Acquire a -> m (ReleaseKey, a) allocateAcquire = liftResourceT . allocateAcquireRIO allocateAcquireRIO :: Acquire a -> ResourceT IO (ReleaseKey, a) allocateAcquireRIO (Acquire f) = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do Allocated a free <- f restore key <- registerType istate free return (key, a) resourcet-1.1.7/Data/Acquire/0000755000000000000000000000000012626621735014175 5ustar0000000000000000resourcet-1.1.7/Data/Acquire/Internal.hs0000644000000000000000000001114312626621735016305 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} module Data.Acquire.Internal ( Acquire (..) , Allocated (..) , with , withEx , mkAcquire , ReleaseType (..) , mkAcquireType ) where import Control.Applicative (Applicative (..)) import Control.Monad.Base (MonadBase (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Control (MonadBaseControl, control) import qualified Control.Exception.Lifted as E import Data.Typeable (Typeable) import Control.Monad (liftM, ap) import qualified Control.Monad.Catch as C import GHC.IO (unsafeUnmask) -- | The way in which a release is called. -- -- Since 1.1.2 data ReleaseType = ReleaseEarly | ReleaseNormal | ReleaseException deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) data Allocated a = Allocated !a !(ReleaseType -> IO ()) -- | A method for acquiring a scarce resource, providing the means of freeing -- it when no longer needed. This data type provides -- @Functor@/@Applicative@/@Monad@ instances for composing different resources -- together. You can allocate these resources using either the @bracket@ -- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@). -- -- This concept was originally introduced by Gabriel Gonzalez and described at: -- . The -- implementation in this package is slightly different, due to taking a -- different approach to async exception safety. -- -- Since 1.1.0 newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a)) deriving Typeable instance Functor Acquire where fmap = liftM instance Applicative Acquire where pure a = Acquire (\_ -> return (Allocated a (const $ return ()))) (<*>) = ap instance Monad Acquire where return = pure Acquire f >>= g' = Acquire $ \restore -> do Allocated x free1 <- f restore let Acquire g = g' x Allocated y free2 <- g restore `E.onException` free1 ReleaseException return $! Allocated y (\rt -> free2 rt `E.finally` free1 rt) instance MonadIO Acquire where liftIO f = Acquire $ \restore -> do x <- restore f return $! Allocated x (const $ return ()) instance MonadBase IO Acquire where liftBase = liftIO -- | Create an @Acquire@ value using the given allocate and free functions. -- -- Since 1.1.0 mkAcquire :: IO a -- ^ acquire the resource -> (a -> IO ()) -- ^ free the resource -> Acquire a mkAcquire create free = Acquire $ \restore -> do x <- restore create return $! Allocated x (const $ free x) -- | Same as 'mkAcquire', but the cleanup function will be informed of /how/ -- cleanup was initiated. This allows you to distinguish, for example, between -- normal and exceptional exits. -- -- Since 1.1.2 mkAcquireType :: IO a -- ^ acquire the resource -> (a -> ReleaseType -> IO ()) -- ^ free the resource -> Acquire a mkAcquireType create free = Acquire $ \restore -> do x <- restore create return $! Allocated x (free x) -- | Allocate the given resource and provide it to the provided function. The -- resource will be freed as soon as the inner block is exited, whether -- normally or via an exception. This function is similar in function to -- @bracket@. -- -- Since 1.1.0 with :: MonadBaseControl IO m => Acquire a -> (a -> m b) -> m b with (Acquire f) g = control $ \run -> E.mask $ \restore -> do Allocated x free <- f restore res <- restore (run (g x)) `E.onException` free ReleaseException free ReleaseNormal return res -- | Same as @with@, but uses the @MonadMask@ typeclass from exceptions instead -- of @MonadBaseControl@ from exceptions. -- -- Since 1.1.3 #if MIN_VERSION_exceptions(0,6,0) withEx :: (C.MonadMask m, MonadIO m) #else withEx :: (C.MonadCatch m, MonadIO m) #endif => Acquire a -> (a -> m b) -> m b withEx (Acquire f) g = do -- We need to do some funny business, since the restore we get below is -- specialized to the m from the result, whereas we need a restore function -- in IO. Checking the current masking state is exactly how mask is -- implemented in base. origMS <- liftIO E.getMaskingState C.mask $ \restore -> do Allocated x free <- liftIO $ f $ case origMS of E.Unmasked -> unsafeUnmask _ -> id res <- restore (g x) `C.onException` liftIO (free ReleaseException) liftIO $ free ReleaseNormal return res resourcet-1.1.7/test/0000755000000000000000000000000012626621735012712 5ustar0000000000000000resourcet-1.1.7/test/main.hs0000644000000000000000000001216212626621735014174 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} import Control.Concurrent import Control.Concurrent.Lifted (fork) import Control.Exception (Exception, MaskingState (MaskedInterruptible), getMaskingState, throwIO, try) import Control.Exception (SomeException, handle) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource import Data.IORef import Data.Typeable (Typeable) import Test.Hspec import Data.Acquire main :: IO () main = hspec $ do describe "general" $ do it "survives releasing bottom" $ do x <- newIORef 0 handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do _ <- register $ writeIORef x 1 release undefined x' <- readIORef x x' `shouldBe` 1 describe "early release" $ do it "works from a different context" $ do x <- newIORef 0 runResourceT $ do key <- register $ writeIORef x 1 runResourceT $ release key y <- liftIO $ readIORef x liftIO $ y `shouldBe` 1 describe "forking" $ do forkHelper "resourceForkIO" resourceForkIO --forkHelper "lifted fork" fork describe "unprotecting" $ do it "unprotect keeps resource from being cleared" $ do x <- newIORef 0 runResourceT $ do key <- register $ writeIORef x 1 unprotect key y <- readIORef x y `shouldBe` 0 it "cleanup actions are masked #144" $ do let checkMasked name = do ms <- getMaskingState unless (ms == MaskedInterruptible) $ error $ show (name, ms) runResourceT $ do register (checkMasked "release") >>= release register (checkMasked "normal") Left Dummy <- try $ runResourceT $ do register (checkMasked "exception") liftIO $ throwIO Dummy return () describe "mkAcquireType" $ do describe "ResourceT" $ do it "early" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just runResourceT $ do (releaseKey, ()) <- allocateAcquire acq release releaseKey readIORef ref >>= (`shouldBe` Just ReleaseEarly) it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just runResourceT $ do (_releaseKey, ()) <- allocateAcquire acq return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ runResourceT $ do (_releaseKey, ()) <- allocateAcquire acq liftIO $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) describe "with" $ do it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just with acq $ const $ return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ with acq $ const $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) describe "withEx" $ do it "normal" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just withEx acq $ const $ return () readIORef ref >>= (`shouldBe` Just ReleaseNormal) it "exception" $ do ref <- newIORef Nothing let acq = mkAcquireType (return ()) $ \() -> writeIORef ref . Just Left Dummy <- try $ withEx acq $ const $ throwIO Dummy readIORef ref >>= (`shouldBe` Just ReleaseException) data Dummy = Dummy deriving (Show, Typeable) instance Exception Dummy 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 () y1 <- readIORef y y1 `shouldBe` 0 putMVar x () z' <- takeMVar z z' `shouldBe` 0 y2 <- readIORef y Just y2 `shouldBe` Just 1