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