{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE TypeFamilies          #-}

-- to preserve 'HasCallstack' constraint on 'checkInvariant'
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Control.Monad.Class.MonadSTM.Strict
  ( module X
  , LazyTVar
  , LazyTMVar
    -- * 'StrictTVar'
  , StrictTVar
  , labelTVar
  , labelTVarIO
  , traceTVar
  , traceTVarIO
  , castStrictTVar
  , toLazyTVar
  , fromLazyTVar
  , newTVar
  , newTVarIO
  , newTVarWithInvariant
  , newTVarWithInvariantIO
  , readTVar
  , readTVarIO
  , writeTVar
  , modifyTVar
  , stateTVar
  , swapTVar
    -- * 'StrictTMVar'
  , StrictTMVar
  , labelTMVar
  , labelTMVarIO
  , traceTMVar
  , traceTMVarIO
  , castStrictTMVar
  , toLazyTMVar
  , fromLazyTMVar
  , newTMVar
  , newTMVarIO
  , newEmptyTMVar
  , newEmptyTMVarIO
  , takeTMVar
  , tryTakeTMVar
  , putTMVar
  , tryPutTMVar
  , readTMVar
  , tryReadTMVar
  , swapTMVar
  , isEmptyTMVar
    -- ** Low-level API
  , checkInvariant
    -- * Deprecated API
  , updateTVar
  , newTVarM
  , newTVarWithInvariantM
  , newTMVarM
  , newEmptyTMVarM
  ) where

import           Control.Monad.Class.MonadSTM as X hiding (LazyTMVar, LazyTVar,
                     TMVar, TVar, isEmptyTMVar, labelTMVar, labelTMVarIO,
                     labelTVar, labelTVarIO, modifyTVar, newEmptyTMVar,
                     newEmptyTMVarIO, newEmptyTMVarM, newTMVar, newTMVarIO,
                     newTMVarM, newTVar, newTVarIO, newTVarM, putTMVar,
                     readTMVar, readTVar, readTVarIO, stateTVar, swapTMVar,
                     swapTVar, takeTMVar, traceTMVar, traceTMVarIO, traceTVar,
                     traceTVarIO, tryPutTMVar, tryReadTMVar, tryTakeTMVar,
                     writeTVar)
import qualified Control.Monad.Class.MonadSTM as Lazy
import           GHC.Stack

{-------------------------------------------------------------------------------
  Lazy TVar
-------------------------------------------------------------------------------}

type LazyTVar  m = Lazy.TVar m
type LazyTMVar m = Lazy.TMVar m

{-------------------------------------------------------------------------------
  Strict TVar
-------------------------------------------------------------------------------}

#if CHECK_TVAR_INVARIANT
data StrictTVar m a = StrictTVar
   { invariant :: !(a -> Maybe String)
     -- ^ Invariant checked whenever updating the 'StrictTVar'.
   , tvar      :: !(LazyTVar m a)
   }
#else
newtype StrictTVar m a = StrictTVar
   { StrictTVar m a -> LazyTVar m a
tvar      :: LazyTVar m a
   }
#endif

labelTVar :: MonadLabelledSTM m => StrictTVar m a -> String -> STM m ()
labelTVar :: StrictTVar m a -> String -> STM m ()
labelTVar StrictTVar { LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar } = LazyTVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
Lazy.labelTVar LazyTVar m a
tvar

labelTVarIO :: MonadLabelledSTM m => StrictTVar m a -> String -> m ()
labelTVarIO :: StrictTVar m a -> String -> m ()
labelTVarIO StrictTVar m a
v = STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> (String -> STM m ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTVar m a -> String -> STM m ()
labelTVar StrictTVar m a
v

traceTVar :: MonadTraceSTM m
          => proxy m
          -> StrictTVar m a
          -> (Maybe a -> a -> InspectMonad m TraceValue)
          -> STM m ()
traceTVar :: proxy m
-> StrictTVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar proxy m
p StrictTVar {LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar} = proxy m
-> LazyTVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
Lazy.traceTVar proxy m
p LazyTVar m a
tvar

traceTVarIO :: MonadTraceSTM m
            => proxy m
            -> StrictTVar m a
            -> (Maybe a -> a -> InspectMonad m TraceValue)
            -> m ()
traceTVarIO :: proxy m
-> StrictTVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> m ()
traceTVarIO proxy m
p StrictTVar {LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar} = proxy m
-> LazyTVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a -> (Maybe a -> a -> InspectMonad m TraceValue) -> m ()
Lazy.traceTVarIO proxy m
p LazyTVar m a
tvar

castStrictTVar :: LazyTVar m ~ LazyTVar n
               => StrictTVar m a -> StrictTVar n a
castStrictTVar :: StrictTVar m a -> StrictTVar n a
castStrictTVar v :: StrictTVar m a
v@StrictTVar {LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar} =
    (a -> Maybe String) -> TVar n a -> StrictTVar n a
forall a (m :: * -> *).
(a -> Maybe String) -> TVar m a -> StrictTVar m a
mkStrictTVar (StrictTVar m a -> a -> Maybe String
forall (m :: * -> *) a. StrictTVar m a -> a -> Maybe String
getInvariant StrictTVar m a
v) LazyTVar m a
TVar n a
tvar

-- | Get the underlying @TVar@
--
-- Since we obviously cannot guarantee that updates to this 'LazyTVar' will be
-- strict, this should be used with caution.
toLazyTVar :: StrictTVar m a -> LazyTVar m a
toLazyTVar :: StrictTVar m a -> LazyTVar m a
toLazyTVar StrictTVar { LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar } = LazyTVar m a
tvar

fromLazyTVar :: LazyTVar m a -> StrictTVar m a
fromLazyTVar :: LazyTVar m a -> StrictTVar m a
fromLazyTVar LazyTVar m a
tvar =
#if CHECK_TVAR_INVARIANT
  StrictTVar { invariant = const Nothing
             , tvar
             }
#else
  StrictTVar :: forall (m :: * -> *) a. LazyTVar m a -> StrictTVar m a
StrictTVar { LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: LazyTVar m a
tvar }
#endif

newTVar :: MonadSTM m => a -> STM m (StrictTVar m a)
newTVar :: a -> STM m (StrictTVar m a)
newTVar !a
a = (\TVar m a
tvar -> (a -> Maybe String) -> TVar m a -> StrictTVar m a
forall a (m :: * -> *).
(a -> Maybe String) -> TVar m a -> StrictTVar m a
mkStrictTVar (Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) TVar m a
tvar)
         (TVar m a -> StrictTVar m a)
-> STM m (TVar m a) -> STM m (StrictTVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
Lazy.newTVar a
a

newTVarIO :: MonadSTM m => a -> m (StrictTVar m a)
newTVarIO :: a -> m (StrictTVar m a)
newTVarIO = (a -> Maybe String) -> a -> m (StrictTVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
(a -> Maybe String) -> a -> m (StrictTVar m a)
newTVarWithInvariantIO (Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)

newTVarM :: MonadSTM m => a -> m (StrictTVar m a)
newTVarM :: a -> m (StrictTVar m a)
newTVarM = a -> m (StrictTVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO
{-# DEPRECATED newTVarM "Use newTVarIO" #-}

newTVarWithInvariant :: (MonadSTM m, HasCallStack)
                     => (a -> Maybe String) -- ^ Invariant (expect 'Nothing')
                     -> a
                     -> STM m (StrictTVar m a)
newTVarWithInvariant :: (a -> Maybe String) -> a -> STM m (StrictTVar m a)
newTVarWithInvariant  a -> Maybe String
invariant !a
a =
        Maybe String -> STM m (StrictTVar m a) -> STM m (StrictTVar m a)
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a) (STM m (StrictTVar m a) -> STM m (StrictTVar m a))
-> STM m (StrictTVar m a) -> STM m (StrictTVar m a)
forall a b. (a -> b) -> a -> b
$
        (\TVar m a
tvar -> (a -> Maybe String) -> TVar m a -> StrictTVar m a
forall a (m :: * -> *).
(a -> Maybe String) -> TVar m a -> StrictTVar m a
mkStrictTVar a -> Maybe String
invariant TVar m a
tvar)
    (TVar m a -> StrictTVar m a)
-> STM m (TVar m a) -> STM m (StrictTVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
Lazy.newTVar a
a

newTVarWithInvariantIO :: (MonadSTM m, HasCallStack)
                       => (a -> Maybe String) -- ^ Invariant (expect 'Nothing')
                       -> a
                       -> m (StrictTVar m a)
newTVarWithInvariantIO :: (a -> Maybe String) -> a -> m (StrictTVar m a)
newTVarWithInvariantIO  a -> Maybe String
invariant !a
a =
        Maybe String -> m (StrictTVar m a) -> m (StrictTVar m a)
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (a -> Maybe String
invariant a
a) (m (StrictTVar m a) -> m (StrictTVar m a))
-> m (StrictTVar m a) -> m (StrictTVar m a)
forall a b. (a -> b) -> a -> b
$
        (\TVar m a
tvar -> (a -> Maybe String) -> TVar m a -> StrictTVar m a
forall a (m :: * -> *).
(a -> Maybe String) -> TVar m a -> StrictTVar m a
mkStrictTVar a -> Maybe String
invariant TVar m a
tvar)
    (TVar m a -> StrictTVar m a) -> m (TVar m a) -> m (StrictTVar m a)
forall (f :: * -> *) a b. Functor 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

newTVarWithInvariantM :: (MonadSTM m, HasCallStack)
                      => (a -> Maybe String) -- ^ Invariant (expect 'Nothing')
                      -> a
                      -> m (StrictTVar m a)
newTVarWithInvariantM :: (a -> Maybe String) -> a -> m (StrictTVar m a)
newTVarWithInvariantM = (a -> Maybe String) -> a -> m (StrictTVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
(a -> Maybe String) -> a -> m (StrictTVar m a)
newTVarWithInvariantIO
{-# DEPRECATED newTVarWithInvariantM "Use newTVarWithInvariantIO" #-}

readTVar :: MonadSTM m => StrictTVar m a -> STM m a
readTVar :: StrictTVar m a -> STM m a
readTVar StrictTVar { LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar } = LazyTVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
Lazy.readTVar LazyTVar m a
tvar

readTVarIO :: MonadSTM m => StrictTVar m a -> m a
readTVarIO :: StrictTVar m a -> m a
readTVarIO StrictTVar { LazyTVar m a
tvar :: LazyTVar m a
$sel:tvar:StrictTVar :: forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar } = LazyTVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
Lazy.readTVarIO LazyTVar m a
tvar

writeTVar :: (MonadSTM m, HasCallStack) => StrictTVar m a -> a -> STM m ()
writeTVar :: StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m a
v !a
a =
    Maybe String -> STM m () -> STM m ()
forall a. HasCallStack => Maybe String -> a -> a
checkInvariant (StrictTVar m a -> a -> Maybe String
forall (m :: * -> *) a. StrictTVar m a -> a -> Maybe String
getInvariant StrictTVar m a
v a
a) (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 (StrictTVar m a -> TVar m a
forall (m :: * -> *) a. StrictTVar m a -> LazyTVar m a
tvar StrictTVar m a
v) a
a

modifyTVar :: MonadSTM m => StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar :: StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar m a
v a -> a
f = StrictTVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m a
v STM m a -> (a -> STM m ()) -> STM m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StrictTVar m a -> a -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m a
v (a -> STM m ()) -> (a -> a) -> a -> STM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f

stateTVar :: MonadSTM m => StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar :: StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar StrictTVar m s
v s -> (a, s)
f = do
    s
a <- StrictTVar m s -> STM m s
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m s
v
    let (a
b, s
a') = s -> (a, s)
f s
a
    StrictTVar m s -> s -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m s
v s
a'
    a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b

swapTVar :: MonadSTM m => StrictTVar m a -> a -> STM m a
swapTVar :: StrictTVar m a -> a -> STM m a
swapTVar StrictTVar m a
v a
a' = do
    a
a <- StrictTVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m a
v
    StrictTVar m a -> a -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m a
v a
a'
    a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a


updateTVar :: MonadSTM m => StrictTVar m s -> (s -> (a, s)) -> STM m a
updateTVar :: StrictTVar m s -> (s -> (a, s)) -> STM m a
updateTVar = StrictTVar m s -> (s -> (a, s)) -> STM m a
forall (m :: * -> *) s a.
MonadSTM m =>
StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar
{-# DEPRECATED updateTVar "Use stateTVar" #-}

{-------------------------------------------------------------------------------
  Strict TMVar
-------------------------------------------------------------------------------}

-- 'TMVar' that keeps its value in WHNF at all times
--
-- Does not support an invariant: if the invariant would not be satisfied,
-- we would not be able to put a value into an empty TMVar, which would lead
-- to very hard to debug bugs where code is blocked indefinitely.
newtype StrictTMVar m a = StrictTMVar { StrictTMVar m a -> LazyTMVar m a
toLazyTMVar :: LazyTMVar m a }

fromLazyTMVar :: LazyTMVar m a -> StrictTMVar m a
fromLazyTMVar :: LazyTMVar m a -> StrictTMVar m a
fromLazyTMVar = LazyTMVar m a -> StrictTMVar m a
forall (m :: * -> *) a. LazyTMVar m a -> StrictTMVar m a
StrictTMVar

labelTMVar :: MonadLabelledSTM m => StrictTMVar m a -> String -> STM m ()
labelTMVar :: StrictTMVar m a -> String -> STM m ()
labelTMVar (StrictTMVar LazyTMVar m a
tvar) = LazyTMVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TMVar m a -> String -> STM m ()
Lazy.labelTMVar LazyTMVar m a
tvar

labelTMVarIO :: MonadLabelledSTM m => StrictTMVar m a -> String -> m ()
labelTMVarIO :: StrictTMVar m a -> String -> m ()
labelTMVarIO StrictTMVar m a
v = STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> (String -> STM m ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTMVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTMVar m a -> String -> STM m ()
labelTMVar StrictTMVar m a
v

traceTMVar :: MonadTraceSTM m
           => proxy m
           -> StrictTMVar m a
           -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)
           -> STM m ()
traceTMVar :: proxy m
-> StrictTMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVar proxy m
p (StrictTMVar LazyTMVar m a
var) = proxy m
-> LazyTMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
Lazy.traceTMVar proxy m
p LazyTMVar m a
var

traceTMVarIO :: MonadTraceSTM m
             => proxy m
             -> StrictTMVar m a
             -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)
             -> m ()
traceTMVarIO :: proxy m
-> StrictTMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> m ()
traceTMVarIO proxy m
p (StrictTMVar LazyTMVar m a
var) = proxy m
-> LazyTMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> m ()
Lazy.traceTMVarIO proxy m
p LazyTMVar m a
var

castStrictTMVar :: LazyTMVar m ~ LazyTMVar n
                => StrictTMVar m a -> StrictTMVar n a
castStrictTMVar :: StrictTMVar m a -> StrictTMVar n a
castStrictTMVar (StrictTMVar LazyTMVar m a
var) = LazyTMVar n a -> StrictTMVar n a
forall (m :: * -> *) a. LazyTMVar m a -> StrictTMVar m a
StrictTMVar LazyTMVar m a
LazyTMVar n a
var

newTMVar :: MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar :: a -> STM m (StrictTMVar m a)
newTMVar !a
a = LazyTMVar m a -> StrictTMVar m a
forall (m :: * -> *) a. LazyTMVar m a -> StrictTMVar m a
StrictTMVar (LazyTMVar m a -> StrictTMVar m a)
-> STM m (LazyTMVar m a) -> STM m (StrictTMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> STM m (LazyTMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TMVar m a)
Lazy.newTMVar a
a

newTMVarIO :: MonadSTM m => a -> m (StrictTMVar m a)
newTMVarIO :: a -> m (StrictTMVar m a)
newTMVarIO !a
a = LazyTMVar m a -> StrictTMVar m a
forall (m :: * -> *) a. LazyTMVar m a -> StrictTMVar m a
StrictTMVar (LazyTMVar m a -> StrictTMVar m a)
-> m (LazyTMVar m a) -> m (StrictTMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (LazyTMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
Lazy.newTMVarIO a
a

newTMVarM :: MonadSTM m => a -> m (StrictTMVar m a)
newTMVarM :: a -> m (StrictTMVar m a)
newTMVarM = a -> m (StrictTMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTMVar m a)
newTMVarIO
{-# DEPRECATED newTMVarM "Use newTVarIO" #-}

newEmptyTMVar :: MonadSTM m => STM m (StrictTMVar m a)
newEmptyTMVar :: STM m (StrictTMVar m a)
newEmptyTMVar = LazyTMVar m a -> StrictTMVar m a
forall (m :: * -> *) a. LazyTMVar m a -> StrictTMVar m a
StrictTMVar (LazyTMVar m a -> StrictTMVar m a)
-> STM m (LazyTMVar m a) -> STM m (StrictTMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (LazyTMVar m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TMVar m a)
Lazy.newEmptyTMVar

newEmptyTMVarIO :: MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarIO :: m (StrictTMVar m a)
newEmptyTMVarIO = LazyTMVar m a -> StrictTMVar m a
forall (m :: * -> *) a. LazyTMVar m a -> StrictTMVar m a
StrictTMVar (LazyTMVar m a -> StrictTMVar m a)
-> m (LazyTMVar m a) -> m (StrictTMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (LazyTMVar m a)
forall (m :: * -> *) a. MonadSTM m => m (TMVar m a)
Lazy.newEmptyTMVarIO

newEmptyTMVarM :: MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarM :: m (StrictTMVar m a)
newEmptyTMVarM = m (StrictTMVar m a)
forall (m :: * -> *) a. MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarIO
{-# DEPRECATED newEmptyTMVarM "Use newEmptyTMVarIO" #-}

takeTMVar :: MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar :: StrictTMVar m a -> STM m a
takeTMVar (StrictTMVar LazyTMVar m a
tmvar) = LazyTMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
Lazy.takeTMVar LazyTMVar m a
tmvar

tryTakeTMVar :: MonadSTM m => StrictTMVar m a -> STM m (Maybe a)
tryTakeTMVar :: StrictTMVar m a -> STM m (Maybe a)
tryTakeTMVar (StrictTMVar LazyTMVar m a
tmvar) = LazyTMVar m a -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
Lazy.tryTakeTMVar LazyTMVar m a
tmvar

putTMVar :: MonadSTM m => StrictTMVar m a -> a -> STM m ()
putTMVar :: StrictTMVar m a -> a -> STM m ()
putTMVar (StrictTMVar LazyTMVar m a
tmvar) !a
a = LazyTMVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
Lazy.putTMVar LazyTMVar m a
tmvar a
a

tryPutTMVar :: MonadSTM m => StrictTMVar m a -> a -> STM m Bool
tryPutTMVar :: StrictTMVar m a -> a -> STM m Bool
tryPutTMVar (StrictTMVar LazyTMVar m a
tmvar) !a
a = LazyTMVar m a -> a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m Bool
Lazy.tryPutTMVar LazyTMVar m a
tmvar a
a

readTMVar :: MonadSTM m => StrictTMVar m a -> STM m a
readTMVar :: StrictTMVar m a -> STM m a
readTMVar (StrictTMVar LazyTMVar m a
tmvar) = LazyTMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
Lazy.readTMVar LazyTMVar m a
tmvar

tryReadTMVar :: MonadSTM m => StrictTMVar m a -> STM m (Maybe a)
tryReadTMVar :: StrictTMVar m a -> STM m (Maybe a)
tryReadTMVar (StrictTMVar LazyTMVar m a
tmvar) = LazyTMVar m a -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
Lazy.tryReadTMVar LazyTMVar m a
tmvar

swapTMVar :: MonadSTM m => StrictTMVar m a -> a -> STM m a
swapTMVar :: StrictTMVar m a -> a -> STM m a
swapTMVar (StrictTMVar LazyTMVar m a
tmvar) !a
a = LazyTMVar m a -> a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m a
Lazy.swapTMVar LazyTMVar m a
tmvar a
a

isEmptyTMVar :: MonadSTM m => StrictTMVar m a -> STM m Bool
isEmptyTMVar :: StrictTMVar m a -> STM m Bool
isEmptyTMVar (StrictTMVar LazyTMVar m a
tmvar) = LazyTMVar m a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m Bool
Lazy.isEmptyTMVar LazyTMVar m a
tmvar

{-------------------------------------------------------------------------------
  Dealing with invariants
-------------------------------------------------------------------------------}

getInvariant :: StrictTVar m a -> a -> Maybe String
mkStrictTVar :: (a -> Maybe String) -> Lazy.TVar m a -> StrictTVar m a

-- | Check invariant (if enabled) before continuing
--
-- @checkInvariant mErr x@ is equal to @x@ if @mErr == Nothing@, and throws
-- an error @err@ if @mErr == Just err@.
--
-- This is exported so that other code that wants to conditionally check
-- invariants can reuse the same logic, rather than having to introduce new
-- per-package flags.
checkInvariant :: HasCallStack => Maybe String -> a -> a

#if CHECK_TVAR_INVARIANT
getInvariant StrictTVar {invariant} = invariant
mkStrictTVar invariant  tvar = StrictTVar {invariant, tvar}

checkInvariant Nothing    k = k
checkInvariant (Just err) _ = error $ "Invariant violation: " ++ err
#else
getInvariant :: StrictTVar m a -> a -> Maybe String
getInvariant StrictTVar m a
_               = \a
_ -> Maybe String
forall a. Maybe a
Nothing
mkStrictTVar :: (a -> Maybe String) -> TVar m a -> StrictTVar m a
mkStrictTVar a -> Maybe String
_invariant TVar m a
tvar = StrictTVar :: forall (m :: * -> *) a. LazyTVar m a -> StrictTVar m a
StrictTVar {TVar m a
tvar :: TVar m a
$sel:tvar:StrictTVar :: TVar m a
tvar}

checkInvariant :: Maybe String -> a -> a
checkInvariant Maybe String
_err       a
k  = a
k
#endif