{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeFamilies      #-}

module Ouroboros.Consensus.Util.MonadSTM.StrictMVar (
    StrictMVar(..) -- constructors exported for benefit of tests
  , castStrictMVar
  , newMVar
  , newMVarWithInvariant
  , newEmptyMVar
  , newEmptyMVarWithInvariant
  , takeMVar
  , tryTakeMVar
  , putMVar
  , tryPutMVar
  , readMVar
  , readMVarSTM
  , tryReadMVar
  , swapMVar
  , isEmptyMVar
  , updateMVar
  , updateMVar_
  , modifyMVar
  , modifyMVar_
  ) where

import           Control.Concurrent.STM (readTVarIO)
import           Control.Monad (when)
import           Control.Monad.Class.MonadSTM (MonadSTM (..))
import qualified Control.Monad.Class.MonadSTM as Lazy
import           Control.Monad.Class.MonadSTM.Strict (checkInvariant)
import           Control.Monad.Class.MonadThrow (ExitCase (..), MonadCatch,
                     generalBracket)
import           GHC.Stack
import           NoThunks.Class (NoThunks (..))

{-------------------------------------------------------------------------------
  Strict MVar
-------------------------------------------------------------------------------}

-- | Strict MVar (modelled using a lazy 'Lazy.TMVar' under the hood)
--
-- The 'StrictMVar' API is slightly stronger than the usual 'MVar' one, as we
-- offer a primitive to read the value of the MVar even if it is empty (in which
-- case we will return the oldest known stale one). See 'readMVarSTM'.
--
-- There is a weaker invariant for a 'StrictMVar' than for a 'StrictTVar':
-- although all functions that modify the 'StrictMVar' check the invariant, we
-- do /not/ guarantee that the value inside the 'StrictMVar' always satisfies
-- the invariant. Instead, we /do/ guarantee that if the 'StrictMVar' is updated
-- with a value that does not satisfy the invariant, an exception is thrown. The
-- reason for this weaker guarantee is that leaving an 'MVar' empty can lead to
-- very hard to debug "blocked indefinitely" problems.
--
-- This is also the reason we do not offer support for an invariant in
-- 'StrictTMVar': if we throw an exception from an STM transaction, the STM
-- transaction is not executed, and so we would not even be able to provide the
-- weaker guarantee that we provide for 'StrictMVar'.
data StrictMVar m a = StrictMVar
  { StrictMVar m a -> a -> Maybe String
invariant :: !(a -> Maybe String)
    -- ^ Invariant checked whenever updating the 'StrictMVar'.
  , StrictMVar m a -> TMVar m a
tmvar     :: !(Lazy.TMVar m a)
    -- ^ The main TMVar supporting this 'StrictMVar'
  , StrictMVar m a -> TVar m a
tvar      :: !(Lazy.TVar m a)
    -- ^ TVar for supporting 'readMVarSTM'
    --
    -- This TVar is always kept up to date with the 'Lazy.TMVar', but holds on
    -- the old value of the 'Lazy.TMVar' when it is empty. This is very useful
    -- to support single writer/many reader scenarios.
    --
    -- NOTE: We should always update the 'tmvar' before the 'tvar' so that if
    -- the update to the 'tmvar' fails, the 'tvar is left unchanged.
  }

castStrictMVar :: ( Lazy.TMVar m ~ Lazy.TMVar n
                  , Lazy.TVar  m ~ Lazy.TVar  n
                  )
               => StrictMVar m a -> StrictMVar n a
castStrictMVar :: StrictMVar m a -> StrictMVar n a
castStrictMVar StrictMVar{TMVar m a
TVar m a
a -> Maybe String
tvar :: TVar m a
tmvar :: TMVar m a
invariant :: a -> Maybe String
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
invariant :: forall (m :: * -> *) a. StrictMVar m a -> a -> Maybe String
..} = StrictMVar :: forall (m :: * -> *) a.
(a -> Maybe String) -> TMVar m a -> TVar m a -> StrictMVar m a
StrictMVar{TMVar m a
TMVar_ (STM n) a
TVar m a
TVar_ (STM n) a
a -> Maybe String
tvar :: TVar m a
tmvar :: TMVar m a
invariant :: a -> Maybe String
tvar :: TVar_ (STM n) a
tmvar :: TMVar_ (STM n) a
invariant :: a -> Maybe String
..}

newMVar :: MonadSTM m => a -> m (StrictMVar m a)
newMVar :: a -> m (StrictMVar m a)
newMVar = (a -> Maybe String) -> a -> m (StrictMVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
(a -> Maybe String) -> a -> m (StrictMVar m a)
newMVarWithInvariant (Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)

newMVarWithInvariant :: (MonadSTM m, HasCallStack)
                     => (a -> Maybe String)  -- ^ Invariant (expect 'Nothing')
                     -> a
                     -> m (StrictMVar m a)
newMVarWithInvariant :: (a -> Maybe String) -> a -> m (StrictMVar m a)
newMVarWithInvariant a -> Maybe String
invariant !a
a =
    Maybe String -> m (StrictMVar m a) -> m (StrictMVar m a)
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a) (m (StrictMVar m a) -> m (StrictMVar m a))
-> m (StrictMVar m a) -> m (StrictMVar m a)
forall a b. (a -> b) -> a -> b
$
    (a -> Maybe String)
-> TMVar_ (STM m) a -> TVar_ (STM m) a -> StrictMVar m a
forall (m :: * -> *) a.
(a -> Maybe String) -> TMVar m a -> TVar m a -> StrictMVar m a
StrictMVar a -> Maybe String
invariant (TMVar_ (STM m) a -> TVar_ (STM m) a -> StrictMVar m a)
-> m (TMVar_ (STM m) a) -> m (TVar_ (STM m) a -> StrictMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (TMVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
Lazy.newTMVarIO a
a m (TVar_ (STM m) a -> StrictMVar m a)
-> m (TVar_ (STM m) a) -> m (StrictMVar m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m (TVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
Lazy.newTVarIO a
a

newEmptyMVar :: MonadSTM m => a -> m (StrictMVar m a)
newEmptyMVar :: a -> m (StrictMVar m a)
newEmptyMVar = (a -> Maybe String) -> a -> m (StrictMVar m a)
forall (m :: * -> *) a.
MonadSTM m =>
(a -> Maybe String) -> a -> m (StrictMVar m a)
newEmptyMVarWithInvariant (Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)

-- | Create an initially empty 'StrictMVar'
--
-- NOTE: Since 'readMVarSTM' allows to read the 'StrictMVar' even when it is
-- empty, we need an initial value of @a@ even though the 'StrictMVar' starts
-- out empty. However, we are /NOT/ strict in this value, to allow it to be
-- @error@.
newEmptyMVarWithInvariant :: MonadSTM m
                          => (a -> Maybe String)  -- ^ Invariant (expect 'Nothing')
                          -> a                    -- ^ The initial stale value
                          -> m (StrictMVar m a)
newEmptyMVarWithInvariant :: (a -> Maybe String) -> a -> m (StrictMVar m a)
newEmptyMVarWithInvariant a -> Maybe String
invariant a
stale =
    (a -> Maybe String)
-> TMVar_ (STM m) a -> TVar_ (STM m) a -> StrictMVar m a
forall (m :: * -> *) a.
(a -> Maybe String) -> TMVar m a -> TVar m a -> StrictMVar m a
StrictMVar a -> Maybe String
invariant (TMVar_ (STM m) a -> TVar_ (STM m) a -> StrictMVar m a)
-> m (TMVar_ (STM m) a) -> m (TVar_ (STM m) a -> StrictMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (TMVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => m (TMVar m a)
Lazy.newEmptyTMVarIO m (TVar_ (STM m) a -> StrictMVar m a)
-> m (TVar_ (STM m) a) -> m (StrictMVar m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m (TVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
Lazy.newTVarIO a
stale

takeMVar :: MonadSTM m => StrictMVar m a -> m a
takeMVar :: StrictMVar m a -> m a
takeMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar } = STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m a -> m a) -> STM m a -> m a
forall a b. (a -> b) -> a -> b
$ TMVar m a -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => TMVar_ stm a -> stm a
Lazy.takeTMVar TMVar m a
tmvar

tryTakeMVar :: MonadSTM m => StrictMVar m a -> m (Maybe a)
tryTakeMVar :: StrictMVar m a -> m (Maybe a)
tryTakeMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar } = STM m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Maybe a) -> m (Maybe a)) -> STM m (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ TMVar m a -> STM m (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm (Maybe a)
Lazy.tryTakeTMVar TMVar m a
tmvar

putMVar :: (MonadSTM m, HasCallStack) => StrictMVar m a -> a -> m ()
putMVar :: StrictMVar m a -> a -> m ()
putMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar, TVar m a
tvar :: TVar m a
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tvar, a -> Maybe String
invariant :: a -> Maybe String
invariant :: forall (m :: * -> *) a. StrictMVar m a -> a -> Maybe String
invariant } !a
a = do
    STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        TMVar m a -> a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm ()
Lazy.putTMVar TMVar m a
tmvar a
a
        TVar m a -> a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
Lazy.writeTVar TVar m a
tvar a
a
    Maybe String -> m () -> m ()
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tryPutMVar :: (MonadSTM m, HasCallStack) => StrictMVar m a -> a -> m Bool
tryPutMVar :: StrictMVar m a -> a -> m Bool
tryPutMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar, TVar m a
tvar :: TVar m a
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tvar, a -> Maybe String
invariant :: a -> Maybe String
invariant :: forall (m :: * -> *) a. StrictMVar m a -> a -> Maybe String
invariant } !a
a = do
    Bool
didPut <- STM m Bool -> m Bool
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Bool -> m Bool) -> STM m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
        Bool
didPut <- TMVar m a -> a -> STM m Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm Bool
Lazy.tryPutTMVar TMVar m a
tmvar a
a
        Bool -> STM m () -> STM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
didPut (STM m () -> STM m ()) -> STM m () -> STM m ()
forall a b. (a -> b) -> a -> b
$ TVar m a -> a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
Lazy.writeTVar TVar m a
tvar a
a
        Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
didPut
    Maybe String -> m Bool -> m Bool
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a) (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
didPut

readMVar :: MonadSTM m => StrictMVar m a -> m a
readMVar :: StrictMVar m a -> m a
readMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar } = STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m a -> m a) -> STM m a -> m a
forall a b. (a -> b) -> a -> b
$ TMVar m a -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => TMVar_ stm a -> stm a
Lazy.readTMVar TMVar m a
tmvar

tryReadMVar :: MonadSTM m => StrictMVar m a -> m (Maybe a)
tryReadMVar :: StrictMVar m a -> m (Maybe a)
tryReadMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar } = STM m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Maybe a) -> m (Maybe a)) -> STM m (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ TMVar m a -> STM m (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm (Maybe a)
Lazy.tryReadTMVar TMVar m a
tmvar

-- | Read the possibly-stale value of the @MVar@
--
-- Will return the current value of the @MVar@ if it non-empty, or the last
-- known value otherwise.
readMVarSTM :: MonadSTM m => StrictMVar m a -> STM m a
readMVarSTM :: StrictMVar m a -> STM m a
readMVarSTM StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar, TVar m a
tvar :: TVar m a
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tvar } = do
    Maybe a
ma <- TMVar m a -> STM m (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm (Maybe a)
Lazy.tryReadTMVar TMVar m a
tmvar
    case Maybe a
ma of
      Just a
a  -> a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
      Maybe a
Nothing -> TVar m a -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
Lazy.readTVar TVar m a
tvar

-- | Swap value of a 'StrictMVar'
--
-- NOTE: Since swapping the value can't leave the 'StrictMVar' empty, we
-- /could/ check the invariant first and only then swap. We nonetheless swap
-- first and check the invariant after to keep the semantics the same with
-- 'putMVar', otherwise it will be difficult to understand when a 'StrictMVar'
-- is updated and when it is not.
swapMVar :: (MonadSTM m, HasCallStack) => StrictMVar m a -> a -> m a
swapMVar :: StrictMVar m a -> a -> m a
swapMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar, TVar m a
tvar :: TVar m a
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tvar, a -> Maybe String
invariant :: a -> Maybe String
invariant :: forall (m :: * -> *) a. StrictMVar m a -> a -> Maybe String
invariant } !a
a = do
    a
oldValue <- STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m a -> m a) -> STM m a -> m a
forall a b. (a -> b) -> a -> b
$ do
        a
oldValue <- TMVar m a -> a -> STM m a
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm a
Lazy.swapTMVar TMVar m a
tmvar a
a
        TVar m a -> a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
Lazy.writeTVar TVar m a
tvar a
a
        a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
oldValue
    Maybe String -> m a -> m a
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
oldValue

isEmptyMVar :: MonadSTM m => StrictMVar m a -> m Bool
isEmptyMVar :: StrictMVar m a -> m Bool
isEmptyMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar } = STM m Bool -> m Bool
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Bool -> m Bool) -> STM m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ TMVar m a -> STM m Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm Bool
Lazy.isEmptyTMVar TMVar m a
tmvar

updateMVar :: (MonadSTM m, HasCallStack) => StrictMVar m a -> (a -> (a, b)) -> m b
updateMVar :: StrictMVar m a -> (a -> (a, b)) -> m b
updateMVar StrictMVar { TMVar m a
tmvar :: TMVar m a
tmvar :: forall (m :: * -> *) a. StrictMVar m a -> TMVar m a
tmvar, TVar m a
tvar :: TVar m a
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tvar, a -> Maybe String
invariant :: a -> Maybe String
invariant :: forall (m :: * -> *) a. StrictMVar m a -> a -> Maybe String
invariant } a -> (a, b)
f = do
    (a
a', b
b) <- STM m (a, b) -> m (a, b)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (a, b) -> m (a, b)) -> STM m (a, b) -> m (a, b)
forall a b. (a -> b) -> a -> b
$ do
        a
a <- TMVar m a -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => TMVar_ stm a -> stm a
Lazy.takeTMVar TMVar m a
tmvar
        let !(!a
a', b
b) = a -> (a, b)
f a
a
        TMVar m a -> a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm ()
Lazy.putTMVar TMVar m a
tmvar a
a'
        TVar m a -> a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
Lazy.writeTVar TVar m a
tvar a
a'
        (a, b) -> STM m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a', b
b)
    Maybe String -> m b -> m b
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a') (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

updateMVar_ :: (MonadSTM m, HasCallStack) => StrictMVar m a -> (a -> a) -> m ()
updateMVar_ :: StrictMVar m a -> (a -> a) -> m ()
updateMVar_ StrictMVar m a
var a -> a
f = StrictMVar m a -> (a -> (a, ())) -> m ()
forall (m :: * -> *) a b.
(MonadSTM m, HasCallStack) =>
StrictMVar m a -> (a -> (a, b)) -> m b
updateMVar StrictMVar m a
var ((, ()) (a -> (a, ())) -> (a -> a) -> a -> (a, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)

modifyMVar :: (MonadSTM m, MonadCatch m, HasCallStack)
           => StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar :: StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m a
var a -> m (a, b)
action =
    (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (((a, b), ()) -> (a, b)) -> ((a, b), ()) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b), ()) -> (a, b)
forall a b. (a, b) -> a
fst (((a, b), ()) -> b) -> m ((a, b), ()) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
-> (a -> ExitCase (a, b) -> m ())
-> (a -> m (a, b))
-> m ((a, b), ())
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (StrictMVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => StrictMVar m a -> m a
takeMVar StrictMVar m a
var) a -> ExitCase (a, b) -> m ()
putBack a -> m (a, b)
action
  where
    putBack :: a -> ExitCase (a, b) -> m ()
putBack a
a ExitCase (a, b)
ec = case ExitCase (a, b)
ec of
      ExitCaseSuccess (a
a', b
_) -> StrictMVar m a -> a -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictMVar m a -> a -> m ()
putMVar StrictMVar m a
var a
a'
      ExitCaseException SomeException
_ex   -> StrictMVar m a -> a -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictMVar m a -> a -> m ()
putMVar StrictMVar m a
var a
a
      ExitCase (a, b)
ExitCaseAbort           -> StrictMVar m a -> a -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictMVar m a -> a -> m ()
putMVar StrictMVar m a
var a
a

modifyMVar_ :: (MonadSTM m, MonadCatch m, HasCallStack)
            => StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ :: StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m a
var a -> m a
action = StrictMVar m a -> (a -> m (a, ())) -> m ()
forall (m :: * -> *) a b.
(MonadSTM m, MonadCatch m, HasCallStack) =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m a
var ((a -> (a, ())) -> m a -> m (a, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) (m a -> m (a, ())) -> (a -> m a) -> a -> m (a, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
action)

{-------------------------------------------------------------------------------
  NoThunks
-------------------------------------------------------------------------------}

instance NoThunks a => NoThunks (StrictMVar IO a) where
  showTypeOf :: Proxy (StrictMVar IO a) -> String
showTypeOf Proxy (StrictMVar IO a)
_ = String
"StrictMVar IO"
  wNoThunks :: Context -> StrictMVar IO a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt StrictMVar { TVar IO a
tvar :: TVar IO a
tvar :: forall (m :: * -> *) a. StrictMVar m a -> TVar m a
tvar } = do
      -- We can't use @atomically $ readTVar ..@ here, as that will lead to a
      -- "Control.Concurrent.STM.atomically was nested" exception.
      a
a <- TVar a -> IO a
forall a. TVar a -> IO a
readTVarIO TVar a
TVar IO a
tvar
      Context -> a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt a
a