mongodb/Control/Monad/MVar.hs

66 lines
1.9 KiB
Haskell
Raw Normal View History

{- | Lift MVar operations so you can do them within monads stacked on top of IO. Analogous to MonadIO -}
{-# LANGUAGE TupleSections #-}
module Control.Monad.MVar (
MVar,
module Control.Monad.MVar,
2011-08-25 13:29:39 +00:00
liftIO,
MonadControlIO
) where
import Control.Concurrent.MVar (MVar)
import qualified Control.Concurrent.MVar as IO
2011-08-25 13:29:39 +00:00
import Control.Monad.Error (MonadIO (liftIO))
import Control.Monad.IO.Control (MonadControlIO, controlIO)
import Control.Exception.Control (mask, onException)
newEmptyMVar :: (MonadIO m) => m (MVar a)
newEmptyMVar = liftIO IO.newEmptyMVar
newMVar :: (MonadIO m) => a -> m (MVar a)
newMVar = liftIO . IO.newMVar
takeMVar :: (MonadIO m) => MVar a -> m a
takeMVar = liftIO . IO.takeMVar
putMVar :: (MonadIO m) => MVar a -> a -> m ()
putMVar var = liftIO . IO.putMVar var
readMVar :: (MonadIO m) => MVar a -> m a
readMVar = liftIO . IO.readMVar
swapMVar :: (MonadIO m) => MVar a -> a -> m a
swapMVar var = liftIO . IO.swapMVar var
tryTakeMVar :: (MonadIO m) => MVar a -> m (Maybe a)
tryTakeMVar = liftIO . IO.tryTakeMVar
tryPutMVar :: (MonadIO m) => MVar a -> a -> m Bool
tryPutMVar var = liftIO . IO.tryPutMVar var
isEmptyMVar :: (MonadIO m) => MVar a -> m Bool
isEmptyMVar = liftIO . IO.isEmptyMVar
2011-08-25 13:29:39 +00:00
modifyMVar :: MonadControlIO m => MVar a -> (a -> m (a, b)) -> m b
modifyMVar m io =
mask $ \restore -> do
a <- takeMVar m
(a',b) <- restore (io a) `onException` putMVar m a
putMVar m a'
return b
2011-08-25 13:29:39 +00:00
addMVarFinalizer :: MonadControlIO m => MVar a -> m () -> m ()
addMVarFinalizer mvar f = controlIO $ \run ->
2011-09-08 03:51:57 +00:00
return $ liftIO $ IO.addMVarFinalizer mvar (run f >> return ())
2011-08-25 13:29:39 +00:00
modifyMVar_ :: (MonadControlIO m) => MVar a -> (a -> m a) -> m ()
modifyMVar_ var act = modifyMVar var $ \a -> do
2010-10-27 20:46:11 +00:00
a' <- act a
return (a', ())
2011-08-25 13:29:39 +00:00
withMVar :: (MonadControlIO m) => MVar a -> (a -> m b) -> m b
withMVar var act = modifyMVar var $ \a -> do
b <- act a
return (a, b)