{-# LANGUAGE BangPatterns #-}

module Bcc.Node.STM
  ( modifyReadTVar
  , modifyReadTVar'
  , modifyReadTVarIO
  , modifyReadTVarIO'
  ) where

import Data.Function
import Control.Monad
import System.IO (IO)

import qualified Control.Concurrent.STM as STM

-- | Mutate the contents of a TVar and return the new value of the TVar (non-strict).
modifyReadTVar :: STM.TVar a -> (a -> a) -> STM.STM a
modifyReadTVar :: TVar a -> (a -> a) -> STM a
modifyReadTVar TVar a
tv a -> a
f = do
  a
old <- TVar a -> STM a
forall a. TVar a -> STM a
STM.readTVar TVar a
tv
  let new :: a
new = a -> a
f a
old
  TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar a
tv a
new
  a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
new

-- | Mutate the contents of a TVar and return the new value of the TVar (strict).
modifyReadTVar' :: STM.TVar a -> (a -> a) -> STM.STM a
modifyReadTVar' :: TVar a -> (a -> a) -> STM a
modifyReadTVar' TVar a
tv a -> a
f = do
  a
old <- TVar a -> STM a
forall a. TVar a -> STM a
STM.readTVar TVar a
tv
  let !new :: a
new = a -> a
f a
old
  TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar a
tv a
new
  a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
new

-- | Mutate the contents of a TVar and return the new value of the TVar (non-strict).
modifyReadTVarIO :: STM.TVar a -> (a -> a) -> IO a
modifyReadTVarIO :: TVar a -> (a -> a) -> IO a
modifyReadTVarIO TVar a
tv a -> a
f = STM a -> IO a
forall a. STM a -> IO a
STM.atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ TVar a -> (a -> a) -> STM a
forall a. TVar a -> (a -> a) -> STM a
modifyReadTVar TVar a
tv a -> a
f

-- | Mutate the contents of a TVar and return the new value of the TVar (strict).
modifyReadTVarIO' :: STM.TVar a -> (a -> a) -> IO a
modifyReadTVarIO' :: TVar a -> (a -> a) -> IO a
modifyReadTVarIO' TVar a
tv a -> a
f = STM a -> IO a
forall a. STM a -> IO a
STM.atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ TVar a -> (a -> a) -> STM a
forall a. TVar a -> (a -> a) -> STM a
modifyReadTVar' TVar a
tv a -> a
f