resourcet 0.4.7.2 → 0.4.8

raw patch · 3 files changed

+426/−361 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Monad/Trans/Resource.hs +4/−360
• Control/Monad/Trans/Resource/Internal.hs +420/−0
• resourcet.cabal +2/−1

@@ -38,7 +38,7 @@     , allocate     , register     , release-    , unprotect +    , unprotect     , resourceMask       -- * Type class/associated types     , MonadResource (..)@@ -58,19 +58,13 @@     , withInternalState     ) where -import Data.Typeable-import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap-import Control.Exception (SomeException, throw, Exception)+import Control.Exception (SomeException, throw) import Control.Monad.Trans.Control-    ( MonadTransControl (..), MonadBaseControl (..)-    , ComposeSt, defaultLiftBaseWith, defaultRestoreM-    , liftBaseDiscard, control-    )+    ( MonadBaseControl (..), liftBaseDiscard, control ) import qualified Data.IORef as I import Control.Monad.Base (MonadBase, liftBase) import Control.Applicative (Applicative (..))-import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad (liftM) import qualified Control.Exception as E@@ -82,134 +76,26 @@ import Control.Monad.Trans.Maybe    ( MaybeT   ) import Control.Monad.Trans.Error    ( ErrorT, Error) import Control.Monad.Trans.Reader   ( ReaderT  )-import Control.Monad.Trans.Cont     ( ContT  ) import Control.Monad.Trans.State    ( StateT   ) import Control.Monad.Trans.Writer   ( WriterT  )+import Control.Monad.Trans.Resource.Internal import Control.Monad.Trans.RWS      ( RWST     ) -import 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 Data.Word (Word)- import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   ) import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) import Control.Concurrent (ThreadId, forkIO)  import Control.Monad.ST (ST)-#if __GLASGOW_HASKELL__ >= 704-import Control.Monad.ST.Unsafe (unsafeIOToST)-#else-import Control.Monad.ST (unsafeIOToST)-#endif -#if __GLASGOW_HASKELL__ >= 704-import qualified Control.Monad.ST.Lazy.Unsafe as LazyUnsafe-#else-import qualified Control.Monad.ST.Lazy as LazyUnsafe-#endif- import qualified Control.Monad.ST.Lazy as Lazy  import Data.Functor.Identity (Identity, runIdentity) import Control.Monad.Morph --- | 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 (IO ()))-  | ReleaseMapClosed --- | 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---- | 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----- | 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, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResource m where-    -- | Lift a @ResourceT IO@ action into the current @Monad@.-    ---    -- Since 0.4.0-    liftResourceT :: ResourceT IO a -> m a- -- | Register some action that will be called precisely once, either when -- 'runResourceT' is called, or when the 'ReleaseKey' is passed to 'release'. --@@ -256,9 +142,6 @@ resourceMask :: MonadResource m => ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> m b resourceMask = liftResourceT . resourceMaskRIO -instance (MonadThrow m, MonadUnsafeIO m, MonadIO m, Applicative m) => MonadResource (ResourceT m) where-    liftResourceT = transResourceT liftIO- allocateRIO :: IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a) allocateRIO acquire rel = ResourceT $ \istate -> liftIO $ E.mask $ \restore -> do     a <- restore acquire@@ -276,23 +159,6 @@     go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a)     go r (ResourceT g) = ResourceT (\i -> r (g i)) -#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)-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- register' :: I.IORef ReleaseMap           -> IO ()           -> IO ReleaseKey@@ -304,22 +170,8 @@             )         ReleaseMapClosed -> throw $ InvalidAccess "register'" --- | 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- release' :: I.IORef ReleaseMap          -> Int          -> (Maybe (IO ()) -> IO a)@@ -342,31 +194,7 @@     -- 0.4.4, it's no longer a library misuse or a library bug.     lookupAction ReleaseMapClosed = (ReleaseMapClosed, Nothing) -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 :: I.IORef ReleaseMap -> IO ()-stateCleanup 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 >> return ()) $ IntMap.elems m-        Nothing -> return ()-  where-    try :: IO a -> IO (Either SomeException a)-    try = E.try  -- | Unwrap a 'ResourceT' transformer, and call all registered release actions. --@@ -388,23 +216,7 @@ bracket_ alloc cleanup inside =     control $ \run -> E.bracket_ alloc cleanup (run inside) --- | 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)  -- | This function mirrors @join@ at the transformer level: it will collapse -- two levels of @ResourceT@ into a single @ResourceT@.@@ -414,57 +226,8 @@               -> ResourceT m a joinResourceT (ResourceT f) = ResourceT $ \r -> unResourceT (f r) r --------- 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 -instance Monad m => Monad (ResourceT m) where-    return = ResourceT . const . return-    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-    newtype StT ResourceT a = StReader {unStReader :: a}-    liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r-    restoreT = ResourceT . const . liftM unStReader-    {-# INLINE liftWith #-}-    {-# INLINE restoreT #-}--instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where-     newtype StM (ResourceT m) a = StMT (StM m a)-     liftBaseWith f = ResourceT $ \reader ->-         liftBaseWith $ \runInBase ->-             f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader)-     restoreM (StMT base) = ResourceT $ const $ restoreM base-instance Monad m => MonadThrow (ExceptionT m) where-    monadThrow = ExceptionT . return . Left . E.toException-instance MonadResource m => MonadResource (ExceptionT m) where-    liftResourceT = lift . liftResourceT-instance MonadIO m => MonadIO (ExceptionT m) where-    liftIO = lift . liftIO---- | 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) }- -- | Same as 'runExceptionT', but immediately 'E.throw' any exception returned. -- -- Since 0.3.0@@ -483,108 +246,6 @@ runException_ :: ExceptionT Identity a -> a runException_ = runIdentity . runExceptionT_ -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)---- | 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- -- | 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.@@ -612,24 +273,7 @@             (stateCleanup r)             (restore $ f r)) --- | 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  -- | 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

@@ -0,0 +1,420 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Control.Monad.Trans.Resource.Internal(+    ExceptionT(..)+  , InvalidAccess(..)+  , MonadResource(..)+  , MonadThrow(..)+  , MonadUnsafeIO(..)+  , ReleaseKey(..)+  , ReleaseMap(..)\+  , ResIO+  , ResourceT(..)+  , stateAlloc+  , stateCleanup+  , transResourceT+) where++import Control.Exception (throw,Exception,SomeException)+import Control.Applicative (Applicative (..))+import Control.Monad.Trans.Control+    ( MonadTransControl (..), MonadBaseControl (..)+    , ComposeSt, defaultLiftBaseWith, defaultRestoreM)+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.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 (liftM)+import qualified Control.Exception as E+import Control.Monad.ST (ST)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import qualified Data.IORef as I+import Data.Monoid+import Data.Typeable+import Data.Word(Word)++#if __GLASGOW_HASKELL__ >= 704+import Control.Monad.ST.Unsafe (unsafeIOToST)+#else+import Control.Monad.ST (unsafeIOToST)+#endif++#if __GLASGOW_HASKELL__ >= 704+import qualified Control.Monad.ST.Lazy.Unsafe as LazyUnsafe+#else+import qualified Control.Monad.ST.Lazy as LazyUnsafe+#endif++import qualified Control.Monad.ST.Lazy as Lazy++import Control.Monad.Morph++-- | 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, MonadUnsafeIO m, MonadIO m, Applicative 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 (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++-- | 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+    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++instance Monad m => Monad (ResourceT m) where+    return = ResourceT . const . return+    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+    newtype StT ResourceT a = StReader {unStReader :: a}+    liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r+    restoreT = ResourceT . const . liftM unStReader+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where+     newtype StM (ResourceT m) a = StMT (StM m a)+     liftBaseWith f = ResourceT $ \reader' ->+         liftBaseWith $ \runInBase ->+             f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader'  )+     restoreM (StMT base) = ResourceT $ const $ restoreM base+instance Monad m => MonadThrow (ExceptionT m) where+    monadThrow = ExceptionT . return . Left . E.toException+instance MonadResource m => MonadResource (ExceptionT m) where+    liftResourceT = lift . liftResourceT+instance MonadIO m => MonadIO (ExceptionT m) where+    liftIO = lift . liftIO++#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)+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+++-- | 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 ->+        case rm of+            ReleaseMap nk rf m ->+                (ReleaseMap nk (rf + 1) m, ())+            ReleaseMapClosed -> throw $ InvalidAccess "stateAlloc"++stateCleanup :: I.IORef ReleaseMap -> IO ()+stateCleanup 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 >> return ()) $ IntMap.elems m+        Nothing -> return ()+  where+    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)

@@ -1,5 +1,5 @@ Name:                resourcet-Version:             0.4.7.2+Version:             0.4.8 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>.@@ -14,6 +14,7 @@  Library   Exposed-modules:     Control.Monad.Trans.Resource+                       Control.Monad.Trans.Resource.Internal   Build-depends:       base                     >= 4.3          && < 5                      , lifted-base              >= 0.1                      , transformers-base        >= 0.4.1        && < 0.5