resourcet 0.4.10.2 → 1.1.0
raw patch · 5 files changed
+158/−292 lines, 5 filesdep +exceptions
Dependencies added: exceptions
Files
- Control/Monad/Trans/Resource.hs +22/−84
- Control/Monad/Trans/Resource/Internal.hs +18/−207
- Data/Acquire.hs +32/−0
- Data/Acquire/Internal.hs +82/−0
- resourcet.cabal +4/−1
Control/Monad/Trans/Resource.hs view
@@ -29,11 +29,6 @@ -- * Monad transformation , transResourceT , joinResourceT- -- * A specific Exception transformer- , ExceptionT (..)- , runExceptionT_- , runException- , runException_ -- * Registering/releasing , allocate , register@@ -42,9 +37,6 @@ , resourceMask -- * Type class/associated types , MonadResource (..)- , MonadUnsafeIO (..)- , MonadThrow (..)- , MonadActive (..) , MonadResourceBase -- ** Low-level , InvalidAccess (..)@@ -58,11 +50,14 @@ , withInternalState , createInternalState , closeInternalState- -- * Resource- , Resource- , mkResource- , with- , allocateResource+ -- * Backwards compatibility+ , ExceptionT (..)+ , runExceptionT+ , runExceptionT_+ , runException+ , runException_+ , MonadThrow (..)+ , monadThrow ) where import qualified Data.IntMap as IntMap@@ -99,6 +94,8 @@ import Data.Functor.Identity (Identity, runIdentity) import Control.Monad.Morph+import Control.Monad.Catch (MonadThrow, throwM)+import Control.Monad.Catch.Pure (CatchT, runCatchT) @@ -140,13 +137,6 @@ -> m (ReleaseKey, a) allocate a = liftResourceT . allocateRIO a --- | Allocate a resource and register an action with the @MonadResource@ to--- free the resource.------ Since 0.4.10-allocateResource :: MonadResource m => Resource a -> m (ReleaseKey, a)-allocateResource = liftResourceT . allocateResourceRIO- -- | Perform asynchronous exception masking. -- -- This is more general then @Control.Exception.mask@, yet more efficient@@ -162,12 +152,6 @@ key <- register' istate $ rel a return (key, a) -allocateResourceRIO :: Resource a -> ResourceT IO (ReleaseKey, a)-allocateResourceRIO (Resource f) = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do- Allocated a free <- f restore- key <- register' istate free- return (key, a)- registerRIO :: IO () -> ResourceT IO ReleaseKey registerRIO rel = ResourceT $ \istate -> liftIO $ register' istate rel @@ -179,19 +163,8 @@ go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a) go r (ResourceT g) = ResourceT (\i -> r (g i)) -register' :: I.IORef ReleaseMap- -> IO ()- -> IO ReleaseKey-register' istate rel = I.atomicModifyIORef istate $ \rm ->- case rm of- ReleaseMap key rf m ->- ( ReleaseMap (key - 1) rf (IntMap.insert key rel m)- , ReleaseKey istate key- )- ReleaseMapClosed -> throw $ InvalidAccess "register'" - release' :: I.IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a)@@ -244,7 +217,12 @@ -> 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. --@@ -293,50 +271,6 @@ --- | Determine if some monad is still active. This is intended to prevent usage--- of a monadic state after it has been closed. This is necessary for such--- cases as lazy I\/O, where an unevaluated thunk may still refer to a--- closed @ResourceT@.------ Since 0.3.0-class Monad m => MonadActive m where- monadActive :: m Bool--instance (MonadIO m, MonadActive m) => MonadActive (ResourceT m) where- monadActive = ResourceT $ \rmMap -> do- rm <- liftIO $ I.readIORef rmMap- case rm of- ReleaseMapClosed -> return False- _ -> monadActive -- recurse--instance MonadActive Identity where- monadActive = return True--instance MonadActive IO where- monadActive = return True--instance MonadActive (ST s) where- monadActive = return True--instance MonadActive (Lazy.ST s) where- monadActive = return True--#define GO(T) instance MonadActive m => MonadActive (T m) where monadActive = lift monadActive-#define GOX(X, T) instance (X, MonadActive m) => MonadActive (T m) where monadActive = lift monadActive-GO(IdentityT)-GO(ListT)-GO(MaybeT)-GOX(Error e, ErrorT e)-GO(ReaderT r)-GO(StateT s)-GOX(Monoid w, WriterT w)-GOX(Monoid w, RWST r w s)-GOX(Monoid w, Strict.RWST r w s)-GO(Strict.StateT s)-GOX(Monoid w, Strict.WriterT w)-#undef GO-#undef GOX- -- | A @Monad@ which can be used as a base for a @ResourceT@. -- -- A @ResourceT@ has some restrictions on its base monad:@@ -358,10 +292,10 @@ -- -- Since 0.3.2 #if __GLASGOW_HASKELL__ >= 704-type MonadResourceBase m = (MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m)+type MonadResourceBase m = (MonadBaseControl IO m, MonadThrow m, MonadBase IO m, MonadIO m, Applicative m) #else-class (MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResourceBase m-instance (MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResourceBase m+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@@ -411,3 +345,7 @@ -- Since 0.4.6 withInternalState :: (InternalState -> m a) -> ResourceT m a withInternalState = ResourceT++-- | Backwards compatibility+monadThrow :: (E.Exception e, MonadThrow m) => e -> m a+monadThrow = throwM
Control/Monad/Trans/Resource/Internal.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-}@@ -8,11 +9,8 @@ {-# LANGUAGE RankNTypes #-} module Control.Monad.Trans.Resource.Internal(- ExceptionT(..)- , InvalidAccess(..)+ InvalidAccess(..) , MonadResource(..)- , MonadThrow(..)- , MonadUnsafeIO(..) , ReleaseKey(..) , ReleaseMap(..) , ResIO@@ -20,10 +18,7 @@ , stateAlloc , stateCleanup , transResourceT- , Resource (..)- , Allocated (..)- , with- , mkResource+ , register' ) where import Control.Exception (throw,Exception,SomeException)@@ -57,6 +52,7 @@ import Control.Monad (liftM, ap) import qualified Control.Exception as E import Control.Monad.ST (ST)+import Control.Monad.Catch (MonadThrow (..)) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import qualified Data.IORef as I@@ -91,7 +87,7 @@ -- unwrapped before calling @runResourceT@. -- -- Since 0.3.0-class (MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResource m where+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@@ -141,43 +137,9 @@ listen = mapResourceT listen pass = mapResourceT pass --- | A @Monad@ which can throw exceptions. Note that this does not work in a--- vanilla @ST@ or @Identity@ monad. Instead, you should use the 'ExceptionT'--- transformer in your stack if you are dealing with a non-@IO@ base monad.------ Since 0.3.0-class Monad m => MonadThrow m where- monadThrow :: E.Exception e => e -> m a--instance MonadThrow IO where- monadThrow = E.throwIO--instance MonadThrow Maybe where- monadThrow _ = Nothing-instance MonadThrow (Either SomeException) where- monadThrow = Left . E.toException-instance MonadThrow [] where- monadThrow _ = []--#define GO(T) instance (MonadThrow m) => MonadThrow (T m) where monadThrow = lift . monadThrow-#define GOX(X, T) instance (X, MonadThrow m) => MonadThrow (T m) where monadThrow = lift . monadThrow-GO(IdentityT)-GO(ListT)-GO(MaybeT)-GOX(Error e, ErrorT e)-GO(ReaderT r)-GO(ContT r)-GO(ResourceT)-GO(StateT s)-GOX(Monoid w, WriterT w)-GOX(Monoid w, RWST r w s)-GOX(Monoid w, Strict.RWST r w s)-GO(Strict.StateT s)-GOX(Monoid w, Strict.WriterT w)-#undef GO-#undef GOX--instance (MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResource (ResourceT m) where+instance MonadThrow m => MonadThrow (ResourceT m) where+ throwM = lift . throwM+instance (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@@ -282,12 +244,6 @@ liftBaseWith $ \runInBase -> f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader' ) restoreM (StMT base) = ResourceT $ const $ restoreM base-instance Monad m => MonadThrow (ExceptionT m) where- monadThrow = ExceptionT . return . Left . E.toException-instance MonadResource m => MonadResource (ExceptionT m) where- liftResourceT = lift . liftResourceT-instance MonadIO m => MonadIO (ExceptionT m) where- liftIO = lift . liftIO #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@@ -306,13 +262,6 @@ #undef GO #undef GOX ---- | The express purpose of this transformer is to allow non-@IO@-based monad--- stacks to catch exceptions via the 'MonadThrow' typeclass.------ Since 0.3.0-newtype ExceptionT m a = ExceptionT { runExceptionT :: m (Either SomeException a) }- stateAlloc :: I.IORef ReleaseMap -> IO () stateAlloc istate = do I.atomicModifyIORef istate $ \rm ->@@ -339,151 +288,13 @@ try :: IO a -> IO (Either SomeException a) try = E.try ---- | A @Monad@ based on some monad which allows running of some 'IO' actions,--- via unsafe calls. This applies to 'IO' and 'ST', for instance.------ Since 0.3.0-class Monad m => MonadUnsafeIO m where- unsafeLiftIO :: IO a -> m a--instance MonadUnsafeIO IO where- unsafeLiftIO = id--instance MonadUnsafeIO (ST s) where- unsafeLiftIO = unsafeIOToST--instance MonadUnsafeIO (Lazy.ST s) where- unsafeLiftIO = LazyUnsafe.unsafeIOToST--instance (MonadTrans t, MonadUnsafeIO m, Monad (t m)) => MonadUnsafeIO (t m) where- unsafeLiftIO = lift . unsafeLiftIO--instance Monad m => Functor (ExceptionT m) where- fmap f = ExceptionT . (liftM . fmap) f . runExceptionT-instance Monad m => Applicative (ExceptionT m) where- pure = ExceptionT . return . Right- ExceptionT mf <*> ExceptionT ma = ExceptionT $ do- ef <- mf- case ef of- Left e -> return (Left e)- Right f -> do- ea <- ma- case ea of- Left e -> return (Left e)- Right x -> return (Right (f x))-instance Monad m => Monad (ExceptionT m) where- return = pure- ExceptionT ma >>= f = ExceptionT $ do- ea <- ma- case ea of- Left e -> return (Left e)- Right a -> runExceptionT (f a)-instance MonadBase b m => MonadBase b (ExceptionT m) where- liftBase = lift . liftBase-instance MonadTrans ExceptionT where- lift = ExceptionT . liftM Right-instance MonadTransControl ExceptionT where- newtype StT ExceptionT a = StExc { unStExc :: Either SomeException a }- liftWith f = ExceptionT $ liftM return $ f $ liftM StExc . runExceptionT- restoreT = ExceptionT . liftM unStExc-instance MonadBaseControl b m => MonadBaseControl b (ExceptionT m) where- newtype StM (ExceptionT m) a = StE { unStE :: ComposeSt ExceptionT m a }- liftBaseWith = defaultLiftBaseWith StE- restoreM = defaultRestoreM unStE--instance MonadCont m => MonadCont (ExceptionT m) where- callCC f = ExceptionT $- callCC $ \c ->- runExceptionT (f (\a -> ExceptionT $ c (Right a)))--instance MonadError e m => MonadError e (ExceptionT m) where- throwError = lift . throwError- catchError r h = ExceptionT $ runExceptionT r `catchError` (runExceptionT . h)--instance MonadRWS r w s m => MonadRWS r w s (ExceptionT m)--instance MonadReader r m => MonadReader r (ExceptionT m) where- ask = lift ask- local = mapExceptionT . local--mapExceptionT :: (m (Either SomeException a) -> n (Either SomeException b)) -> ExceptionT m a -> ExceptionT n b-mapExceptionT f = ExceptionT . f . runExceptionT--instance MonadState s m => MonadState s (ExceptionT m) where- get = lift get- put = lift . put--instance MonadWriter w m => MonadWriter w (ExceptionT m) where- tell = lift . tell- listen = mapExceptionT $ \ m -> do- (a, w) <- listen m- return $! fmap (\ r -> (r, w)) a- pass = mapExceptionT $ \ m -> pass $ do- a <- m- return $! case a of- Left l -> (Left l, id)- Right (r, f) -> (Right r, f)--data Allocated a = Allocated !a !(IO ())---- | A method for allocating a scarce resource, providing the means of freeing--- it when no longer needed. This data type provides--- @Functor@/@Applicative@/@Monad@ instances for composing different resources--- together. You can allocate these resources using either the @bracket@--- pattern (via @with@) or using @ResourceT@ (via @allocateResource@).------ This concept was originally introduced by Gabriel Gonzalez and described at:--- <http://www.haskellforall.com/2013/06/the-resource-applicative.html>. The--- implementation in this package is slightly different, due to taking a--- different approach to async exception safety.------ Since 0.4.10-newtype Resource a = Resource ((forall b. IO b -> IO b) -> IO (Allocated a))- deriving Typeable--instance Functor Resource where- fmap = liftM-instance Applicative Resource where- pure = return- (<*>) = ap--instance Monad Resource where- return a = Resource (\_ -> return (Allocated a (return ())))- Resource f >>= g' = Resource $ \restore -> do- Allocated x free1 <- f restore- let Resource g = g' x- Allocated y free2 <- g restore `E.onException` free1- return $! Allocated y (free2 `E.finally` free1)--instance MonadIO Resource where- liftIO f = Resource $ \restore -> do- x <- restore f- return $! Allocated x (return ())--instance MonadBase IO Resource where- liftBase = liftIO---- | Create a @Resource@ value using the given allocate and free functions.------ Since 0.4.10-mkResource :: IO a -- ^ allocate the resource- -> (a -> IO ()) -- ^ free the resource- -> Resource a-mkResource create free = Resource $ \restore -> do- x <- restore create- return $! Allocated x (free x)---- | Allocate the given resource and provide it to the provided function. The--- resource will be freed as soon as the inner block is exited, whether--- normally or via an exception. This function is similar in function to--- @bracket@.------ Since 0.4.10-with :: MonadBaseControl IO m- => Resource a- -> (a -> m b)- -> m b-with (Resource f) g = control $ \run -> E.mask $ \restore -> do- Allocated x free <- f restore- run (g x) `E.finally` free+register' :: I.IORef ReleaseMap+ -> IO ()+ -> IO ReleaseKey+register' istate rel = I.atomicModifyIORef istate $ \rm ->+ case rm of+ ReleaseMap key rf m ->+ ( ReleaseMap (key - 1) rf (IntMap.insert key rel m)+ , ReleaseKey istate key+ )+ ReleaseMapClosed -> throw $ InvalidAccess "register'"
+ Data/Acquire.hs view
@@ -0,0 +1,32 @@+-- | 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+ , mkAcquire+ , allocateAcquire+ ) 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 <- register' istate free+ return (key, a)
+ Data/Acquire/Internal.hs view
@@ -0,0 +1,82 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+module Data.Acquire.Internal+ ( Acquire (..)+ , Allocated (..)+ , with+ , mkAcquire+ ) 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)++data Allocated a = Allocated !a !(IO ())++-- | A method for acquiring a scarce resource, providing the means of freeing+-- it when no longer needed. This data type provides+-- @Functor@/@Applicative@/@Monad@ instances for composing different resources+-- together. You can allocate these resources using either the @bracket@+-- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@).+--+-- This concept was originally introduced by Gabriel Gonzalez and described at:+-- <http://www.haskellforall.com/2013/06/the-resource-applicative.html>. The+-- implementation in this package is slightly different, due to taking a+-- different approach to async exception safety.+--+-- Since 1.1.0+newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a))+ deriving Typeable++instance Functor Acquire where+ fmap = liftM+instance Applicative Acquire where+ pure = return+ (<*>) = ap++instance Monad Acquire where+ return a = Acquire (\_ -> return (Allocated a (return ())))+ Acquire f >>= g' = Acquire $ \restore -> do+ Allocated x free1 <- f restore+ let Acquire g = g' x+ Allocated y free2 <- g restore `E.onException` free1+ return $! Allocated y (free2 `E.finally` free1)++instance MonadIO Acquire where+ liftIO f = Acquire $ \restore -> do+ x <- restore f+ return $! Allocated x (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 (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+ run (g x) `E.finally` free
resourcet.cabal view
@@ -1,5 +1,5 @@ Name: resourcet-Version: 0.4.10.2+Version: 1.1.0 Synopsis: Deterministic allocation and freeing of scarce resources. Description: This package was originally included with the conduit package, and has since been split off. For more information, please see <http://www.yesodweb.com/book/conduits>.@@ -15,6 +15,8 @@ Library Exposed-modules: Control.Monad.Trans.Resource Control.Monad.Trans.Resource.Internal+ Data.Acquire+ Data.Acquire.Internal Build-depends: base >= 4.3 && < 5 , lifted-base >= 0.1 , transformers-base >= 0.4.1 && < 0.5@@ -23,6 +25,7 @@ , transformers >= 0.2.2 && < 0.4 , mtl >= 2.0 && < 2.2 , mmorph+ , exceptions >= 0.5 ghc-options: -Wall test-suite test