{-# 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
  a
a0 <- forall a. TVar a -> STM a
readTVar TVar a
tvar
  let (a
a1, b
b) = a -> (a, b)
f a
a0
  forall a. TVar a -> a -> STM ()
writeTVar TVar a
tvar a
a1
  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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (TChan a)
STM.newTChanIO