module Control.Concurrent.Classy.MVar
(
MVar
, newEmptyMVar
, newEmptyMVarN
, newMVar
, newMVarN
, takeMVar
, putMVar
, readMVar
, swapMVar
, tryTakeMVar
, tryPutMVar
, isEmptyMVar
, withMVar
, withMVarMasked
, modifyMVar_
, modifyMVar
, modifyMVarMasked_
, modifyMVarMasked
) where
import Control.Monad.Catch (onException)
import Control.Monad.Conc.Class
import Data.Maybe (isJust)
swapMVar :: MonadConc m => MVar m a -> a -> m a
swapMVar :: forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m a
swapMVar MVar m a
cvar a
a = m a -> m a
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
a
old <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m a
cvar
MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
a
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
old
isEmptyMVar :: MonadConc m => MVar m a -> m Bool
isEmptyMVar :: forall (m :: * -> *) a. MonadConc m => MVar m a -> m Bool
isEmptyMVar = (Maybe a -> Bool) -> m (Maybe a) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (m (Maybe a) -> m Bool)
-> (MVar m a -> m (Maybe a)) -> MVar m a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> m (Maybe a)
forall a. MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
tryReadMVar
{-# INLINE withMVar #-}
withMVar :: MonadConc m => MVar m a -> (a -> m b) -> m b
withMVar :: forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m b) -> m b
withMVar MVar m a
cvar a -> m b
f = ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
a
val <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m a
cvar
b
out <- m b -> m b
forall a. m a -> m a
restore (a -> m b
f a
val) m b -> m () -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`onException` MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val
MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val
b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
out
{-# INLINE withMVarMasked #-}
withMVarMasked :: MonadConc m => MVar m a -> (a -> m b) -> m b
withMVarMasked :: forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m b) -> m b
withMVarMasked MVar m a
cvar a -> m b
f = m b -> m b
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
a
val <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m a
cvar
b
out <- a -> m b
f a
val m b -> m () -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`onException` MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val
MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val
b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
out
{-# INLINE modifyMVar_ #-}
modifyMVar_ :: MonadConc m => MVar m a -> (a -> m a) -> m ()
modifyMVar_ :: forall (m :: * -> *) a.
MonadConc m =>
MVar m a -> (a -> m a) -> m ()
modifyMVar_ MVar m a
cvar a -> m a
f = MVar m a -> (a -> m (a, ())) -> m ()
forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m (a, b)) -> m b
modifyMVar MVar m a
cvar ((a -> m (a, ())) -> m ()) -> (a -> m (a, ())) -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> (a, ())) -> m a -> m (a, ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a,())) (m a -> m (a, ())) -> (a -> m a) -> a -> m (a, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
f
{-# INLINE modifyMVar #-}
modifyMVar :: MonadConc m => MVar m a -> (a -> m (a, b)) -> m b
modifyMVar :: forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m (a, b)) -> m b
modifyMVar MVar m a
cvar a -> m (a, b)
f = ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
a
val <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m a
cvar
(a
val', b
out) <- m (a, b) -> m (a, b)
forall a. m a -> m a
restore (a -> m (a, b)
f a
val) m (a, b) -> m () -> m (a, b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`onException` MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val
MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val'
b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
out
{-# INLINE modifyMVarMasked_ #-}
modifyMVarMasked_ :: MonadConc m => MVar m a -> (a -> m a) -> m ()
modifyMVarMasked_ :: forall (m :: * -> *) a.
MonadConc m =>
MVar m a -> (a -> m a) -> m ()
modifyMVarMasked_ MVar m a
cvar a -> m a
f = MVar m a -> (a -> m (a, ())) -> m ()
forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m (a, b)) -> m b
modifyMVarMasked MVar m a
cvar ((a -> m (a, ())) -> m ()) -> (a -> m (a, ())) -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> (a, ())) -> m a -> m (a, ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a,())) (m a -> m (a, ())) -> (a -> m a) -> a -> m (a, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
f
{-# INLINE modifyMVarMasked #-}
modifyMVarMasked :: MonadConc m => MVar m a -> (a -> m (a, b)) -> m b
modifyMVarMasked :: forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m (a, b)) -> m b
modifyMVarMasked MVar m a
cvar a -> m (a, b)
f = m b -> m b
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
a
val <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m a
cvar
(a
val', b
out) <- a -> m (a, b)
f a
val m (a, b) -> m () -> m (a, b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`onException` MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val
MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
val'
b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
out