-- Register delay, API around `GHC.Conc.registerDelay`
--
-- The module should be imported qualified.
module Ouroboros.Network.RegisteredDelay where

import Control.Concurrent.Class.MonadSTM as LazySTM
import Control.Monad ((>=>))
import Control.Monad.Class.MonadTimer.SI
import Prelude hiding (read)

newtype RegisteredDelay m = RegisteredDelay { forall (m :: * -> *). RegisteredDelay m -> TVar m Bool
registeredDelayVar :: LazySTM.TVar m Bool }

new :: MonadTimer m
    => DiffTime
    -> m (RegisteredDelay m)
new :: forall (m :: * -> *).
MonadTimer m =>
DiffTime -> m (RegisteredDelay m)
new = (TVar m Bool -> RegisteredDelay m)
-> m (TVar m Bool) -> m (RegisteredDelay m)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TVar m Bool -> RegisteredDelay m
forall (m :: * -> *). TVar m Bool -> RegisteredDelay m
RegisteredDelay (m (TVar m Bool) -> m (RegisteredDelay m))
-> (DiffTime -> m (TVar m Bool))
-> DiffTime
-> m (RegisteredDelay m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay

read :: MonadSTM m
     => RegisteredDelay m
     -> STM m Bool
read :: forall (m :: * -> *). MonadSTM m => RegisteredDelay m -> STM m Bool
read = TVar m Bool -> STM m Bool
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
LazySTM.readTVar (TVar m Bool -> STM m Bool)
-> (RegisteredDelay m -> TVar m Bool)
-> RegisteredDelay m
-> STM m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisteredDelay m -> TVar m Bool
forall (m :: * -> *). RegisteredDelay m -> TVar m Bool
registeredDelayVar

await :: MonadSTM m
      => RegisteredDelay m
      -> STM m ()
await :: forall (m :: * -> *). MonadSTM m => RegisteredDelay m -> STM m ()
await = RegisteredDelay m -> STM m Bool
forall (m :: * -> *). MonadSTM m => RegisteredDelay m -> STM m Bool
read (RegisteredDelay m -> STM m Bool)
-> (Bool -> STM m ()) -> RegisteredDelay m -> STM m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> STM m ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check