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 :: m StageSwitchVar newStageSwitchVar = m StageSwitchVar forall (m :: * -> *) a. MonadIO m => m (TMVar a) newEmptyTMVarIO trySwitchStage :: NextStage -> StageRIO rs Bool trySwitchStage :: 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 :: 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