module Engine.StageSwitch
  ( StageSwitchVar
  , newStageSwitchVar

  , StageSwitch(..)
  , trySwitchStage
  , trySwitchStageSTM
  , getNextStage
  ) where

import RIO

import RIO.App (appEnv)

import Engine.Types (NextStage, StageRIO, StageSwitch(..), StageSwitchVar)
import Engine.Types qualified as Engine

newStageSwitchVar :: MonadIO m => m StageSwitchVar
newStageSwitchVar :: forall (m :: * -> *). MonadIO m => m StageSwitchVar
newStageSwitchVar = forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO

trySwitchStage :: NextStage -> StageRIO rs Bool
trySwitchStage :: forall rs. NextStage -> StageRIO rs Bool
trySwitchStage NextStage
nextStage = do
  StageSwitchVar
var <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ GlobalHandles -> StageSwitchVar
Engine.ghStageSwitch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env st. App env st -> env
appEnv
  forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ StageSwitchVar -> NextStage -> STM Bool
trySwitchStageSTM StageSwitchVar
var NextStage
nextStage

trySwitchStageSTM :: StageSwitchVar -> NextStage -> STM Bool
trySwitchStageSTM :: StageSwitchVar -> NextStage -> STM Bool
trySwitchStageSTM StageSwitchVar
switchVar = forall a. TMVar a -> a -> STM Bool
tryPutTMVar StageSwitchVar
switchVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextStage -> StageSwitch
StageSwitchPending

getNextStage :: StageRIO rs (Maybe NextStage)
getNextStage :: forall rs. StageRIO rs (Maybe NextStage)
getNextStage = do
  StageSwitchVar
var <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ GlobalHandles -> StageSwitchVar
Engine.ghStageSwitch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env st. App env st -> env
appEnv
  forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically do
    Bool
noSwitch <- forall a. TMVar a -> STM Bool
isEmptyTMVar StageSwitchVar
var
    if Bool
noSwitch then
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    else
      forall a. TMVar a -> STM a
takeTMVar StageSwitchVar
var forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        StageSwitchPending NextStage
nextStage -> do
          forall a. TMVar a -> a -> STM ()
putTMVar StageSwitchVar
var StageSwitch
StageSwitchHandled
          pure $ forall a. a -> Maybe a
Just NextStage
nextStage
        StageSwitch
StageSwitchHandled ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing