import qualified Control.Concurrent.MVar as IO
import Control.Monad.IO.Control (MonadControlIO, controlIO)
import Control.Exception.Control (mask, onException)
import Control.Monad.IO.Class (liftIO)

modifyMVar :: MonadControlIO m => IO.MVar a -> (a -> m (a, b)) -> m b
modifyMVar m io =
  mask $ \restore -> do
    a      <- liftIO $ IO.takeMVar m
    (a',b) <- restore (io a) `onException` liftIO (IO.putMVar m a)
    liftIO $ IO.putMVar m a'
    return b

addMVarFinalizer :: MonadControlIO m => IO.MVar a -> m () -> m ()
addMVarFinalizer m io = controlIO $ \inIO ->
    return $ liftIO $ IO.addMVarFinalizer m (inIO io >> return ())