[commit: packages/base] ghc-7.8: Add `withMVarMasked` (re #8818) (a91d682)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/base

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/a91d68221ca30a3564b4e611c81a4e471a3a86c1/base

>---------------------------------------------------------------

commit a91d68221ca30a3564b4e611c81a4e471a3a86c1
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Tue Feb 25 11:04:46 2014 +0100

    Add `withMVarMasked` (re #8818)
    
    Like `withMVar`, but the @IO@ action in the second argument is executed
    with asynchronous exceptions masked. This completes the `MVar` API,
    which already contained `modifyMVarMasked` and `modifyMVarMasked_`.
    
    Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>
    (cherry picked from commit 2d5471cd3ee42406042a030424a1a83308a170fa)


>---------------------------------------------------------------

a91d68221ca30a3564b4e611c81a4e471a3a86c1
 Control/Concurrent/MVar.hs |   16 ++++++++++++++++
 changelog.md               |    4 ++++
 2 files changed, 20 insertions(+)

diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
index aaf1939..72a44d3 100644
--- a/Control/Concurrent/MVar.hs
+++ b/Control/Concurrent/MVar.hs
@@ -139,6 +139,7 @@ module Control.Concurrent.MVar
         , tryPutMVar
         , isEmptyMVar
         , withMVar
+        , withMVarMasked
         , modifyMVar_
         , modifyMVar
         , modifyMVarMasked_
@@ -189,6 +190,21 @@ withMVar m io =
     return b
 
 {-|
+  Like 'withMVar', but the @IO@ action in the second argument is executed
+  with asynchronous exceptions masked.
+
+  /Since: 4.7.0.0/
+-}
+{-# INLINE withMVarMasked #-}
+withMVarMasked :: MVar a -> (a -> IO b) -> IO b
+withMVarMasked m io =
+  mask_ $ do
+    a <- takeMVar m
+    b <- io a `onException` putMVar m a
+    putMVar m a
+    return b
+
+{-|
   An exception-safe wrapper for modifying the contents of an 'MVar'.
   Like 'withMVar', 'modifyMVar' will replace the original contents of
   the 'MVar' if an exception is raised during the operation.  This
diff --git a/changelog.md b/changelog.md
index ef9fa08..88ceec5 100644
--- a/changelog.md
+++ b/changelog.md
@@ -51,6 +51,10 @@
     `putMVar`.  There is also a new `tryReadMVar` which is a
     non-blocking version.
 
+  * New `Control.Concurrent.MVar.withMVarMasked` which executes
+    `IO` action with asynchronous exceptions masked in the same style
+    as the existing `modifyMVarMasked` and `modifyMVarMasked_`.
+
   * New `threadWait{Read,Write}STM :: Fd -> IO (STM (), IO ())`
     functions added to `Control.Concurrent` for waiting on FD
     readiness with STM actions.