-- |
-- 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 :: forall (stm :: * -> *) a.
MonadSTM stm =>
TVar stm a -> (a -> a) -> stm ()
modifyTVar TVar stm a
ctvar a -> a
f = do
  a
a <- forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm a
ctvar
  forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm a
ctvar 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' :: forall (stm :: * -> *) a.
MonadSTM stm =>
TVar stm a -> (a -> a) -> stm ()
modifyTVar' TVar stm a
ctvar a -> a
f = do
  a
a <- forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm a
ctvar
  forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm a
ctvar 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 :: forall (stm :: * -> *) s a.
MonadSTM stm =>
TVar stm s -> (s -> (a, s)) -> stm a
stateTVar TVar stm s
var s -> (a, s)
f = do
   s
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
   forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm s
var s
s'
   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 :: forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm a
swapTVar TVar stm a
ctvar a
a = do
  a
old <- forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm a
ctvar
  forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm a
ctvar a
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 :: forall (m :: * -> *). MonadConc m => Int -> m (TVar (STM m) Bool)
registerDelay Int
delay = do
  TVar (STM m) Bool
var <- forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar Bool
False)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadConc m => Int -> m ()
threadDelay Int
delay
    forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar (STM m) Bool
var Bool
True)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure TVar (STM m) Bool
var