module Engine.Stage.Bootstrap.Setup
  ( stackStage
  , bootstrapStage
  ) where

import RIO

import UnliftIO.Resource qualified as Resource

import Engine.Stage.Component qualified as Stage
import Engine.Types (StackStage(..))
import Engine.Types qualified as Engine
import Engine.StageSwitch (trySwitchStage)

stackStage
  :: (a -> StackStage)
  -> Engine.StageSetupRIO a
  -> StackStage
stackStage :: forall a. (a -> StackStage) -> StageSetupRIO a -> StackStage
stackStage a -> StackStage
handoff StageSetupRIO a
action = Stage NoRenderPass NoPipelines NoFrameResources NoRunState
-> StackStage
forall rp p rr st. RenderPass rp => Stage rp p rr st -> StackStage
StackStage (Stage NoRenderPass NoPipelines NoFrameResources NoRunState
 -> StackStage)
-> Stage NoRenderPass NoPipelines NoFrameResources NoRunState
-> StackStage
forall a b. (a -> b) -> a -> b
$ (a -> StackStage)
-> StageSetupRIO a
-> Stage NoRenderPass NoPipelines NoFrameResources NoRunState
forall a.
(a -> StackStage)
-> StageSetupRIO a
-> Stage NoRenderPass NoPipelines NoFrameResources NoRunState
bootstrapStage a -> StackStage
handoff StageSetupRIO a
action

bootstrapStage
  :: (a -> StackStage)
  -> Engine.StageSetupRIO a
  -> Engine.Stage Stage.NoRenderPass Stage.NoPipelines Stage.NoFrameResources Stage.NoRunState
bootstrapStage :: forall a.
(a -> StackStage)
-> StageSetupRIO a
-> Stage NoRenderPass NoPipelines NoFrameResources NoRunState
bootstrapStage a -> StackStage
handoff StageSetupRIO a
action = Text
-> Rendering NoRenderPass NoPipelines NoRunState
-> Resources NoRenderPass NoPipelines NoRunState NoFrameResources
-> Maybe
     (Scene NoRenderPass NoPipelines NoRunState NoFrameResources)
-> Stage NoRenderPass NoPipelines NoFrameResources NoRunState
forall (t :: * -> *) rp p st rr.
Foldable t =>
Text
-> Rendering rp p st
-> Resources rp p st rr
-> t (Scene rp p st rr)
-> Stage rp p rr st
Stage.assemble Text
"Bootstrap" Rendering NoRenderPass NoPipelines NoRunState
forall st. NoRendering st
Stage.noRendering Resources NoRenderPass NoPipelines NoRunState NoFrameResources
resources Maybe (Scene NoRenderPass NoPipelines NoRunState NoFrameResources)
forall a. Maybe a
Nothing
  where
    resources :: Resources NoRenderPass NoPipelines NoRunState NoFrameResources
resources = Resources NoRenderPass NoPipelines NoRunState NoFrameResources
forall rp p. NoResources rp p
Stage.noResources
      { $sel:rInitialRS:Resources :: StageRIO (Maybe SwapchainResources) (ReleaseKey, NoRunState)
Stage.rInitialRS =
          (a -> StackStage)
-> StageSetupRIO a
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoRunState)
forall a.
(a -> StackStage)
-> StageSetupRIO a
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoRunState)
transitState a -> StackStage
handoff StageSetupRIO a
action
      }

transitState
  :: (a -> StackStage)
  -> Engine.StageSetupRIO a
  -> Engine.StageSetupRIO (Resource.ReleaseKey, Stage.NoRunState)
transitState :: forall a.
(a -> StackStage)
-> StageSetupRIO a
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoRunState)
transitState a -> StackStage
handoff StageSetupRIO a
action = do
  a
res <- StageSetupRIO a
action

  Bool
switched <- NextStage -> StageRIO (Maybe SwapchainResources) Bool
forall rs. NextStage -> StageRIO rs Bool
trySwitchStage (NextStage -> StageRIO (Maybe SwapchainResources) Bool)
-> (StackStage -> NextStage)
-> StackStage
-> StageRIO (Maybe SwapchainResources) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackStage -> NextStage
Engine.Replace (StackStage -> StageRIO (Maybe SwapchainResources) Bool)
-> StackStage -> StageRIO (Maybe SwapchainResources) Bool
forall a b. (a -> b) -> a -> b
$
    a -> StackStage
handoff a
res

  Bool
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ()
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
switched (RIO (App GlobalHandles (Maybe SwapchainResources)) ()
 -> RIO (App GlobalHandles (Maybe SwapchainResources)) ())
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ()
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ()
forall a b. (a -> b) -> a -> b
$
    Utf8Builder
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"Bootstrap switch failed"

  ReleaseKey
key <- IO ()
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (IO ()
 -> RIO (App GlobalHandles (Maybe SwapchainResources)) ReleaseKey)
-> IO ()
-> RIO (App GlobalHandles (Maybe SwapchainResources)) ReleaseKey
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure (ReleaseKey
key, NoRunState
Stage.NoRunState)