{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Util.NormalForm.StrictTVar (
newTVar
, newTVarIO
, newTVarWithInvariant
, newTVarWithInvariantIO
, noThunksInvariant
, uncheckedNewTVarM
, module Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked
) where
import Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked hiding
(checkInvariant, newTVar, newTVarIO, newTVarWithInvariant,
newTVarWithInvariantIO)
import qualified Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked as Checked
import Control.Monad.Class.MonadSTM as StrictSTM
import GHC.Stack
import NoThunks.Class (NoThunks (..))
import Ouroboros.Consensus.Util.NormalForm.StrictMVar
(noThunksInvariant)
newTVar :: (HasCallStack, MonadSTM m, NoThunks a) => a -> STM m (StrictTVar m a)
newTVar :: forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
a -> STM m (StrictTVar m a)
newTVar = (a -> Maybe String) -> a -> STM m (StrictTVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
(a -> Maybe String) -> a -> STM m (StrictTVar m a)
Checked.newTVarWithInvariant a -> Maybe String
forall a. NoThunks a => a -> Maybe String
noThunksInvariant
newTVarIO :: (HasCallStack, MonadSTM m, NoThunks a) => a -> m (StrictTVar m a)
newTVarIO :: forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
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)
Checked.newTVarWithInvariantIO a -> Maybe String
forall a. NoThunks a => a -> Maybe String
noThunksInvariant
newTVarWithInvariant ::
(HasCallStack, MonadSTM m, NoThunks a)
=> (a -> Maybe String)
-> a
-> STM m (StrictTVar m a)
newTVarWithInvariant :: forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
(a -> Maybe String) -> a -> STM m (StrictTVar m a)
newTVarWithInvariant a -> Maybe String
inv =
(a -> Maybe String) -> a -> STM m (StrictTVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
(a -> Maybe String) -> a -> STM m (StrictTVar m a)
Checked.newTVarWithInvariant (\a
x -> a -> Maybe String
inv a
x Maybe String -> Maybe String -> Maybe String
forall a. Semigroup a => a -> a -> a
<> a -> Maybe String
forall a. NoThunks a => a -> Maybe String
noThunksInvariant a
x)
newTVarWithInvariantIO ::
(HasCallStack, MonadSTM m, NoThunks a)
=> (a -> Maybe String)
-> a
-> m (StrictTVar m a)
newTVarWithInvariantIO :: forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
(a -> Maybe String) -> a -> m (StrictTVar m a)
newTVarWithInvariantIO a -> Maybe String
inv =
(a -> Maybe String) -> a -> m (StrictTVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
(a -> Maybe String) -> a -> m (StrictTVar m a)
Checked.newTVarWithInvariantIO (\a
x -> a -> Maybe String
inv a
x Maybe String -> Maybe String -> Maybe String
forall a. Semigroup a => a -> a -> a
<> a -> Maybe String
forall a. NoThunks a => a -> Maybe String
noThunksInvariant a
x)
instance NoThunks a => NoThunks (StrictTVar IO a) where
showTypeOf :: Proxy (StrictTVar IO a) -> String
showTypeOf Proxy (StrictTVar IO a)
_ = String
"StrictTVar IO"
wNoThunks :: Context -> StrictTVar IO a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt StrictTVar IO a
tv = do
a
a <- StrictTVar IO a -> IO a
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar IO a
tv
Context -> a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt a
a
uncheckedNewTVarM :: MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM :: forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM = a -> m (StrictTVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
Checked.newTVarIO