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

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

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 n a
TVar m a
TVar n a
a -> Maybe String
tvar :: TVar m a
tmvar :: TMVar m a
invariant :: a -> Maybe String
tvar :: TVar n a
tmvar :: TMVar 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 m a -> TVar 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 m a -> TVar m a -> StrictMVar m a)
-> m (TMVar m a) -> m (TVar m a -> StrictMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
Lazy.newTMVarIO a
a m (TVar m a -> StrictMVar m a)
-> m (TVar m a) -> m (StrictMVar m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m (TVar 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 m a -> TVar 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 m a -> TVar m a -> StrictMVar m a)
-> m (TMVar m a) -> m (TVar m a -> StrictMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => m (TMVar m a)
Lazy.newEmptyTMVarIO m (TVar m a -> StrictMVar m a)
-> m (TVar m a) -> m (StrictMVar m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m (TVar 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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m 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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (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 (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
Lazy.putTMVar TMVar m a
tmvar a
a
        TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
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 (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m 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 (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m 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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (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 (m :: * -> *) a. MonadSTM m => TVar m a -> STM m 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 (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m a
Lazy.swapTMVar TMVar m a
tmvar a
a
        TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m 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 (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m 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 (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
Lazy.putTMVar TMVar m a
tmvar a
a'
        TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
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 IO a -> IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar IO a
tvar
      Context -> a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt a
a