{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Util.NormalForm.StrictMVar (
newEmptyMVar
, newEmptyMVarWithInvariant
, newMVar
, newMVarWithInvariant
, noThunksInvariant
, uncheckedNewEmptyMVar
, uncheckedNewMVar
, module Control.Concurrent.Class.MonadMVar.Strict.Checked
) where
import Control.Concurrent.Class.MonadMVar (MonadInspectMVar (..))
import Control.Concurrent.Class.MonadMVar.Strict.Checked hiding
(newEmptyMVar, newEmptyMVarWithInvariant, newMVar,
newMVarWithInvariant)
import qualified Control.Concurrent.Class.MonadMVar.Strict.Checked as Checked
import Data.Proxy (Proxy (..))
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks (..), unsafeNoThunks)
newMVar :: (HasCallStack, MonadMVar m, NoThunks a) => a -> m (StrictMVar m a)
newMVar :: forall (m :: * -> *) a.
(HasCallStack, MonadMVar m, NoThunks a) =>
a -> m (StrictMVar m a)
newMVar = (a -> Maybe String) -> a -> m (StrictMVar m a)
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
(a -> Maybe String) -> a -> m (StrictMVar m a)
Checked.newMVarWithInvariant a -> Maybe String
forall a. NoThunks a => a -> Maybe String
noThunksInvariant
newEmptyMVar :: (MonadMVar m, NoThunks a) => m (StrictMVar m a)
newEmptyMVar :: forall (m :: * -> *) a.
(MonadMVar m, NoThunks a) =>
m (StrictMVar m a)
newEmptyMVar = (a -> Maybe String) -> m (StrictMVar m a)
forall (m :: * -> *) a.
MonadMVar m =>
(a -> Maybe String) -> m (StrictMVar m a)
Checked.newEmptyMVarWithInvariant a -> Maybe String
forall a. NoThunks a => a -> Maybe String
noThunksInvariant
newMVarWithInvariant ::
(HasCallStack, MonadMVar m, NoThunks a)
=> (a -> Maybe String)
-> a
-> m (StrictMVar m a)
newMVarWithInvariant :: forall (m :: * -> *) a.
(HasCallStack, MonadMVar m, NoThunks a) =>
(a -> Maybe String) -> a -> m (StrictMVar m a)
newMVarWithInvariant a -> Maybe String
inv =
(a -> Maybe String) -> a -> m (StrictMVar m a)
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
(a -> Maybe String) -> a -> m (StrictMVar m a)
Checked.newMVarWithInvariant (\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)
newEmptyMVarWithInvariant ::
(MonadMVar m, NoThunks a)
=> (a -> Maybe String)
-> m (StrictMVar m a)
newEmptyMVarWithInvariant :: forall (m :: * -> *) a.
(MonadMVar m, NoThunks a) =>
(a -> Maybe String) -> m (StrictMVar m a)
newEmptyMVarWithInvariant a -> Maybe String
inv =
(a -> Maybe String) -> m (StrictMVar m a)
forall (m :: * -> *) a.
MonadMVar m =>
(a -> Maybe String) -> m (StrictMVar m a)
Checked.newEmptyMVarWithInvariant (\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)
noThunksInvariant :: NoThunks a => a -> Maybe String
noThunksInvariant :: forall a. NoThunks a => a -> Maybe String
noThunksInvariant = (ThunkInfo -> String) -> Maybe ThunkInfo -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ThunkInfo -> String
forall a. Show a => a -> String
show (Maybe ThunkInfo -> Maybe String)
-> (a -> Maybe ThunkInfo) -> a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe ThunkInfo
forall a. NoThunks a => a -> Maybe ThunkInfo
unsafeNoThunks
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 IO a
mvar = do
Maybe a
aMay <- Proxy IO -> MVar IO a -> InspectMVarMonad IO (Maybe a)
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadInspectMVar m =>
proxy m -> MVar m a -> InspectMVarMonad m (Maybe a)
forall (proxy :: (* -> *) -> *) a.
proxy IO -> MVar IO a -> InspectMVarMonad IO (Maybe a)
inspectMVar (Proxy IO
forall {k} (t :: k). Proxy t
Proxy :: Proxy IO) (StrictMVar IO a -> MVar IO a
forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
toLazyMVar StrictMVar IO a
mvar)
Context -> Maybe a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Maybe a
aMay
uncheckedNewMVar :: MonadMVar m => a -> m (StrictMVar m a)
uncheckedNewMVar :: forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
uncheckedNewMVar = a -> m (StrictMVar m a)
forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
Checked.newMVar
uncheckedNewEmptyMVar :: MonadMVar m => m (StrictMVar m a)
uncheckedNewEmptyMVar :: forall (m :: * -> *) a. MonadMVar m => m (StrictMVar m a)
uncheckedNewEmptyMVar = m (StrictMVar m a)
forall (m :: * -> *) a. MonadMVar m => m (StrictMVar m a)
Checked.newEmptyMVar