Hello community,
here is the log from the commit of package ghc-resourcet for openSUSE:Factory
checked in at 2018-05-30 12:12:26
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-resourcet (Old)
and /work/SRC/openSUSE:Factory/.ghc-resourcet.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-resourcet"
Wed May 30 12:12:26 2018 rev:18 rq:607873 version:1.2.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-resourcet/ghc-resourcet.changes
2017-09-15 22:09:54.300397853 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-resourcet.new/ghc-resourcet.changes
2018-05-30 12:27:02.670821888 +0200
@@ -1,0 +2,14 @@
+Mon May 14 17:02:11 UTC 2018 - psim...@suse.com
+
+- Update resourcet to version 1.2.1.
+ * Support `exceptions-0.10`.
+ * Drop `monad-control` and `mmorph` dependencies
+ * Change behavior of `runResourceT` to match `runResourceTChecked`
+ * `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`.
+ * Added `MonadUnliftIO` instances and `UnliftIO.Resource`
+
+-------------------------------------------------------------------
Old:
----
resourcet-1.1.9.tar.gz
New:
----
resourcet-1.2.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-resourcet.spec ++++++
--- /var/tmp/diff_new_pack.NX2n9g/_old 2018-05-30 12:27:03.330799139 +0200
+++ /var/tmp/diff_new_pack.NX2n9g/_new 2018-05-30 12:27:03.334799001 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-resourcet
#
-# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name resourcet
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.1.9
+Version: 1.2.1
Release: 0
Summary: Deterministic allocation and freeing of scarce resources
License: BSD-3-Clause
@@ -29,14 +29,11 @@
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-containers-devel
BuildRequires: ghc-exceptions-devel
-BuildRequires: ghc-lifted-base-devel
-BuildRequires: ghc-mmorph-devel
-BuildRequires: ghc-monad-control-devel
BuildRequires: ghc-mtl-devel
+BuildRequires: ghc-primitive-devel
BuildRequires: ghc-rpm-macros
-BuildRequires: ghc-transformers-base-devel
-BuildRequires: ghc-transformers-compat-devel
BuildRequires: ghc-transformers-devel
+BuildRequires: ghc-unliftio-core-devel
%if %{with tests}
BuildRequires: ghc-hspec-devel
%endif
@@ -75,7 +72,7 @@
%ghc_pkg_recache
%files -f %{name}.files
-%doc LICENSE
+%license LICENSE
%files devel -f %{name}-devel.files
%doc ChangeLog.md README.md
++++++ resourcet-1.1.9.tar.gz -> resourcet-1.2.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/ChangeLog.md
new/resourcet-1.2.1/ChangeLog.md
--- old/resourcet-1.1.9/ChangeLog.md 2016-12-20 11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/ChangeLog.md 2018-04-10 09:32:39.000000000 +0200
@@ -1,3 +1,24 @@
+## 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/resourcet-1.1.9/Control/Monad/Trans/Resource/Internal.hs
new/resourcet-1.2.1/Control/Monad/Trans/Resource/Internal.hs
--- old/resourcet-1.1.9/Control/Monad/Trans/Resource/Internal.hs
2016-12-20 11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/Control/Monad/Trans/Resource/Internal.hs
2018-04-10 09:34:26.000000000 +0200
@@ -7,13 +7,6 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
--- Can only mark as Safe when using a newer GHC, otherwise we get build
--- failures due to the manual Typeable instance below.
-#if __GLASGOW_HASKELL__ >= 707
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
module Control.Monad.Trans.Resource.Internal(
InvalidAccess(..)
@@ -27,15 +20,16 @@
, transResourceT
, register'
, registerType
+ , ResourceCleanupException (..)
+ , stateCleanupChecked
) where
import Control.Exception (throw,Exception,SomeException)
import Control.Applicative (Applicative (..), Alternative(..))
import Control.Monad (MonadPlus(..))
import Control.Monad.Fix (MonadFix(..))
-import Control.Monad.Trans.Control
- ( MonadTransControl (..), MonadBaseControl (..) )
-import Control.Monad.Base (MonadBase, liftBase)
+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 (..) )
@@ -47,7 +41,6 @@
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 )
@@ -59,38 +52,30 @@
import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
import Control.Monad.IO.Class (MonadIO (..))
-#if !(MIN_VERSION_monad_control(1,0,0))
-import Control.Monad (liftM)
-#endif
+import Control.Monad.Primitive (PrimMonad (..))
import qualified Control.Exception as E
-import Control.Monad.Catch (MonadThrow (..), MonadCatch (..)
-#if MIN_VERSION_exceptions(0,6,0)
- , MonadMask (..)
-#endif
- )
+
+-- FIXME Do we want to only support MonadThrow?
+import Control.Monad.Catch (MonadThrow (..), MonadCatch (..), MonadMask (..))
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.IORef as I
-import Data.Monoid
import Data.Typeable
import Data.Word(Word)
-import Prelude hiding (catch)
import Data.Acquire.Internal (ReleaseType (..))
-import Control.Monad.Morph
-
-- | A @Monad@ which allows for safe resource allocation. In theory, any monad
-- transformer stack which includes a @ResourceT@ can be an instance of
-- @MonadResource@.
--
--- Note: @runResourceT@ has a requirement for a @MonadBaseControl IO m@ monad,
+-- Note: @runResourceT@ has a requirement for a @MonadUnliftIO m@ monad,
-- which allows control operations to be lifted. A @MonadResource@ does not
-- have this requirement. This means that transformers such as @ContT@ can be
-- an instance of @MonadResource@. However, the @ContT@ wrapper will need to be
-- unwrapped before calling @runResourceT@.
--
-- Since 0.3.0
-class (MonadThrow m, MonadIO m, Applicative m, MonadBase IO m) =>
MonadResource m where
+class MonadIO m => MonadResource m where
-- | Lift a @ResourceT IO@ action into the current @Monad@.
--
-- Since 0.4.0
@@ -112,7 +97,7 @@
| ReleaseMapClosed
-- | Convenient alias for @ResourceT IO@.
-type ResIO a = ResourceT IO a
+type ResIO = ResourceT IO
instance MonadCont m => MonadCont (ResourceT m) where
@@ -145,16 +130,29 @@
instance MonadCatch m => MonadCatch (ResourceT m) where
catch (ResourceT m) c =
ResourceT $ \r -> m r `catch` \e -> unResourceT (c e) r
-#if MIN_VERSION_exceptions(0,6,0)
instance MonadMask m => MonadMask (ResourceT m) where
-#endif
mask a = ResourceT $ \e -> mask $ \u -> unResourceT (a $ q u) e
where q u (ResourceT b) = ResourceT (u . b)
uninterruptibleMask a =
ResourceT $ \e -> uninterruptibleMask $ \u -> unResourceT (a $ q u) e
where q u (ResourceT b) = ResourceT (u . b)
-instance (MonadThrow m, MonadBase IO m, MonadIO m, Applicative m) =>
MonadResource (ResourceT m) where
+#if MIN_VERSION_exceptions(0, 10, 0)
+ generalBracket acquire release use =
+ ResourceT $ \r ->
+ generalBracket
+ ( unResourceT acquire r )
+ ( \resource exitCase ->
+ unResourceT ( release resource exitCase ) r
+ )
+ ( \resource -> unResourceT ( use resource ) r )
+#elif MIN_VERSION_exceptions(0, 9, 0)
+#error exceptions 0.9.0 is not supported
+#endif
+instance MonadIO m => MonadResource (ResourceT m) where
liftResourceT = transResourceT liftIO
+instance PrimMonad m => PrimMonad (ResourceT m) where
+ type PrimState (ResourceT m) = PrimState m
+ primitive = lift . primitive
-- | Transform the monad a @ResourceT@ lives in. This is most often used to
-- strip or add new transformers to a stack, e.g. to run a @ReaderT@.
@@ -167,13 +165,6 @@
-> ResourceT n b
transResourceT f (ResourceT mx) = ResourceT (\r -> f (mx r))
--- | Since 0.4.7
-instance MFunctor ResourceT where
- hoist f (ResourceT mx) = ResourceT (\r -> f (mx r))
--- | Since 0.4.7
-instance MMonad ResourceT where
- embed f m = ResourceT (\i -> unResourceT (f (unResourceT m i)) i)
-
-- | The Resource transformer. This transformer keeps track of all registered
-- actions, and calls them upon exit (via 'runResourceT'). Actions may be
-- registered via 'register', or resources may be allocated atomically via
@@ -240,9 +231,7 @@
(ResourceT mf) `mplus` (ResourceT ma) = ResourceT $ \r -> mf r `mplus` ma r
instance Monad m => Monad (ResourceT m) where
-#if !MIN_VERSION_base(4,8,0)
- return = ResourceT . const . return
-#endif
+ return = pure
ResourceT ma >>= f = ResourceT $ \r -> do
a <- ma r
let ResourceT f' = f a
@@ -258,46 +247,18 @@
instance MonadIO m => MonadIO (ResourceT m) where
liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (ResourceT m) where
- liftBase = lift . liftBase
-
-instance MonadTransControl ResourceT where
-#if MIN_VERSION_monad_control(1,0,0)
- type StT ResourceT a = a
- liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> t r
- restoreT = ResourceT . const
-#else
- newtype StT ResourceT a = StReader {unStReader :: a}
- liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r
- restoreT = ResourceT . const . liftM unStReader
-#endif
- {-# INLINE liftWith #-}
- {-# INLINE restoreT #-}
-
-instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where
-#if MIN_VERSION_monad_control(1,0,0)
- type StM (ResourceT m) a = StM m a
- liftBaseWith f = ResourceT $ \reader' ->
- liftBaseWith $ \runInBase ->
- f $ runInBase . (\(ResourceT r) -> r reader' )
- restoreM = ResourceT . const . restoreM
-#else
- newtype StM (ResourceT m) a = StMT (StM m a)
- liftBaseWith f = ResourceT $ \reader' ->
- liftBaseWith $ \runInBase ->
- f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader' )
- restoreM (StMT base) = ResourceT $ const $ restoreM base
-#endif
+-- | @since 1.1.10
+instance MonadUnliftIO m => MonadUnliftIO (ResourceT m) where
+ askUnliftIO = ResourceT $ \r ->
+ withUnliftIO $ \u ->
+ return (UnliftIO (unliftIO u . flip unResourceT r))
#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)
@@ -359,3 +320,69 @@
, 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/Control/Monad/Trans/Resource.hs
new/resourcet-1.2.1/Control/Monad/Trans/Resource.hs
--- old/resourcet-1.1.9/Control/Monad/Trans/Resource.hs 2016-12-20
11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/Control/Monad/Trans/Resource.hs 2018-03-14
07:08:08.000000000 +0100
@@ -6,10 +6,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
-#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE ConstraintKinds #-}
-#endif
-{-# LANGUAGE Safe #-}
-- | Allocate resources which are guaranteed to be released.
--
-- For more information, see
<https://www.fpcomplete.com/user/snoyberg/library-documentation/resourcet>.
@@ -24,6 +21,9 @@
, ReleaseKey
-- * Unwrap
, runResourceT
+ -- ** Check cleanup exceptions
+ , runResourceTChecked
+ , ResourceCleanupException (..)
-- * Special actions
, resourceForkWith
, resourceForkIO
@@ -42,7 +42,7 @@
-- ** Low-level
, InvalidAccess (..)
-- * Re-exports
- , MonadBaseControl
+ , MonadUnliftIO
-- * Internal state
-- $internalState
, InternalState
@@ -51,36 +51,20 @@
, withInternalState
, createInternalState
, closeInternalState
- -- * Backwards compatibility
- , ExceptionT (..)
- , runExceptionT
- , runExceptionT_
- , runException
- , runException_
+ -- * Reexport
, MonadThrow (..)
- , monadThrow
) where
import qualified Data.IntMap as IntMap
-import Control.Exception (SomeException, throw)
-import Control.Monad.Trans.Control
- ( MonadBaseControl (..), liftBaseDiscard, control )
import qualified Data.IORef as I
-import Control.Monad.Base (MonadBase, liftBase)
-import Control.Applicative (Applicative (..))
-import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad (liftM)
+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)
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 (..))
@@ -100,7 +84,7 @@
release (ReleaseKey istate rk) = liftIO $ release' istate rk
(maybe (return ()) id)
--- | Unprotect resource from cleanup actions, this allowes you to send
+-- | Unprotect resource from cleanup actions; this allows you to send
-- resource into another resourcet process and reregister it there.
-- It returns an release action that should be run in order to clean
-- resource or Nothing in case if resource is already freed.
@@ -180,33 +164,41 @@
-- 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
+-- /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.onException`
- stateCleanup ReleaseException istate
- stateCleanup ReleaseNormal istate
+ res <- restore (run (r istate)) `E.catch` \e -> do
+ stateCleanupChecked (Just e) istate
+ E.throwIO e
+ stateCleanupChecked Nothing istate
return res
-bracket_ :: MonadBaseControl IO m
+-- | Backwards compatible alias for 'runResourceT'.
+--
+-- @since 1.1.11
+runResourceTChecked :: MonadUnliftIO m => ResourceT m a -> m a
+runResourceTChecked = runResourceT
+{-# INLINE runResourceTChecked #-}
+
+bracket_ :: MonadUnliftIO m
=> IO () -- ^ allocate
-> IO () -- ^ normal cleanup
-> IO () -- ^ exceptional cleanup
-> m a
-> m a
bracket_ alloc cleanupNormal cleanupExc inside =
- control $ \run -> E.mask $ \restore -> do
+ withRunInIO $ \run -> E.mask $ \restore -> do
alloc
res <- restore (run inside) `E.onException` cleanupExc
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@.
--
@@ -215,31 +207,6 @@
-> ResourceT m a
joinResourceT (ResourceT f) = ResourceT $ \r -> unResourceT (f r) r
--- | For backwards compatibility.
-type ExceptionT = CatchT
-
--- | For backwards compatibility.
-runExceptionT :: ExceptionT m a -> m (Either SomeException a)
-runExceptionT = runCatchT
-
--- | Same as 'runExceptionT', but immediately 'E.throw' any exception returned.
---
--- Since 0.3.0
-runExceptionT_ :: Monad m => ExceptionT m a -> m a
-runExceptionT_ = liftM (either E.throw id) . runExceptionT
-
--- | Run an @ExceptionT Identity@ stack.
---
--- Since 0.4.2
-runException :: ExceptionT Identity a -> Either SomeException a
-runException = runIdentity . runExceptionT
-
--- | Run an @ExceptionT Identity@ stack, but immediately 'E.throw' any
exception returned.
---
--- Since 0.4.2
-runException_ :: ExceptionT Identity a -> a
-runException_ = runIdentity . runExceptionT_
-
-- | Introduce a reference-counting scheme to allow a resource context to be
-- shared by multiple threads. Once the last thread exits, all remaining
-- resources will be released.
@@ -256,8 +223,13 @@
-- a new @ResourceT@ block and then call @resourceForkWith@ from there.
--
-- @since 1.1.9
-resourceForkWith :: MonadBaseControl IO m => (IO () -> IO a) -> ResourceT m ()
-> ResourceT m a
-resourceForkWith g (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->
+resourceForkWith
+ :: MonadUnliftIO m
+ => (IO () -> IO a)
+ -> ResourceT m ()
+ -> ResourceT m a
+resourceForkWith g (ResourceT f) =
+ ResourceT $ \r -> withRunInIO $ \run -> E.mask $ \restore ->
-- We need to make sure the counter is incremented before this call
-- returns. Otherwise, the parent thread may call runResourceT before
-- the child thread increments, and all resources will be freed
@@ -266,46 +238,35 @@
(stateAlloc r)
(return ())
(return ())
- (liftBaseDiscard g $ bracket_
+ (g $ bracket_
(return ())
(stateCleanup ReleaseNormal r)
(stateCleanup ReleaseException r)
- (restore $ f r))
+ (restore $ run $ f r))
-- | Launch a new reference counted resource context using @forkIO@.
--
-- This is defined as @resourceForkWith forkIO@.
--
-- @since 0.3.0
-resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m
ThreadId
+resourceForkIO :: MonadUnliftIO m => ResourceT m () -> ResourceT m ThreadId
resourceForkIO = resourceForkWith forkIO
--- | A @Monad@ which can be used as a base for a @ResourceT@.
+-- | Just use 'MonadUnliftIO' directly now, legacy explanation continues:
--
--- 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@.
+-- A @Monad@ which can be used as a base for a @ResourceT@.
--
--- While any instance of @MonadBaseControl IO@ should be an instance of the
--- other classes, this is not guaranteed by the type system (e.g., you may have
--- a transformer in your stack with does not implement @MonadThrow@). Ideally,
--- we would like to simply create an alias for the five type classes listed,
--- but this is not possible with GHC currently.
+-- A @ResourceT@ has some restrictions on its base monad:
--
--- Instead, this typeclass acts as a proxy for the other five. Its only purpose
--- is to make your type signatures shorter.
+-- * @runResourceT@ requires an instance of @MonadUnliftIO@.
+-- * @MonadResource@ requires an instance of @MonadIO@
--
-- Note that earlier versions of @conduit@ had a typeclass @ResourceIO@. This
-- fulfills much the same role.
--
-- Since 0.3.2
-#if __GLASGOW_HASKELL__ >= 704
-type MonadResourceBase m = (MonadBaseControl IO m, MonadThrow m, MonadBase IO
m, MonadIO m, Applicative m)
-#else
-class (MonadBaseControl IO m, MonadThrow m, MonadIO m, Applicative m) =>
MonadResourceBase m
-instance (MonadBaseControl IO m, MonadThrow m, MonadIO m, Applicative m) =>
MonadResourceBase m
-#endif
+type MonadResourceBase = MonadUnliftIO
+{-# DEPRECATED MonadResourceBase "Use MonadUnliftIO directly instead" #-}
-- $internalState
--
@@ -321,16 +282,16 @@
-- Caveat emptor!
--
-- Since 0.4.9
-createInternalState :: MonadBase IO m => m InternalState
-createInternalState = liftBase
+createInternalState :: MonadIO m => m InternalState
+createInternalState = liftIO
$ I.newIORef
$ ReleaseMap maxBound (minBound + 1) IntMap.empty
-- | Close an internal state created by @createInternalState@.
--
-- Since 0.4.9
-closeInternalState :: MonadBase IO m => InternalState -> m ()
-closeInternalState = liftBase . stateCleanup ReleaseNormal
+closeInternalState :: MonadIO m => InternalState -> m ()
+closeInternalState = liftIO . stateCleanup ReleaseNormal
-- | Get the internal state of the current @ResourceT@.
--
@@ -354,7 +315,3 @@
-- Since 0.4.6
withInternalState :: (InternalState -> m a) -> ResourceT m a
withInternalState = ResourceT
-
--- | Backwards compatibility
-monadThrow :: (E.Exception e, MonadThrow m) => e -> m a
-monadThrow = throwM
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/Data/Acquire/Internal.hs
new/resourcet-1.2.1/Data/Acquire/Internal.hs
--- old/resourcet-1.1.9/Data/Acquire/Internal.hs 2016-12-20
11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/Data/Acquire/Internal.hs 2018-03-14
07:08:08.000000000 +0100
@@ -4,30 +4,25 @@
{-# 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 Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)
+import qualified Control.Exception as E
import Data.Typeable (Typeable)
import Control.Monad (liftM, ap)
-import qualified Control.Monad.Catch as C
-import GHC.IO (unsafeUnmask)
+import qualified Control.Monad.Catch as C ()
-- | The way in which a release is called.
--
--- Since 1.1.2
+-- @since 1.1.2
data ReleaseType = ReleaseEarly
| ReleaseNormal
| ReleaseException
@@ -37,7 +32,7 @@
-- | A method for acquiring a scarce resource, providing the means of freeing
-- it when no longer needed. This data type provides
--- @Functor@/@Applicative@/@Monad@ instances for composing different resources
+-- @Functor@\/@Applicative@\/@Monad@ instances for composing different
resources
-- together. You can allocate these resources using either the @bracket@
-- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@).
--
@@ -46,7 +41,7 @@
-- implementation in this package is slightly different, due to taking a
-- different approach to async exception safety.
--
--- Since 1.1.0
+-- @since 1.1.0
newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a))
deriving Typeable
@@ -69,12 +64,9 @@
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
+-- @since 1.1.0
mkAcquire :: IO a -- ^ acquire the resource
-> (a -> IO ()) -- ^ free the resource
-> Acquire a
@@ -86,7 +78,7 @@
-- cleanup was initiated. This allows you to distinguish, for example, between
-- normal and exceptional exits.
--
--- Since 1.1.2
+-- @since 1.1.2
mkAcquireType
:: IO a -- ^ acquire the resource
-> (a -> ReleaseType -> IO ()) -- ^ free the resource
@@ -100,40 +92,13 @@
-- normally or via an exception. This function is similar in function to
-- @bracket@.
--
--- Since 1.1.0
-with :: MonadBaseControl IO m
+-- @since 1.1.0
+with :: MonadUnliftIO m
=> Acquire a
-> (a -> m b)
-> m b
-with (Acquire f) g = control $ \run -> E.mask $ \restore -> do
+with (Acquire f) g = withRunInIO $ \run -> E.mask $ \restore -> do
Allocated x free <- f restore
res <- restore (run (g x)) `E.onException` free ReleaseException
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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/Data/Acquire.hs
new/resourcet-1.2.1/Data/Acquire.hs
--- old/resourcet-1.1.9/Data/Acquire.hs 2016-12-20 11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/Data/Acquire.hs 2018-03-14 07:08:08.000000000 +0100
@@ -1,11 +1,66 @@
{-# 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
+-- * 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
- , withEx
+ , withAcquire
, mkAcquire
, mkAcquireType
, allocateAcquire
@@ -13,20 +68,14 @@
) where
import Control.Monad.Trans.Resource.Internal
-import Control.Monad.Trans.Resource
import Data.Acquire.Internal
-import Control.Applicative (Applicative (..))
-import Control.Monad.Base (MonadBase (..))
-import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.Trans.Control (MonadBaseControl, control)
-import qualified Control.Exception.Lifted as E
-import Data.Typeable (Typeable)
-import Control.Monad (liftM, ap)
+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO)
+import qualified Control.Exception as E
-- | Allocate a resource and register an action with the @MonadResource@ to
-- free the resource.
--
--- Since 1.1.0
+-- @since 1.1.0
allocateAcquire :: MonadResource m => Acquire a -> m (ReleaseKey, a)
allocateAcquire = liftResourceT . allocateAcquireRIO
@@ -35,3 +84,10 @@
Allocated a free <- f restore
key <- registerType istate free
return (key, a)
+
+-- | Longer name for 'with', in case @with@ is not obvious enough in context.
+--
+-- @since 1.2.0
+withAcquire :: MonadUnliftIO m => Acquire a -> (a -> m b) -> m b
+withAcquire = with
+{-# INLINE withAcquire #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/README.md
new/resourcet-1.2.1/README.md
--- old/resourcet-1.1.9/README.md 2016-12-20 11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/README.md 2018-02-25 16:29:17.000000000 +0100
@@ -21,9 +21,18 @@
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
@@ -34,21 +43,43 @@
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 it printed. And by using `release`
before `somethingElse`, we guarantee that the resource is freed *before*
running the potentially long process.
+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
@@ -57,9 +88,12 @@
(\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!"
```
@@ -76,17 +110,33 @@
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
-
+ (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)
+ (putStrLn "Allocating" >> return 5)
+ (\i -> putStrLn $ "Freeing: " ++ show i)
+ (\i -> putStrLn $ "Using: " ++ show i)
```
Now let's analyze why the second statement is true.
@@ -122,64 +172,87 @@
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 Data.Conduit (addCleanup, runResourceT, ($$), (=$))
+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
+-- 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"
--- Monad instance of Source allows us to simply mapM_ to create a single Source
+-- 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)
+ 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 = runResourceT $ source $$ gzip =$ sink
+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
-
-fillRandom fp = runResourceT
- $ sourceFile "/dev/urandom"
- $$ isolate (50 * 1024)
- =$ sinkFile fp
-
-
--- Modified sourceFile and sinkFile that print when they are opening and
--- closing file handles, to demonstrate interleaved allocation.
-sourceFileTrace fp = do
- liftIO $ putStrLn $ "Opening: " ++ fp
- addCleanup (const $ liftIO $ putStrLn $ "Closing: " ++ fp) (sourceFile fp)
-
-sinkFileTrace fp = do
- liftIO $ putStrLn $ "Opening: " ++ fp
- addCleanup (const $ liftIO $ putStrLn $ "Closing: " ++ fp) (sinkFile fp)
```
## resourcet is not conduit
@@ -191,28 +264,51 @@
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 src dst = runResourceT $ sourceFile src $$ sinkFile dst
+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
+ 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"
@@ -223,4 +319,4 @@
## Conclusion
-ResourceT provides you with a flexible means of allocating resources in an
exception safe manner. Its main advantage over the simpler bracket pattern is
that it allows interleaving of allocations, allowing for more complicated
programs to be created efficiently. If your needs are simple, stick with
bracket. If you have need of something more complex, resourcet may be your
answer.
+ResourceT provides you with a flexible means of allocating resources in an
exception safe manner. Its main advantage over the simpler bracket pattern is
that it allows interleaving of allocations, allowing for more complicated
programs to be created efficiently. If your needs are simple, stick with
bracket. If you have need of something more complex, resourcet may be your
answer. For understanding how it works under the hook, refer
[here](https://www.fpcomplete.com/blog/2017/06/understanding-resourcet).
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/UnliftIO/Resource.hs
new/resourcet-1.2.1/UnliftIO/Resource.hs
--- old/resourcet-1.1.9/UnliftIO/Resource.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/resourcet-1.2.1/UnliftIO/Resource.hs 2018-02-25 16:29:17.000000000
+0100
@@ -0,0 +1,27 @@
+-- | Unlifted "Control.Monad.Trans.Resource".
+--
+-- @since 1.1.10
+module UnliftIO.Resource
+ ( -- * UnliftIO variants
+ runResourceT
+ , liftResourceT
+ -- * 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/resourcet.cabal
new/resourcet-1.2.1/resourcet.cabal
--- old/resourcet-1.1.9/resourcet.cabal 2016-12-20 11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/resourcet.cabal 2018-04-10 09:35:50.000000000 +0200
@@ -1,5 +1,5 @@
Name: resourcet
-Version: 1.1.9
+Version: 1.2.1
Synopsis: Deterministic allocation and freeing of scarce resources.
description: Hackage documentation generation is not reliable. For up
to date documentation, please see: <http://www.stackage.org/package/resourcet>.
License: BSD3
@@ -17,16 +17,14 @@
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
+ UnliftIO.Resource
+ Build-depends: base >= 4.9 && < 5
, containers
- , transformers >= 0.2.2
- , transformers-compat >= 0.3 && < 0.6
+ , transformers >= 0.4
, mtl >= 2.0 && < 2.3
- , mmorph
- , exceptions >= 0.5
+ , exceptions (== 0.8.* || == 0.10.*)
+ , unliftio-core
+ , primitive
ghc-options: -Wall
test-suite test
@@ -36,8 +34,8 @@
cpp-options: -DTEST
build-depends: resourcet
, base
+ , exceptions
, hspec >= 1.3
- , lifted-base
, transformers
ghc-options: -Wall
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/resourcet-1.1.9/test/main.hs
new/resourcet-1.2.1/test/main.hs
--- old/resourcet-1.1.9/test/main.hs 2016-12-20 11:01:09.000000000 +0100
+++ new/resourcet-1.2.1/test/main.hs 2018-04-10 09:31:48.000000000 +0200
@@ -2,11 +2,11 @@
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Concurrent
-import Control.Concurrent.Lifted (fork)
import Control.Exception (Exception, MaskingState
(MaskedInterruptible),
- getMaskingState, throwIO, try)
+ getMaskingState, throwIO, try,
fromException)
import Control.Exception (SomeException, handle)
-import Control.Monad (unless)
+import Control.Monad (unless, void)
+import qualified Control.Monad.Catch
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource
import Data.IORef
@@ -18,7 +18,7 @@
main = hspec $ do
describe "general" $ do
it "survives releasing bottom" $ do
- x <- newIORef 0
+ x <- newIORef (0 :: Int)
handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do
_ <- register $ writeIORef x 1
release undefined
@@ -26,7 +26,7 @@
x' `shouldBe` 1
describe "early release" $ do
it "works from a different context" $ do
- x <- newIORef 0
+ x <- newIORef (0 :: Int)
runResourceT $ do
key <- register $ writeIORef x 1
runResourceT $ release key
@@ -35,11 +35,11 @@
describe "resourceForkIO" $ do
it "waits for all threads" $ do
x <- newEmptyMVar
- y <- newIORef 0
+ y <- newIORef (0 :: Int)
z <- newEmptyMVar
w <- newEmptyMVar
- runResourceT $ do
+ _ <- runResourceT $ do
_ <- register $ do
writeIORef y 1
putMVar w ()
@@ -62,8 +62,8 @@
Just y2 `shouldBe` Just 1
describe "unprotecting" $ do
it "unprotect keeps resource from being cleared" $ do
- x <- newIORef 0
- runResourceT $ do
+ x <- newIORef (0 :: Int)
+ _ <- runResourceT $ do
key <- register $ writeIORef x 1
unprotect key
y <- readIORef x
@@ -73,11 +73,11 @@
ms <- getMaskingState
unless (ms == MaskedInterruptible) $
error $ show (name, ms)
- runResourceT $ do
+ _ <- runResourceT $ do
register (checkMasked "release") >>= release
register (checkMasked "normal")
Left Dummy <- try $ runResourceT $ do
- register (checkMasked "exception")
+ _ <- register (checkMasked "exception")
liftIO $ throwIO Dummy
return ()
describe "mkAcquireType" $ do
@@ -114,18 +114,38 @@
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)
+ 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
