resourcet 1.1.10 → 1.1.11

raw patch · 8 files changed

+329/−49 lines, 8 filesdep ~transformers-compatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: transformers-compat

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• Control/Monad/Trans/Resource.hs +24/−1
• Control/Monad/Trans/Resource/Internal.hs +69/−1
• Data/Acquire.hs +57/−1
• Data/Acquire/Internal.hs +6/−6
• README.md +133/−37
• resourcet.cabal +1/−1
• test/main.hs +31/−2

@@ -1,3 +1,11 @@+## 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`

@@ -24,6 +24,9 @@     , ReleaseKey       -- * Unwrap     , runResourceT+      -- ** Check cleanup exceptions+    , runResourceTChecked+    , ResourceCleanupException (..)       -- * Special actions     , resourceForkWith     , resourceForkIO@@ -68,7 +71,7 @@ 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.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO) import Control.Monad (liftM) import qualified Control.Exception as E import Data.Monoid (Monoid)@@ -180,6 +183,11 @@ -- If multiple threads are sharing the same collection of resources, only the -- last call to @runResourceT@ will deallocate the resources. --+-- /NOTE/ Since version 1.1.11, this module has also provided+-- `runResourceTChecked`, which is a safer version of this+-- function. In the next major release of this library, it will become+-- the behavior of this function.+-- -- Since 0.3.0 runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a runResourceT (ResourceT r) = control $ \run -> do@@ -188,6 +196,21 @@         res <- restore (run (r istate)) `E.onException`             stateCleanup ReleaseException istate         stateCleanup ReleaseNormal istate+        return res++-- | Like 'runResourceT', but checks whether the cleanup functions+-- throw any exceptions. If they do, they are rethrown inside a+-- 'ResourceCleanupException'.+--+-- @since 1.1.11+runResourceTChecked :: MonadUnliftIO m => ResourceT m a -> m a+runResourceTChecked (ResourceT r) = withRunInIO $ \run -> do+    istate <- createInternalState+    E.mask $ \restore -> do+        res <- restore (run (r istate)) `E.catch` \e -> do+            stateCleanupChecked (Just e) istate+            E.throwIO e+        stateCleanupChecked Nothing istate         return res  bracket_ :: MonadBaseControl IO m

@@ -27,6 +27,8 @@   , transResourceT   , register'   , registerType+  , ResourceCleanupException (..)+  , stateCleanupChecked ) where  import Control.Exception (throw,Exception,SomeException)@@ -113,7 +115,7 @@   | ReleaseMapClosed  -- | Convenient alias for @ResourceT IO@.-type ResIO a = ResourceT IO a+type ResIO = ResourceT IO   instance MonadCont m => MonadCont (ResourceT m) where@@ -366,3 +368,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

@@ -2,8 +2,64 @@ {-# 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     , mkAcquire@@ -26,7 +82,7 @@ -- | 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 

@@ -27,7 +27,7 @@  -- | The way in which a release is called. ----- Since 1.1.2+-- @since 1.1.2 data ReleaseType = ReleaseEarly                  | ReleaseNormal                  | ReleaseException@@ -46,7 +46,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 @@ -74,7 +74,7 @@  -- | 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 +86,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,7 +100,7 @@ -- normally or via an exception. This function is similar in function to -- @bracket@. ----- Since 1.1.0+-- @since 1.1.0 with :: MonadBaseControl IO m      => Acquire a      -> (a -> m b)@@ -114,7 +114,7 @@ -- | Same as @with@, but uses the @MonadMask@ typeclass from exceptions instead -- of @MonadBaseControl@ from exceptions. ----- Since 1.1.3+-- @since 1.1.3 #if MIN_VERSION_exceptions(0,6,0) withEx :: (C.MonadMask m, MonadIO m) #else

@@ -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 is 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).

@@ -1,5 +1,5 @@ Name:                resourcet-Version:             1.1.10+Version:             1.1.11 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

@@ -4,9 +4,9 @@ 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           Control.Monad.IO.Class       (liftIO) import           Control.Monad.Trans.Resource import           Data.IORef@@ -125,7 +125,36 @@                 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"  data Dummy = Dummy     deriving (Show, Typeable) instance Exception Dummy++data Dummy2 = Dummy2+    deriving (Show, Typeable)+instance Exception Dummy2