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

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Types (StackStage(..), StageRIO, StageFrameRIO)
import Engine.Types qualified as Engine
import Engine.Vulkan.Types (Queues)
import Engine.StageSwitch (trySwitchStage)

import Engine.Stage.Bootstrap.Types (NoRendering(..), NoPipelines(..), NoResources(..), NoState(..))

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

bootstrapStage
  :: (a -> StackStage)
  -> Engine.StageSetupRIO a
  -> Engine.Stage NoRendering NoPipelines NoResources NoState
bootstrapStage :: forall a.
(a -> StackStage)
-> StageSetupRIO a
-> Stage NoRendering NoPipelines NoResources NoState
bootstrapStage a -> StackStage
handoff StageSetupRIO a
action = Stage :: forall rp p rr st a.
Text
-> (SwapchainResources -> ResourceT (StageRIO st) rp)
-> (SwapchainResources -> rp -> ResourceT (StageRIO st) p)
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, st)
-> (Queues CommandPool -> rp -> p -> ResourceT (StageRIO st) rr)
-> StageRIO st a
-> (st -> rr -> StageFrameRIO rp p rr st ())
-> (CommandBuffer
    -> rr -> ("image index" ::: Word32) -> StageFrameRIO rp p rr st ())
-> (a -> StageRIO st ())
-> Stage rp p rr st
Engine.Stage
  { $sel:sTitle:Stage :: Text
sTitle = Text
"Bootstrap"

  , $sel:sAllocateRP:Stage :: SwapchainResources
-> ResourceT (RIO (App GlobalHandles NoState)) NoRendering
sAllocateRP = SwapchainResources
-> ResourceT (RIO (App GlobalHandles NoState)) NoRendering
forall swapchain st.
swapchain -> ResourceT (StageRIO st) NoRendering
noRendering
  , $sel:sAllocateP:Stage :: SwapchainResources
-> NoRendering
-> ResourceT (RIO (App GlobalHandles NoState)) NoPipelines
sAllocateP  = SwapchainResources
-> NoRendering
-> ResourceT (RIO (App GlobalHandles NoState)) NoPipelines
forall swapchain st.
swapchain -> NoRendering -> ResourceT (StageRIO st) NoPipelines
noPipelines
  , $sel:sInitialRS:Stage :: StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState)
sInitialRS  = (a -> StackStage)
-> StageSetupRIO a
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState)
forall a.
(a -> StackStage)
-> StageSetupRIO a
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState)
transitState a -> StackStage
handoff StageSetupRIO a
action
  , $sel:sInitialRR:Stage :: Queues CommandPool
-> NoRendering
-> NoPipelines
-> ResourceT (RIO (App GlobalHandles NoState)) NoResources
sInitialRR  = Queues CommandPool
-> NoRendering
-> NoPipelines
-> ResourceT (RIO (App GlobalHandles NoState)) NoResources
forall renderPasses pipelines rs.
Queues CommandPool
-> renderPasses -> pipelines -> ResourceT (StageRIO rs) NoResources
noFrameResources

  , $sel:sBeforeLoop:Stage :: StageRIO NoState ()
sBeforeLoop     = () -> StageRIO NoState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , $sel:sUpdateBuffers:Stage :: NoState
-> NoResources
-> StageFrameRIO NoRendering NoPipelines NoResources NoState ()
sUpdateBuffers  = NoState
-> NoResources
-> StageFrameRIO NoRendering NoPipelines NoResources NoState ()
forall st rd rp p. st -> rd -> StageFrameRIO rp p rd st ()
noUpdates
  , $sel:sRecordCommands:Stage :: CommandBuffer
-> NoResources
-> ("image index" ::: Word32)
-> StageFrameRIO NoRendering NoPipelines NoResources NoState ()
sRecordCommands = CommandBuffer
-> NoResources
-> ("image index" ::: Word32)
-> StageFrameRIO NoRendering NoPipelines NoResources NoState ()
forall rd rp p st.
CommandBuffer
-> rd -> ("image index" ::: Word32) -> StageFrameRIO rp p rd st ()
noCommands
  , $sel:sAfterLoop:Stage :: () -> StageRIO NoState ()
sAfterLoop      = () -> StageRIO NoState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  }

noRendering :: swapchain -> ResourceT (StageRIO st) NoRendering
noRendering :: forall swapchain st.
swapchain -> ResourceT (StageRIO st) NoRendering
noRendering swapchain
_swapchain =
  NoRendering -> ResourceT (StageRIO st) NoRendering
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoRendering
NoRendering

noPipelines :: swapchain -> NoRendering -> ResourceT (StageRIO st) NoPipelines
noPipelines :: forall swapchain st.
swapchain -> NoRendering -> ResourceT (StageRIO st) NoPipelines
noPipelines swapchain
_swapchain NoRendering
NoRendering =
  NoPipelines -> ResourceT (StageRIO st) NoPipelines
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoPipelines
NoPipelines

noCommands
  :: Vk.CommandBuffer
  -> rd
  -> "image index" ::: Word32
  -> StageFrameRIO rp p rd st ()
noCommands :: forall rd rp p st.
CommandBuffer
-> rd -> ("image index" ::: Word32) -> StageFrameRIO rp p rd st ()
noCommands CommandBuffer
_cb rd
_rd "image index" ::: Word32
_index =
  () -> RIO (App GlobalHandles st, Frame rp p rd) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

noUpdates
  :: st
  -> rd
  -> StageFrameRIO rp p rd st ()
noUpdates :: forall st rd rp p. st -> rd -> StageFrameRIO rp p rd st ()
noUpdates st
_st rd
_rd =
  () -> RIO (App GlobalHandles st, Frame rp p rd) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

transitState
  :: (a -> StackStage)
  -> Engine.StageSetupRIO a
  -> Engine.StageSetupRIO (Resource.ReleaseKey, NoState)
transitState :: forall a.
(a -> StackStage)
-> StageSetupRIO a
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState)
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure (ReleaseKey
key, NoState
NoState)

noFrameResources
  :: Queues Vk.CommandPool
  -> renderPasses
  -> pipelines
  -> ResourceT (StageRIO rs) NoResources
noFrameResources :: forall renderPasses pipelines rs.
Queues CommandPool
-> renderPasses -> pipelines -> ResourceT (StageRIO rs) NoResources
noFrameResources Queues CommandPool
_queues renderPasses
_rp pipelines
_p =
  ((ReleaseKey, NoResources) -> NoResources)
-> ResourceT (StageRIO rs) (ReleaseKey, NoResources)
-> ResourceT (StageRIO rs) NoResources
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, NoResources) -> NoResources
forall a b. (a, b) -> b
snd (ResourceT (StageRIO rs) (ReleaseKey, NoResources)
 -> ResourceT (StageRIO rs) NoResources)
-> ResourceT (StageRIO rs) (ReleaseKey, NoResources)
-> ResourceT (StageRIO rs) NoResources
forall a b. (a -> b) -> a -> b
$!
    IO NoResources
-> (NoResources -> IO ())
-> ResourceT (StageRIO rs) (ReleaseKey, NoResources)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
      (NoResources -> IO NoResources
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoResources
NoResources)
      (\NoResources
NoResources -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())