{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}

{- |
  All the provided render passes and pipelines packaged and delivered.
-}

module Render.Basic where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Data.Kind (Type)
import Data.Tagged (Tagged(..))
import Data.Type.Equality (type (~))
import RIO.FilePath ((</>), (<.>))
import RIO.Vector.Partial as Vector (headM)
import Vulkan.Core10 qualified as Vk
import Vulkan.Zero (Zero(..))

-- keid-core

import Engine.Stage.Component qualified as Stage
import Engine.Types (StageRIO)
import Engine.Types qualified as Engine
import Engine.Vulkan.Pipeline qualified as Pipeline
import Engine.Vulkan.Pipeline.External (type (^))
import Engine.Vulkan.Pipeline.External qualified as External
import Engine.Vulkan.Pipeline.Graphics qualified as Graphics
import Engine.Vulkan.Shader qualified as Shader
import Engine.Vulkan.Swapchain qualified as Swapchain
import Engine.Vulkan.Types (DsLayoutBindings, HasSwapchain, HasVulkan, RenderPass(..))

-- keid-render-basic

import Render.Debug.Pipeline qualified as Debug
import Render.DepthOnly.Pipeline qualified as DepthOnly
import Render.DescSets.Set0 (Scene)
import Render.DescSets.Set0 qualified as Scene
import Render.DescSets.Sun (Sun)
import Render.DescSets.Sun qualified as Sun
import Render.Font.EvanwSdf.Pipeline qualified as EvanwSdf
import Render.ForwardMsaa (ForwardMsaa)
import Render.ForwardMsaa qualified as ForwardMsaa
import Render.Lit.Colored.Pipeline qualified as LitColored
import Render.Lit.Material.Pipeline qualified as LitMaterial
import Render.Lit.Textured.Pipeline qualified as LitTextured
import Render.Samplers qualified as Samplers
import Render.ShadowMap.Pipeline qualified as ShadowPipe
import Render.ShadowMap.RenderPass (ShadowMap)
import Render.ShadowMap.RenderPass qualified as ShadowPass
import Render.Skybox.Pipeline qualified as Skybox
import Render.Unlit.Colored.Pipeline qualified as UnlitColored
import Render.Unlit.Line2d.Pipeline qualified as UnlitLine2d
import Render.Unlit.Sprite.Pipeline qualified as UnlitSprite
import Render.Unlit.Textured.Pipeline qualified as UnlitTextured
import Render.Unlit.TileMap.Pipeline qualified as UnlitTileMap

type Stage = Engine.Stage RenderPasses Pipelines
type Frame = Engine.Frame RenderPasses Pipelines
type StageFrameRIO r s a = Engine.StageFrameRIO RenderPasses Pipelines r s a

-- |  Basic rendering component without any extensions.
type Rendering = Stage.Rendering RenderPasses Pipelines

-- |  Basic rendering component without any extensions and resources.
rendering_ :: Rendering st
rendering_ = Stage.Rendering
  { rAllocateRP = allocate_
  , rAllocateP = allocatePipelines_
  }

data RenderPasses = RenderPasses
  { rpForwardMsaa :: ForwardMsaa
  , rpShadowPass  :: ShadowMap
  }

instance RenderPass RenderPasses where
  updateRenderpass swapchain RenderPasses{..} = RenderPasses
    <$> ForwardMsaa.updateMsaa swapchain rpForwardMsaa
    <*> pure rpShadowPass -- XXX: not a screen pass

  refcountRenderpass RenderPasses{..} = do
    refcountRenderpass rpForwardMsaa
    refcountRenderpass rpShadowPass

data Settings = Settings
  { sShadowSize   :: Word32
  , sShadowLayers :: Word32
  }
  deriving (Eq, Show)

instance Zero Settings where
  zero = Settings
    -- XXX: 1x1 placeholder image
    { sShadowSize   = 1
    , sShadowLayers = 1
    }

allocate
  :: ( HasSwapchain swapchain
     , HasLogFunc env
     , HasVulkan env
     )
  => Settings
  -> swapchain
  -> ResourceT (RIO env) RenderPasses
allocate Settings{..} swapchain = do
  rpForwardMsaa <- ForwardMsaa.allocateMsaa swapchain

  rpShadowPass <- ShadowPass.allocate
    swapchain
    sShadowSize
    sShadowLayers

  pure RenderPasses{..}

allocate_
  :: ( HasSwapchain swapchain
     , HasLogFunc env
     , HasVulkan env
     )
  => swapchain
  -> ResourceT (RIO env) RenderPasses
allocate_ = allocate zero

type Pipelines = PipelinesF Identity
type PipelineObservers = PipelinesF External.Observers
type PipelineWorkers = PipelinesF External.ConfigureGraphics

data PipelinesF (f :: Type -> Type) = Pipelines
  { pMSAA       :: Vk.SampleCountFlagBits
  , pSceneBinds :: Tagged Scene DsLayoutBindings
  , pSceneLayout :: Tagged '[Scene] Vk.DescriptorSetLayout

  , pShadowBinds :: Tagged Sun DsLayoutBindings
  , pShadowLayout :: Tagged '[Sun] Vk.DescriptorSetLayout

  , pEvanwSdf :: f ^ EvanwSdf.Pipeline
  , pSkybox   :: f ^ Skybox.Pipeline

  , pDebugUV      :: f ^ Debug.Pipeline
  , pDebugTexture :: f ^ Debug.Pipeline
  , pDebugShadow  :: f ^ Debug.Pipeline

  , pDepthOnly :: f ^ DepthOnly.Pipeline

  , pLitColored       :: f ^ LitColored.Pipeline
  , pLitColoredBlend  :: f ^ LitColored.Pipeline
  , pLitMaterial      :: f ^ LitMaterial.Pipeline
  , pLitMaterialBlend :: f ^ LitMaterial.Pipeline
  , pLitTextured      :: f ^ LitTextured.Pipeline
  , pLitTexturedBlend :: f ^ LitTextured.Pipeline

  , pUnlitColored        :: f ^ UnlitColored.Pipeline
  , pUnlitColoredNoDepth :: f ^ UnlitColored.Pipeline
  , pUnlitTextured       :: f ^ UnlitTextured.Pipeline
  , pUnlitTexturedBlend  :: f ^ UnlitTextured.Pipeline

  , pLine2d        :: f ^ UnlitLine2d.Pipeline
  , pLine2dNoDepth :: f ^ UnlitLine2d.Pipeline

  , pSprite              :: f ^ UnlitSprite.Pipeline
  , pSpriteOutline       :: f ^ UnlitSprite.Pipeline
  , pTileMap             :: f ^ UnlitTileMap.Pipeline
  , pTileMapBlend        :: f ^ UnlitTileMap.Pipeline
  , pWireframe           :: f ^ UnlitColored.Pipeline
  , pWireframeNoDepth    :: f ^ UnlitColored.Pipeline

  , pShadowCast :: f ^ ShadowPipe.Pipeline
  }

allocatePipelines_
  :: HasSwapchain swapchain
  => swapchain
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines_ =
  allocatePipelinesFor Nothing Nothing

allocatePipelinesFor
  :: ( HasSwapchain swapchain
     , Foldable textures
     , Foldable cubes
     )
  => textures t
  -> cubes c
  -> swapchain
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelinesFor textures cubes swapchain renderpasses = do
  samplers <- Samplers.allocate (Swapchain.getAnisotropy swapchain)

  allocatePipelines
    (Scene.mkBindings samplers textures cubes shadows)
    (Swapchain.getMultisample swapchain)
    renderpasses
  where
    shadows = renderpasses.rpShadowPass.smLayerCount

allocatePipelines
  :: Tagged Scene DsLayoutBindings
  -> Vk.SampleCountFlagBits
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines pSceneBinds pMSAA RenderPasses{..} = do
  pEvanwSdf <- EvanwSdf.allocate pMSAA pSceneBinds rpForwardMsaa
  pSkybox   <- Skybox.allocate pMSAA pSceneBinds rpForwardMsaa

  pDebugUV      <- Debug.allocate Debug.UV         pMSAA pSceneBinds rpForwardMsaa
  pDebugTexture <- Debug.allocate Debug.Texture    pMSAA pSceneBinds rpForwardMsaa
  pDebugShadow  <- Debug.allocate (Debug.Shadow 1) pMSAA pSceneBinds rpForwardMsaa

  pDepthOnly <- DepthOnly.allocate pMSAA pSceneBinds rpForwardMsaa

  pLitColored       <- LitColored.allocate pMSAA pSceneBinds rpForwardMsaa
  pLitColoredBlend  <- LitColored.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pLitMaterial      <- LitMaterial.allocate pMSAA pSceneBinds rpForwardMsaa
  pLitMaterialBlend <- LitMaterial.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pLitTextured      <- LitTextured.allocate pMSAA pSceneBinds rpForwardMsaa
  pLitTexturedBlend <- LitTextured.allocateBlend pMSAA pSceneBinds rpForwardMsaa

  pLine2d              <- UnlitLine2d.allocate True pMSAA pSceneBinds rpForwardMsaa
  pLine2dNoDepth       <- UnlitLine2d.allocate False pMSAA pSceneBinds rpForwardMsaa
  pSprite              <- UnlitSprite.allocate pMSAA Nothing False pSceneBinds rpForwardMsaa
  pSpriteOutline       <- UnlitSprite.allocate pMSAA Nothing True pSceneBinds rpForwardMsaa
  pTileMap             <- UnlitTileMap.allocate pMSAA pSceneBinds rpForwardMsaa
  pTileMapBlend        <- UnlitTileMap.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pUnlitColored        <- UnlitColored.allocate True pMSAA pSceneBinds rpForwardMsaa
  pUnlitColoredNoDepth <- UnlitColored.allocate False pMSAA pSceneBinds rpForwardMsaa
  pUnlitTextured       <- UnlitTextured.allocate pMSAA pSceneBinds rpForwardMsaa
  pUnlitTexturedBlend  <- UnlitTextured.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pWireframe           <- UnlitColored.allocateWireframe True pMSAA pSceneBinds rpForwardMsaa
  pWireframeNoDepth    <- UnlitColored.allocateWireframe False pMSAA pSceneBinds rpForwardMsaa

  let pShadowBinds = Sun.set0
  pShadowCast <- ShadowPipe.allocate pShadowBinds rpShadowPass ShadowPipe.defaults

  let
    pSceneLayout =
      case Vector.headM (unTagged $ Pipeline.pDescLayouts pLitColored) of
        Nothing ->
          error "pLitColored has at least set0 in layout"
        Just set0layout ->
          Tagged set0layout

    pShadowLayout =
      case Vector.headM (unTagged $ Pipeline.pDescLayouts pShadowCast) of
        Nothing ->
          error "pShadowCast has at least set0 in layout"
        Just set0layout ->
          Tagged set0layout

  pure Pipelines{..}

allocateWorkers
  :: Tagged Scene DsLayoutBindings
  -> Vk.SampleCountFlagBits
  -> RenderPasses
  -> ResourceT (StageRIO st) PipelineWorkers
allocateWorkers sceneBinds pMSAA renderPasses = do
  builtin <- allocatePipelines sceneBinds pMSAA renderPasses

  let
    evanwSdfFiles =
      Graphics.basicStages
        (shaderDir </> "evanw-sdf" <.> "vert" <.> "spv")
        (shaderDir </> "evanw-sdf" <.> "frag" <.> "spv")

  evanwSdfWorker <-
    External.spawnReflect "evanw-sdf" evanwSdfFiles \(stageCode, reflect) ->
      (EvanwSdf.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    skyboxFiles =
      Graphics.basicStages
        (shaderDir </> "skybox" <.> "vert" <.> "spv")
        (shaderDir </> "skybox" <.> "frag" <.> "spv")

  skyboxWorker <-
    External.spawnReflect "skybox" skyboxFiles \(stageCode, reflect) ->
      (Skybox.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    debugFiles =
      Graphics.basicStages
        (shaderDir </> "debug" <.> "vert" <.> "spv")
        (shaderDir </> "debug" <.> "frag" <.> "spv")

  debugUVWorker <-
    External.spawnReflect "debug-uv" debugFiles \(stageCode, reflect) ->
      (Debug.config Debug.UV sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  debugTextureWorker <-
    External.spawnReflect "debug-texture" debugFiles \(stageCode, reflect) ->
      (Debug.config Debug.Texture sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  debugShadowWorker <-
    External.spawnReflect "debug-shadow" debugFiles \(stageCode, reflect) ->
      (Debug.config (Debug.Shadow 1) sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    depthOnlyFiles = Graphics.vertexOnly
      (shaderDir </> "depth-only" <.> "vert" <.> "spv")

  depthOnlyWorker <-
    External.spawnReflect "debug" depthOnlyFiles \(stageCode, reflect) ->
      (DepthOnly.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    litColoredFiles =
      Graphics.basicStages
        (shaderDir </> "lit-colored" <.> "vert" <.> "spv")
        (shaderDir </> "lit-colored" <.> "frag" <.> "spv")

  litColoredWorker <-
    External.spawnReflect "lit-colored" litColoredFiles \(stageCode, reflect) ->
      (LitColored.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  litColoredBlendWorker <-
    External.spawnReflect "lit-colored-blend" litColoredFiles \(stageCode, reflect) ->
      (LitColored.configBlend sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    litMaterialFiles =
      Graphics.basicStages
        (shaderDir </> "lit-material" <.> "vert" <.> "spv")
        (shaderDir </> "lit-material" <.> "frag" <.> "spv")

  litMaterialWorker <-
    External.spawnReflect "lit-material" litMaterialFiles \(stageCode, reflect) ->
      (LitMaterial.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  litMaterialBlendWorker <-
    External.spawnReflect "lit-material-blend" litMaterialFiles \(stageCode, reflect) ->
      (LitMaterial.configBlend sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    litTexturedFiles =
      Graphics.basicStages
        (shaderDir </> "lit-textured" <.> "vert" <.> "spv")
        (shaderDir </> "lit-textured" <.> "frag" <.> "spv")

  litTexturedWorker <-
    External.spawnReflect "lit-textured" litTexturedFiles \(stageCode, reflect) ->
      (LitTextured.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  litTexturedBlendWorker <-
    External.spawnReflect "lit-textured-blend" litTexturedFiles \(stageCode, reflect) ->
      (LitTextured.configBlend sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    line2dFiles =
      Graphics.basicStages
        (shaderDir </> "line-2d" <.> "vert" <.> "spv")
        (shaderDir </> "line-2d" <.> "frag" <.> "spv")

  line2dWorker <-
    External.spawnReflect "unlit-colored" line2dFiles \(stageCode, reflect) ->
      (UnlitLine2d.config True sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  line2dNoDepthWorker <-
    External.spawnReflect "unlit-colored-nodepth" line2dFiles \(stageCode, reflect) ->
      (UnlitLine2d.config False sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    unlitColoredFiles =
      Graphics.basicStages
        (shaderDir </> "unlit-colored" <.> "vert" <.> "spv")
        (shaderDir </> "unlit-colored" <.> "frag" <.> "spv")

  unlitColoredWorker <-
    External.spawnReflect "unlit-colored" unlitColoredFiles \(stageCode, reflect) ->
      (UnlitColored.config True sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  unlitColoredNoDepthWorker <-
    External.spawnReflect "unlit-colored-nodepth" unlitColoredFiles \(stageCode, reflect) ->
      (UnlitColored.config False sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    unlitTexturedFiles =
      Graphics.basicStages
        (shaderDir </> "unlit-textured" <.> "vert" <.> "spv")
        (shaderDir </> "unlit-textured" <.> "frag" <.> "spv")

  unlitTexturedWorker <-
    External.spawnReflect "unlit-textured" unlitTexturedFiles \(stageCode, reflect) ->
      (UnlitTextured.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  unlitTexturedBlendWorker <-
    External.spawnReflect "unlit-textured" unlitTexturedFiles \(stageCode, reflect) ->
      (UnlitTextured.configBlend sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    spriteFiles =
      Graphics.basicStages
        (shaderDir </> "sprite" <.> "vert" <.> "spv")
        (shaderDir </> "sprite" <.> "frag" <.> "spv")

  spriteWorker <-
    External.spawnReflect "sprite" spriteFiles \(stageCode, reflect) ->
      (UnlitSprite.config Nothing False sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  spriteOutlineWorker <-
    External.spawnReflect "sprite" spriteFiles \(stageCode, reflect) ->
      (UnlitSprite.config Nothing True sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    tileMapFiles =
      Graphics.basicStages
        (shaderDir </> "tilemap" <.> "vert" <.> "spv")
        (shaderDir </> "tilemap" <.> "frag" <.> "spv")

  tileMapWorker <-
    External.spawnReflect "tilemap" tileMapFiles \(stageCode, reflect) ->
      (UnlitTileMap.config sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  tileMapBlendWorker <-
    External.spawnReflect "tilemap" tileMapFiles \(stageCode, reflect) ->
      (UnlitTileMap.configBlend sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  wireframeWorker <-
    External.spawnReflect "wireframe" unlitColoredFiles \(stageCode, reflect) ->
      (UnlitColored.configWireframe True sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  wireframeNoDepthWorker <-
    External.spawnReflect "wireframe-nodepth" unlitColoredFiles \(stageCode, reflect) ->
      (UnlitColored.configWireframe False sceneBinds)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  let
    shadowCastFiles =
      Graphics.vertexOnly
        (shaderDir </> "shadow-cast" <.> "vert" <.> "spv")

  shadowCastWorker <-
    External.spawnReflect "shadow-cast" shadowCastFiles \(stageCode, reflect) ->
      (ShadowPipe.config (pShadowBinds builtin) ShadowPipe.defaults)
        { Graphics.cStages = stageCode
        , Graphics.cReflect = Just reflect
        }

  pure builtin
    { pEvanwSdf = evanwSdfWorker
    , pSkybox = skyboxWorker
    , pDebugUV = debugUVWorker
    , pDebugTexture = debugTextureWorker
    , pDebugShadow = debugShadowWorker
    , pDepthOnly = depthOnlyWorker
    , pLitColored = litColoredWorker
    , pLitColoredBlend = litColoredBlendWorker
    , pLitMaterial = litMaterialWorker
    , pLitMaterialBlend = litMaterialBlendWorker
    , pLitTextured = litTexturedWorker
    , pLitTexturedBlend = litTexturedBlendWorker
    , pLine2d = line2dWorker
    , pLine2dNoDepth = line2dNoDepthWorker
    , pUnlitColored = unlitColoredWorker
    , pUnlitColoredNoDepth = unlitColoredNoDepthWorker
    , pUnlitTextured = unlitTexturedWorker
    , pUnlitTexturedBlend = unlitTexturedBlendWorker
    , pSprite = spriteWorker
    , pSpriteOutline = spriteOutlineWorker
    , pTileMap = tileMapWorker
    , pTileMapBlend = tileMapBlendWorker
    , pWireframe = wireframeWorker
    , pWireframeNoDepth = wireframeNoDepthWorker
    , pShadowCast = shadowCastWorker
    }

allocateObservers
  :: RenderPasses
  -> PipelineWorkers
  -> ResourceT (Engine.StageRIO rs) PipelineObservers
allocateObservers renderPasses Pipelines{..} = do
  evanwSdfExt <- External.newObserverGraphics
    forward
    pMSAA
    pEvanwSdf

  skyboxExt <- External.newObserverGraphics
    forward
    pMSAA
    pSkybox

  debugUVExt <- External.newObserverGraphics
    forward
    pMSAA
    pDebugUV

  debugTextureExt <- External.newObserverGraphics
    forward
    pMSAA
    pDebugTexture

  debugShadowExt <- External.newObserverGraphics
    forward
    pMSAA
    pDebugShadow

  depthOnlyExt <- External.newObserverGraphics
    forward
    pMSAA
    pDepthOnly

  litColoredExt <- External.newObserverGraphics
    forward
    pMSAA
    pLitColored

  litColoredBlendExt <- External.newObserverGraphics
    forward
    pMSAA
    pLitColoredBlend

  litMaterialExt <- External.newObserverGraphics
    forward
    pMSAA
    pLitMaterial

  litMaterialBlendExt <- External.newObserverGraphics
    forward
    pMSAA
    pLitMaterialBlend

  litTexturedExt <- External.newObserverGraphics
    forward
    pMSAA
    pLitTextured

  litTexturedBlendExt <- External.newObserverGraphics
    forward
    pMSAA
    pLitTexturedBlend

  line2dExt <- External.newObserverGraphics
    forward
    pMSAA
    pLine2d

  line2dNoDepthExt <- External.newObserverGraphics
    forward
    pMSAA
    pLine2dNoDepth

  unlitColoredExt <- External.newObserverGraphics
    forward
    pMSAA
    pUnlitColored

  unlitColoredNoDepthExt <- External.newObserverGraphics
    forward
    pMSAA
    pUnlitColoredNoDepth

  unlitTexturedExt <- External.newObserverGraphics
    forward
    pMSAA
    pUnlitTextured

  unlitTexturedBlendExt <- External.newObserverGraphics
    forward
    pMSAA
    pUnlitTexturedBlend

  spriteExt <- External.newObserverGraphics
    forward
    pMSAA
    pSprite

  spriteOutlineExt <- External.newObserverGraphics
    forward
    pMSAA
    pSpriteOutline

  tileMapExt <- External.newObserverGraphics
    forward
    pMSAA
    pTileMap

  tileMapBlendExt <- External.newObserverGraphics
    forward
    pMSAA
    pTileMapBlend

  wireframeExt <- External.newObserverGraphics
    forward
    pMSAA
    pWireframe

  wireframeNoDepthExt <- External.newObserverGraphics
    forward
    pMSAA
    pWireframeNoDepth

  shadowCastExt <- External.newObserverGraphics
    forward
    pMSAA
    pShadowCast

  pure Pipelines
    { pEvanwSdf = evanwSdfExt
    , pSkybox = skyboxExt
    , pDebugUV = debugUVExt
    , pDebugTexture = debugTextureExt
    , pDebugShadow = debugShadowExt
    , pDepthOnly = depthOnlyExt
    , pLitColored = litColoredExt
    , pLitColoredBlend = litColoredBlendExt
    , pLitMaterial = litMaterialExt
    , pLitMaterialBlend = litMaterialBlendExt
    , pLitTextured = litTexturedExt
    , pLitTexturedBlend = litTexturedBlendExt
    , pLine2d = line2dExt
    , pLine2dNoDepth = line2dNoDepthExt
    , pUnlitColored = unlitColoredExt
    , pUnlitColoredNoDepth = unlitColoredNoDepthExt
    , pUnlitTextured = unlitTexturedExt
    , pUnlitTexturedBlend = unlitTexturedBlendExt
    , pSprite = spriteExt
    , pSpriteOutline = spriteOutlineExt
    , pTileMap = tileMapExt
    , pTileMapBlend = tileMapBlendExt
    , pWireframe = wireframeExt
    , pWireframeNoDepth = wireframeNoDepthExt
    , pShadowCast = shadowCastExt
    , ..
    }
  where
    forward = rpForwardMsaa renderPasses

observePipelines
  :: RenderPasses
  -> PipelineWorkers
  -> PipelineObservers
  -> Engine.StageFrameRIO rp p fr rs ()
observePipelines fRenderpass workers pipelines = do
  observe @EvanwSdf.Pipeline pEvanwSdf

  observe @Skybox.Pipeline pSkybox

  observe @Debug.Pipeline pDebugUV
  observe @Debug.Pipeline pDebugTexture
  observe @Debug.Pipeline pDebugShadow

  observe @DepthOnly.Pipeline pDepthOnly

  observe @LitColored.Pipeline pLitColored
  observe @LitColored.Pipeline pLitColoredBlend

  observe @LitTextured.Pipeline pLitTextured
  observe @LitTextured.Pipeline pLitTexturedBlend

  observe @LitMaterial.Pipeline pLitMaterial
  observe @LitMaterial.Pipeline pLitMaterialBlend

  observe @UnlitColored.Pipeline pUnlitColored
  observe @UnlitColored.Pipeline pUnlitColoredNoDepth

  observe @UnlitTextured.Pipeline pUnlitTextured
  observe @UnlitTextured.Pipeline pUnlitTexturedBlend

  observe @UnlitSprite.Pipeline pSprite
  observe @UnlitSprite.Pipeline pSpriteOutline

  observe @UnlitTileMap.Pipeline pTileMap
  observe @UnlitTileMap.Pipeline pTileMapBlend

  observe @UnlitColored.Pipeline pWireframe
  observe @UnlitColored.Pipeline pWireframeNoDepth

  External.observeGraphics
    (rpShadowPass fRenderpass) -- XXX: different RP here
    (pMSAA workers)
    (Tagged [unTagged $ pSceneBinds pipelines])
    (pShadowCast workers)
    (pShadowCast pipelines)
  where
    observe
      :: forall
         p
         s vs is
         rps ps fr rs
      .  ( p ~ Graphics.Pipeline s vs is
         , Shader.Specialization (Graphics.Specialization p)
         )
      => (forall a . PipelinesF a -> a ^ p)
      -> Engine.StageFrameRIO rps ps fr rs ()
    observe =
      External.observeField
        @PipelinesF
        @p
        (rpForwardMsaa fRenderpass)
        (pMSAA workers)
        (pSceneBinds pipelines)
        workers
        pipelines

getSceneLayout :: PipelinesF f -> Tagged '[Scene] Vk.DescriptorSetLayout
getSceneLayout = pSceneLayout

getSunLayout :: Pipelines -> Tagged '[Sun] Vk.DescriptorSetLayout
getSunLayout = pShadowLayout

shaderDir :: FilePath
shaderDir = "data" </> "shaders" </> "basic"

stageSources :: Map Text Graphics.StageCode
stageSources =
  [ ("evanw-sdf", EvanwSdf.stageCode)
  , ("skybox", Skybox.stageCode)
  , ("debug", Debug.stageCode)
  , ("depth-only", DepthOnly.stageCode)
  , ("lit-colored", LitColored.stageCode)
  , ("lit-material", LitMaterial.stageCode)
  , ("lit-textured", LitTextured.stageCode)
  , ("unlit-colored", UnlitColored.stageCode)
  , ("unlit-textured", UnlitTextured.stageCode)
  , ("line-2d", UnlitLine2d.stageCode)
  , ("sprite", UnlitSprite.stageCode)
  , ("tilemap", UnlitTileMap.stageCode)
  , ("shadow-cast", ShadowPipe.stageCode)
  ]