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