content: -- |
  -- Module      : Control.Concurrent.Classy.STM.TVar
  -- Copyright   : (c) 2016 Michael Walker
  -- License     : MIT
  -- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
  -- Stability   : stable
  -- Portability : portable
  --
  -- Transactional variables, for use with 'MonadSTM'.
  --
  -- __Deviations:__ There is no @Eq@ instance for @MonadSTM@ the @TVar@
  -- type. Furthermore, the @newTVarIO@ and @mkWeakTVar@ functions are
  -- not provided.
  module Control.Concurrent.Classy.STM.TVar
    ( -- * @TVar@s
      TVar
    , newTVar
    , newTVarN
    , readTVar
    , readTVarConc
    , writeTVar
    , modifyTVar
    , modifyTVar'
    , stateTVar
    , swapTVar
    , registerDelay
    ) where
  
  import           Control.Monad.Conc.Class
  import           Control.Monad.STM.Class
  import           Data.Functor             (void)
  
  -- * @TVar@s
  
  -- | Mutate the contents of a 'TVar'. This is non-strict.
  --
  -- @since 1.0.0.0
  modifyTVar :: MonadSTM stm => TVar stm a -> (a -> a) -> stm ()
  modifyTVar ctvar f = do
    a <- readTVar ctvar
    writeTVar ctvar $ f a
  
  -- | Mutate the contents of a 'TVar' strictly.
  --
  -- @since 1.0.0.0
  modifyTVar' :: MonadSTM stm => TVar stm a -> (a -> a) -> stm ()
  modifyTVar' ctvar f = do
    a <- readTVar ctvar
    writeTVar ctvar $! f a
  
  -- | Like 'modifyTVar'' but the function is a simple state transition that can
  -- return a side value which is passed on as the result of the STM.
  --
  -- @since 1.6.1.0
  stateTVar :: MonadSTM stm => TVar stm s -> (s -> (a, s)) -> stm a
  stateTVar var f = do
     s <- readTVar var
     let (a, s') = f s -- since we destructure this, we are strict in f
     writeTVar var s'
     pure a
  
  -- | Swap the contents of a 'TVar', returning the old value.
  --
  -- @since 1.0.0.0
  swapTVar :: MonadSTM stm => TVar stm a -> a -> stm a
  swapTVar ctvar a = do
    old <- readTVar ctvar
    writeTVar ctvar a
    pure old
  
  -- | Set the value of returned 'TVar' to @True@ after a given number
  -- of microseconds. The caveats associated with 'threadDelay' also
  -- apply.
  --
  -- @since 1.0.0.0
  registerDelay :: MonadConc m => Int -> m (TVar (STM m) Bool)
  registerDelay delay = do
    var <- atomically (newTVar False)
    void . fork $ do
      threadDelay delay
      atomically (writeTVar var True)
    pure var
  