-- |
-- 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 :: TVar stm a -> (a -> a) -> stm ()
modifyTVar TVar stm a
ctvar a -> a
f = do
  a
a <- TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm a
ctvar
  TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm a
ctvar (a -> stm ()) -> a -> stm ()
forall a b. (a -> b) -> a -> b
$ a -> a
f a
a

-- | Mutate the contents of a 'TVar' strictly.
--
-- @since 1.0.0.0
modifyTVar' :: MonadSTM stm => TVar stm a -> (a -> a) -> stm ()
modifyTVar' :: TVar stm a -> (a -> a) -> stm ()
modifyTVar' TVar stm a
ctvar a -> a
f = do
  a
a <- TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm a
ctvar
  TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm a
ctvar (a -> stm ()) -> a -> stm ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
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 :: TVar stm s -> (s -> (a, s)) -> stm a
stateTVar TVar stm s
var s -> (a, s)
f = do
   s
s <- TVar stm s -> stm s
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm s
var
   let (a
a, s
s') = s -> (a, s)
f s
s -- since we destructure this, we are strict in f
   TVar stm s -> s -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm s
var s
s'
   a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 :: TVar stm a -> a -> stm a
swapTVar TVar stm a
ctvar a
a = do
  a
old <- TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm a
ctvar
  TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm a
ctvar a
a
  a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 :: Int -> m (TVar (STM m) Bool)
registerDelay Int
delay = do
  TVar (STM m) Bool
var <- STM m (TVar (STM m) Bool) -> m (TVar (STM m) Bool)
forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (Bool -> STM m (TVar (STM m) Bool)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar Bool
False)
  m (ThreadId m) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (ThreadId m) -> m ())
-> (m () -> m (ThreadId m)) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (ThreadId m)
forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Int -> m ()
forall (m :: * -> *). MonadConc m => Int -> m ()
threadDelay Int
delay
    STM m () -> m ()
forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (TVar (STM m) Bool -> Bool -> STM m ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar (STM m) Bool
var Bool
True)
  TVar (STM m) Bool -> m (TVar (STM m) Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TVar (STM m) Bool
var