{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Control.Prim.Concurrent.MVar
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Control.Prim.Concurrent.MVar
  ( -- * MVar
    MVar(..)
  , isEmptyMVar
  , isSameMVar
    -- ** Create
  , newMVar
  , newLazyMVar
  , newDeepMVar
  , newEmptyMVar
    -- ** Write
  , putMVar
  , putLazyMVar
  , putDeepMVar
  , tryPutMVar
  , tryPutLazyMVar
  , tryPutDeepMVar
  , writeMVar
    -- ** Read
  , readMVar
  , tryReadMVar
  , takeMVar
  , tryTakeMVar
  , clearMVar
  -- ** Modify
  , swapMVar
  , swapLazyMVar
  , swapDeepMVar
  , withMVar
  , withMVarMasked
  , modifyMVar_
  , modifyMVarMasked_
  , modifyFetchOldMVar
  , modifyFetchOldMVarMasked
  , modifyFetchNewMVar
  , modifyFetchNewMVarMasked
  , modifyMVar
  , modifyMVarMasked
  -- ** Weak Pointer
  , mkWeakMVar
  -- ** Conversion
  , toBaseMVar
  , fromBaseMVar
  ) where

import Control.DeepSeq
import Control.Prim.Monad
import Control.Prim.Exception
import GHC.Exts
import GHC.Weak
import qualified GHC.MVar as GHC

-- | Mutable variable that can either be empty or full. Same as
-- `Control.Concurrent.MVar.MVar`, but works with any state token therefore it is also
-- usable within `ST` monad.
--
-- @since 0.3.0
data MVar a s = MVar (MVar# s a)

-- | Calls `isSameMVar`
instance Eq (MVar a s) where
  == :: MVar a s -> MVar a s -> Bool
(==) = MVar a s -> MVar a s -> Bool
forall a s. MVar a s -> MVar a s -> Bool
isSameMVar
  {-# INLINE (==) #-}


-- | Checks whether supplied `MVar`s refer to the exact same one.
--
-- @since 0.3.0
isSameMVar :: forall a s. MVar a s -> MVar a s -> Bool
isSameMVar :: MVar a s -> MVar a s -> Bool
isSameMVar (MVar MVar# s a
mvar1#) (MVar MVar# s a
mvar2#) = Int# -> Bool
isTrue# (MVar# s a -> MVar# s a -> Int#
forall d a. MVar# d a -> MVar# d a -> Int#
sameMVar# MVar# s a
mvar1# MVar# s a
mvar2#)
{-# INLINE isSameMVar #-}

-- | Checks whether supplied `MVar` is empty.
--
-- @since 0.3.0
isEmptyMVar :: forall a m s. MonadPrim s m => MVar a s -> m Bool
isEmptyMVar :: MVar a s -> m Bool
isEmptyMVar (MVar MVar# s a
mvar#) =
  (State# s -> (# State# s, Bool #)) -> m Bool
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Bool #)) -> m Bool)
-> (State# s -> (# State# s, Bool #)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MVar# s a -> State# s -> (# State# s, Int# #)
forall d a. MVar# d a -> State# d -> (# State# d, Int# #)
isEmptyMVar# MVar# s a
mvar# State# s
s of
      (# State# s
s', Int#
isEmpty# #) -> (# State# s
s', Int# -> Bool
isTrue# Int#
isEmpty# #)
{-# INLINE isEmptyMVar #-}


-- | Construct an `MVar` with initial value in it, which is evaluated to WHNF
--
-- @since 0.3.0
newMVar :: forall a m s. MonadPrim s m => a -> m (MVar a s)
newMVar :: a -> m (MVar a s)
newMVar a
a = m (MVar a s)
forall a (m :: * -> *) s. MonadPrim s m => m (MVar a s)
newEmptyMVar m (MVar a s) -> (MVar a s -> m (MVar a s)) -> m (MVar a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar a s
mvar -> MVar a s
mvar MVar a s -> m () -> m (MVar a s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putMVar MVar a s
mvar a
a
{-# INLINE newMVar #-}

-- | Construct an `MVar` with initial value in it.
--
-- Same as `Control.Concurrent.MVar.newMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
newLazyMVar :: forall a m s. MonadPrim s m => a -> m (MVar a s)
newLazyMVar :: a -> m (MVar a s)
newLazyMVar a
a = m (MVar a s)
forall a (m :: * -> *) s. MonadPrim s m => m (MVar a s)
newEmptyMVar m (MVar a s) -> (MVar a s -> m (MVar a s)) -> m (MVar a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar a s
mvar -> MVar a s
mvar MVar a s -> m () -> m (MVar a s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
a
{-# INLINE newLazyMVar #-}


-- | Construct an `MVar` with initial value in it.
--
-- @since 0.3.0
newDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => a -> m (MVar a s)
newDeepMVar :: a -> m (MVar a s)
newDeepMVar a
a = m (MVar a s)
forall a (m :: * -> *) s. MonadPrim s m => m (MVar a s)
newEmptyMVar m (MVar a s) -> (MVar a s -> m (MVar a s)) -> m (MVar a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar a s
mvar -> MVar a s
mvar MVar a s -> m () -> m (MVar a s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a s -> a -> m ()
forall a (m :: * -> *) s.
(NFData a, MonadPrim s m) =>
MVar a s -> a -> m ()
putDeepMVar MVar a s
mvar a
a
{-# INLINE newDeepMVar #-}


-- | Construct an empty `MVar`.
--
-- Same as `Control.Concurrent.MVar.newEmptyMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
newEmptyMVar :: forall a m s. MonadPrim s m => m (MVar a s)
newEmptyMVar :: m (MVar a s)
newEmptyMVar =
  (State# s -> (# State# s, MVar a s #)) -> m (MVar a s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MVar a s #)) -> m (MVar a s))
-> (State# s -> (# State# s, MVar a s #)) -> m (MVar a s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case State# s -> (# State# s, MVar# s a #)
forall d a. State# d -> (# State# d, MVar# d a #)
newMVar# State# s
s of
      (# State# s
s', MVar# s a
mvar# #) -> (# State# s
s', MVar# s a -> MVar a s
forall a s. MVar# s a -> MVar a s
MVar MVar# s a
mvar# #)
{-# INLINE newEmptyMVar #-}


-- | Write a value into an `MVar`. Blocks the current thread if `MVar` is empty and waits
-- until it gets filled by another thread. Evaluates the argument to WHNF prior to writing
-- it.
--
-- @since 0.3.0
putMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m ()
putMVar :: MVar a s -> a -> m ()
putMVar MVar a s
mvar a
x = MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar (a
x a -> MVar a s -> MVar a s
`seq` MVar a s
mvar) a
x
{-# INLINE putMVar #-}


-- | Same as `putMVar`, but allows to write a thunk into an MVar.
--
-- Same as `Control.Concurrent.MVar.putMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
putLazyMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar :: MVar a s -> a -> m ()
putLazyMVar (MVar MVar# s a
mvar#) a
x = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MVar# s a -> a -> State# s -> State# s
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# s a
mvar# a
x)
{-# INLINE putLazyMVar #-}


-- | Same as putMVar, but evaluates the argument to NF prior to writing it.
--
-- @since 0.3.0
putDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => MVar a s -> a -> m ()
putDeepMVar :: MVar a s -> a -> m ()
putDeepMVar MVar a s
mvar a
x = MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar (a
x a -> MVar a s -> MVar a s
forall a b. NFData a => a -> b -> b
`deepseq` MVar a s
mvar) a
x
{-# INLINE putDeepMVar #-}


-- | Attempt to write a value into `MVar`. Unlike `putMVar` this function never blocks. It
-- also returns `True` if `MVar` was empty and placing the value in it turned out to be
-- successfull and `False` otherwise. Evaluates the supplied argumetn to WHNF prior to
-- attempting a write operation.
--
-- @since 0.3.0
tryPutMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutMVar :: MVar a s -> a -> m Bool
tryPutMVar MVar a s
mvar a
x = MVar a s -> a -> m Bool
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutLazyMVar (a
x a -> MVar a s -> MVar a s
`seq` MVar a s
mvar) a
x
{-# INLINE tryPutMVar #-}

-- | Same as `tryPutMVar`, but allows to put thunks into an `MVar`
--
-- Same as `Control.Concurrent.MVar.tryPutMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
tryPutLazyMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutLazyMVar :: MVar a s -> a -> m Bool
tryPutLazyMVar (MVar MVar# s a
mvar#) a
x =
  (State# s -> (# State# s, Bool #)) -> m Bool
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Bool #)) -> m Bool)
-> (State# s -> (# State# s, Bool #)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MVar# s a -> a -> State# s -> (# State# s, Int# #)
forall d a. MVar# d a -> a -> State# d -> (# State# d, Int# #)
tryPutMVar# MVar# s a
mvar# a
x State# s
s of
      (# State# s
s', Int#
b# #) -> (# State# s
s', Int# -> Bool
isTrue# Int#
b# #)
{-# INLINE tryPutLazyMVar #-}


-- | Same as `tryPutMVar`, but evaluates the argument to NF prior to attempting to write
-- into the `MVar`
--
-- @since 0.3.0
tryPutDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => MVar a s -> a -> m Bool
tryPutDeepMVar :: MVar a s -> a -> m Bool
tryPutDeepMVar MVar a s
mvar a
x = MVar a s -> a -> m Bool
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutLazyMVar MVar a s
mvar (a -> m Bool) -> a -> m Bool
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. NFData a => a -> a
force a
x
{-# INLINE tryPutDeepMVar #-}


-- | Write a value into the MVar regardless if it is currently empty or not. If there is a
-- currently a value it will in the MVar it will simply b discarded. However, if there is
-- another thread that is blocked on attempt to write into this MVar, current operation
-- will block on attempt to fill the MVar. Therefore `writeMVar` is not atomic. Argument
-- is evaluated to WHNF prior to clearing the contents of `MVar`
--
-- @since 0.3.0
writeMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m ()
writeMVar :: MVar a s -> a -> m ()
writeMVar MVar a s
mvar a
a =
  ST s () -> m ()
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s () -> m ()) -> ST s () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    MVar a s -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m ()
clearMVar (a
a a -> MVar a s -> MVar a s
`seq` MVar a s
mvar)
    MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
a :: ST s ()
{-# INLINE writeMVar #-}


-- | Replace current value in an `MVar` with a new one. Supplied value is evaluated to
-- WHNF prior to current value being extracted from the `MVar`. If `MVar` is currently
-- empty this operation will block the current thread until it gets filled in another
-- thread. Furthermore it is possible for another thread to fill the `MVar` after the old
-- value is extracted, but before the new one has a chance to placed inside the `MVar`,
-- thus blocking current thread once more until another thread empties this `MVar`. In
-- other words this operation is not atomic.
--
-- @since 0.3.0
swapMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m a
swapMVar :: MVar a s -> a -> m a
swapMVar MVar a s
mvar a
new =
  ST s a -> m a
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s a -> m a) -> ST s a -> m a
forall a b. (a -> b) -> a -> b
$ do
    a
old <- MVar a s -> ST s a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar (a
new a -> MVar a s -> MVar a s
`seq` MVar a s
mvar)
    a
old a -> ST s () -> ST s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
new :: ST s ())
{-# INLINE swapMVar #-}

-- | Same as `swapMVar`, but allows writing thunks into the `MVar`.
--
-- Same as `Control.Concurrent.MVar.swapMVar` from @base@, but works in any `MonadUnliftPrim`.
--
-- @since 0.3.0
swapLazyMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m a
swapLazyMVar :: MVar a s -> a -> m a
swapLazyMVar MVar a s
mvar a
new =
  ST s a -> m a
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s a -> m a) -> ST s a -> m a
forall a b. (a -> b) -> a -> b
$ do
    a
old <- MVar a s -> ST s a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a s
mvar
    a
old a -> ST s () -> ST s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
new :: ST s ())
{-# INLINE swapLazyMVar #-}


-- | Same as `swapMVar`, but evaluates the argument value to NF.
--
-- @since 0.3.0
swapDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => MVar a s -> a -> m a
swapDeepMVar :: MVar a s -> a -> m a
swapDeepMVar MVar a s
mvar a
new =
  ST s a -> m a
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s a -> m a) -> ST s a -> m a
forall a b. (a -> b) -> a -> b
$ do
    a
old <- MVar a s -> ST s a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar (a
new a -> MVar a s -> MVar a s
forall a b. NFData a => a -> b -> b
`deepseq` MVar a s
mvar)
    a
old a -> ST s () -> ST s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
new :: ST s ())
{-# INLINE swapDeepMVar #-}


-- | Remove the value from `MVar` and return it. Blocks the cuurent thread if `MVar` is empty and
-- waits until antoher thread fills it.
--
-- Same as `Control.Concurrent.MVar.takeMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
takeMVar :: forall a m s. MonadPrim s m => MVar a s -> m a
takeMVar :: MVar a s -> m a
takeMVar (MVar MVar# s a
mvar#) = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, a #)) -> m a)
-> (State# s -> (# State# s, a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \ State# s
s# -> MVar# s a -> State# s -> (# State# s, a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
takeMVar# MVar# s a
mvar# State# s
s#
{-# INLINE takeMVar #-}



-- | Remove the value from `MVar` and return it immediately without blocking. `Nothing` is
-- returned if `MVar` was empty.
--
-- Same as `Control.Concurrent.MVar.tryTakeMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
tryTakeMVar :: forall a m s. MonadPrim s m => MVar a s -> m (Maybe a)
tryTakeMVar :: MVar a s -> m (Maybe a)
tryTakeMVar (MVar MVar# s a
mvar#) =
  (State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Maybe a #)) -> m (Maybe a))
-> (State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MVar# s a -> State# s -> (# State# s, Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# s a
mvar# State# s
s of
      (# State# s
s', Int#
0#, a
_ #) -> (# State# s
s', Maybe a
forall a. Maybe a
Nothing #)
      (# State# s
s', Int#
_, a
a #)  -> (# State# s
s', a -> Maybe a
forall a. a -> Maybe a
Just a
a #)
{-# INLINE tryTakeMVar #-}

-- | Get the value from `MVar` atomically without affecting its contents. Blocks the
-- current thread if the `MVar` is currently empty and waits until another thread fills
-- it with a value.
--
-- Same as `Control.Concurrent.MVar.readMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
readMVar :: forall a m s. MonadPrim s m => MVar a s -> m a
readMVar :: MVar a s -> m a
readMVar (MVar MVar# s a
mvar#) = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (MVar# s a -> State# s -> (# State# s, a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
readMVar# MVar# s a
mvar#)
{-# INLINE readMVar #-}


-- | Get the value from `MVar` atomically without affecting its contents. It does not
-- block and returns the immediately or `Nothing` if the supplied `MVar` was empty.
--
-- Same as `Control.Concurrent.MVar.tryReadMVar` from @base@, but works in any `MonadPrim`.
--
-- @since 0.3.0
tryReadMVar :: forall a m s. MonadPrim s m => MVar a s -> m (Maybe a)
tryReadMVar :: MVar a s -> m (Maybe a)
tryReadMVar (MVar MVar# s a
mvar#) =
  (State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Maybe a #)) -> m (Maybe a))
-> (State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MVar# s a -> State# s -> (# State# s, Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryReadMVar# MVar# s a
mvar# State# s
s of
      (# State# s
s', Int#
0#, a
_ #) -> (# State# s
s', Maybe a
forall a. Maybe a
Nothing #)
      (# State# s
s', Int#
_, a
a #) -> (# State# s
s', a -> Maybe a
forall a. a -> Maybe a
Just a
a #)
{-# INLINE tryReadMVar #-}

-- | Remove a value from an `MVar`, unless it was already empty. It effectively empties
-- the `MVar` however note that by the time this action returns there is a possibility
-- that another thread might have filled it with a different value.
--
-- @since 0.3.0
clearMVar :: forall a m s. MonadPrim s m => MVar a s -> m ()
clearMVar :: MVar a s -> m ()
clearMVar (MVar MVar# s a
mvar#) =
  (State# s -> (# State# s, () #)) -> m ()
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, () #)) -> m ())
-> (State# s -> (# State# s, () #)) -> m ()
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MVar# s a -> State# s -> (# State# s, Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# s a
mvar# State# s
s of
      (# State# s
s', Int#
_, a
_ #) -> (# State# s
s', () #)
{-# INLINE clearMVar #-}


-- | Apply an action to the contents of an `MVar`. Current thread will be blocked if
-- supplied MVar is empty and will wait until another thread fills it with a value. While
-- the action is being appplied other threads should not put anything into the `MVar`
-- otherwise current thread will get blocked again until another thread empties the
-- `MVar`. In other words this is not an atomic operation, but it is exception safe, since
-- the contents of `MVar` are restored regardless of the outcome of supplied action.
--
-- Same as `Control.Concurrent.MVar.withMVar` from @base@, but works in `MonadUnliftPrim`
-- with `RealWorld` state token.
--
-- @since 0.3.0
withMVar :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m b) -> m b
withMVar :: MVar a RW -> (a -> m b) -> m b
withMVar MVar a RW
mvar !a -> m b
action =
  ((forall b. m b -> m b) -> m b) -> m b
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m b) -> m b)
-> ((forall b. m b -> m b) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
    a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
    b
b <- m b -> m b
forall b. m b -> m b
restore (a -> m b
action a
a) m b -> (SomeException -> m b) -> m b
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m b
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
    b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a
{-# INLINE withMVar #-}


-- | Same as `withMVar`, but with supplied action executed with async exceptions masked,
-- but still interruptable.
--
-- Same as `Control.Concurrent.MVar.withMVarMasked` from @base@, but works in
-- `MonadUnliftPrim` with `RealWorld` state token.
--
-- @since 0.3.0
withMVarMasked :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m b) -> m b
withMVarMasked :: MVar a RW -> (a -> m b) -> m b
withMVarMasked MVar a RW
mvar !a -> m b
action =
  m b -> m b
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
    a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
    b
b <- a -> m b
action a
a m b -> (SomeException -> m b) -> m b
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m b
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
    b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a
{-# INLINE withMVarMasked #-}




-- | Internal modification function that does no masking or forcing
modifyFetchLazyMVar :: MonadUnliftPrim RW m => (a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar :: (a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar a -> a -> b
select MVar a RW
mvar a -> m a
action = do
  a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
  a
a' <- a -> m a
action a
a m a -> (SomeException -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m a
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
  a -> a -> b
select a
a a
a' b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a'
{-# INLINE modifyFetchLazyMVar #-}


-- | Apply a monadic action to the contents of supplied `MVar`. Provides the same
-- guarantees as `withMVar`.
--
-- Same as `GHC.modifyMVar_` from @base@, but is strict with respect to result of the
-- action and works in `MonadUnliftPrim` with `RealWorld` state token.
--
-- @since 0.3.0
modifyMVar_ :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m ()
modifyMVar_ :: MVar a RW -> (a -> m a) -> m ()
modifyMVar_ MVar a RW
mvar = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m a -> m ()) -> ((a -> m a) -> m a) -> (a -> m a) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a RW -> (a -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVar MVar a RW
mvar
{-# INLINE modifyMVar_ #-}


-- | Same as `modifyMVarMAsked_`, but the supplied action has async exceptions masked.
--
-- Same as `GHC.modifyMVar` from @base@, except that it is strict in the new value and it
-- works in `MonadUnliftPrim` with `RealWorld` state token.
--
-- @since 0.3.0
modifyMVarMasked_ :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m ()
modifyMVarMasked_ :: MVar a RW -> (a -> m a) -> m ()
modifyMVarMasked_ MVar a RW
mvar !a -> m a
action =
  m () -> m ()
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> a -> ()) -> MVar a RW -> (a -> m a) -> m ()
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar (\a
_ a
_ -> ()) MVar a RW
mvar (a -> m a
action (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyMVarMasked_ #-}


-- | Same as `modifyMVar_`, but also returns the original value that was stored in the `MVar`
--
-- @since 0.3.0
modifyFetchOldMVar :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVar :: MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVar MVar a RW
mvar !a -> m a
action =
  ((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore ->
    (a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar a -> a -> a
forall a b. a -> b -> a
const MVar a RW
mvar ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
a ->
      m a -> m a
forall b. m b -> m b
restore (a -> m a
action a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchOldMVar #-}



-- | Same as `modifyFetchOldMVar`, but supplied action will run with async exceptions
-- masked, but still interruptible
--
-- @since 0.3.0
modifyFetchOldMVarMasked :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVarMasked :: MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVarMasked MVar a RW
mvar !a -> m a
action =
  m a -> m a
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar a -> a -> a
forall a b. a -> b -> a
const MVar a RW
mvar (a -> m a
action (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchOldMVarMasked #-}

-- | Same as `modifyMVar_`, but also returns the result of running the supplied action,
-- i.e. the new value that got stored in the `MVar`.
--
-- @since 0.3.0
modifyFetchNewMVar :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVar :: MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVar MVar a RW
mvar !a -> m a
action =
  ((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore ->
    (a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a b. a -> b -> a
const) MVar a RW
mvar ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
a ->
      m a -> m a
forall b. m b -> m b
restore (a -> m a
action a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchNewMVar #-}


-- | Same as `modifyFetchNewMVar`, but supplied action will run with async exceptions
-- masked, but still interruptible
--
-- @since 0.3.0
modifyFetchNewMVarMasked :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVarMasked :: MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVarMasked MVar a RW
mvar !a -> m a
action =
  m a -> m a
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a b. a -> b -> a
const) MVar a RW
mvar (a -> m a
action (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchNewMVarMasked #-}



-- | Apply a monadic action to the contents of supplied `MVar`. Provides the same
-- guarantees as `withMVar`.
--
-- Same as `GHC.modifyMVar` from @base@, except that it is strict in the new value and it
-- works in `MonadUnliftPrim` with `RealWorld` state token.
--
-- @since 0.3.0
modifyMVar :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m (a, b)) -> m b
modifyMVar :: MVar a RW -> (a -> m (a, b)) -> m b
modifyMVar MVar a RW
mvar a -> m (a, b)
action =
  ((forall b. m b -> m b) -> m b) -> m b
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m b) -> m b)
-> ((forall b. m b -> m b) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
    a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
    let run :: m (a, b)
run = m (a, b) -> m (a, b)
forall b. m b -> m b
restore (a -> m (a, b)
action a
a m (a, b) -> ((a, b) -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: (a, b)
t@(!a
_, b
_) -> (a, b) -> m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, b)
t)
    -- TODO: test against `force a'`
    (a
a', b
b) <- m (a, b)
run m (a, b) -> (SomeException -> m (a, b)) -> m (a, b)
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m (a, b) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m (a, b)
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
    b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a'
{-# INLINE modifyMVar #-}


-- | Apply a monadic action to the contents of supplied `MVar`. Provides the same
-- guarantees as `withMVar`.
--
-- Same as `GHC.modifyMVarMasked` from @base@, except that it is strict in the new value
-- and it works in `MonadUnliftPrim` with `RealWorld` state token.
--
-- @since 0.3.0
modifyMVarMasked :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m (a, b)) -> m b
modifyMVarMasked :: MVar a RW -> (a -> m (a, b)) -> m b
modifyMVarMasked MVar a RW
mvar a -> m (a, b)
action =
  m b -> m b
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
    a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
    let run :: m (a, b)
run = a -> m (a, b)
action a
a m (a, b) -> ((a, b) -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: (a, b)
t@(!a
_, b
_) -> (a, b) -> m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, b)
t
    -- TODO: test against `force a'`
    (a
a', b
b) <- m (a, b)
run m (a, b) -> (SomeException -> m (a, b)) -> m (a, b)
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m (a, b) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m (a, b)
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
    b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a'
{-# INLINE modifyMVarMasked #-}


-- | Create a `Weak` pointer associated with the supplied `MVar`.
--
-- Same as `Control.Concurrent.MVar.mkWeakMVar` from @base@, but works in any `MonadPrim`
-- with `RealWorld` state token.
--
-- @since 0.3.0
mkWeakMVar ::
     forall a b m. MonadUnliftPrim RW m
  => MVar a RW
  -> m b -- ^ An action that will get executed whenever `MVar` gets garbage collected by
         -- the runtime.
  -> m (Weak (MVar a RW))
mkWeakMVar :: MVar a RW -> m b -> m (Weak (MVar a RW))
mkWeakMVar mvar :: MVar a RW
mvar@(MVar MVar# RW a
mvar#) !m b
finalizer =
  m b
-> ((State# RW -> (# State# RW, b #))
    -> State# RW -> (# State# RW, Weak (MVar a RW) #))
-> m (Weak (MVar a RW))
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
    -> State# s -> (# State# s, b #))
-> m b
runInPrimBase m b
finalizer (((State# RW -> (# State# RW, b #))
  -> State# RW -> (# State# RW, Weak (MVar a RW) #))
 -> m (Weak (MVar a RW)))
-> ((State# RW -> (# State# RW, b #))
    -> State# RW -> (# State# RW, Weak (MVar a RW) #))
-> m (Weak (MVar a RW))
forall a b. (a -> b) -> a -> b
$ \State# RW -> (# State# RW, b #)
f# State# RW
s ->
    case MVar# RW a
-> MVar a RW
-> (State# RW -> (# State# RW, b #))
-> State# RW
-> (# State# RW, Weak# (MVar a RW) #)
forall a b c.
a
-> b
-> (State# RW -> (# State# RW, c #))
-> State# RW
-> (# State# RW, Weak# b #)
mkWeak# MVar# RW a
mvar# MVar a RW
mvar State# RW -> (# State# RW, b #)
f# State# RW
s of
      (# State# RW
s', Weak# (MVar a RW)
weak# #) -> (# State# RW
s', Weak# (MVar a RW) -> Weak (MVar a RW)
forall v. Weak# v -> Weak v
Weak Weak# (MVar a RW)
weak# #)
{-# INLINE mkWeakMVar #-}



-- | Cast `MVar` into and the `Control.Concurrent.MVar.MVar` from @base@
--
-- @since 0.3.0
toBaseMVar :: MVar a RW -> GHC.MVar a
toBaseMVar :: MVar a RW -> MVar a
toBaseMVar (MVar MVar# RW a
mvar#) = MVar# RW a -> MVar a
forall a. MVar# RW a -> MVar a
GHC.MVar MVar# RW a
mvar#
{-# INLINE toBaseMVar #-}

-- | Cast `Control.Concurrent.MVar.MVar` from @base@ into `MVar`.
--
-- @since 0.3.0
fromBaseMVar :: GHC.MVar a -> MVar a RW
fromBaseMVar :: MVar a -> MVar a RW
fromBaseMVar (GHC.MVar MVar# RW a
mvar#) = MVar# RW a -> MVar a RW
forall a s. MVar# s a -> MVar a s
MVar MVar# RW a
mvar#
{-# INLINE fromBaseMVar #-}