{-# LANGUAGE PartialTypeSignatures #-}

-- | STM functions in MonadIO and custom functions like modifyTVarIO.
--
-- Why not lifted-stm of stm-lifted package?
--  - neither is in stackage
--  - only a few functions needed
module Hercules.Agent.STM
  ( module Hercules.Agent.STM,
    module Control.Concurrent.STM,
  )
where

import Control.Concurrent.STM (STM, TBQueue, TChan, TVar, readTVar, writeTVar)
import qualified Control.Concurrent.STM as STM
import Protolude hiding (atomically)

atomically :: MonadIO m => STM a -> m a
atomically :: forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (STM a -> IO a) -> STM a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM a -> IO a
forall a. STM a -> IO a
STM.atomically

readTVarIO :: MonadIO m => TVar a -> m a
readTVarIO :: forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (TVar a -> IO a) -> TVar a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar a -> IO a
forall a. TVar a -> IO a
STM.readTVarIO

newTVarIO :: MonadIO m => a -> m (TVar a)
newTVarIO :: forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO = IO (TVar a) -> m (TVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar a) -> m (TVar a))
-> (a -> IO (TVar a)) -> a -> m (TVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (TVar a)
forall a. a -> IO (TVar a)
STM.newTVarIO

-- | Drop-in replacement for atomicModifyIORef
modifyTVarIO :: MonadIO m => TVar a -> (a -> (a, b)) -> m b
modifyTVarIO :: forall (m :: * -> *) a b.
MonadIO m =>
TVar a -> (a -> (a, b)) -> m b
modifyTVarIO TVar a
tvar a -> (a, b)
f = STM b -> m b
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM b -> m b) -> STM b -> m b
forall a b. (a -> b) -> a -> b
$ do
  a
a0 <- TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
tvar
  let (a
a1, b
b) = a -> (a, b)
f a
a0
  TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar a
tvar a
a1
  b -> STM b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b

newTChanIO :: MonadIO m => m (TChan a)
newTChanIO :: forall (m :: * -> *) a. MonadIO m => m (TChan a)
newTChanIO = IO (TChan a) -> m (TChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TChan a)
forall a. IO (TChan a)
STM.newTChanIO