Pipeline.hs

module Engine.Vulkan.Pipeline
  ( Pipeline(..)
  , allocateWith
  , Specialization
  ) where

import RIO

import Data.Kind (Type)
import Data.Tagged (Tagged(..))
import Data.Vector qualified as Vector
import GHC.Stack (withFrozenCallStack)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk

import Engine.Vulkan.Types (DsLayouts, MonadVulkan, getDevice)

data Pipeline (dsl :: [Type]) vertices instances = Pipeline
  { pipeline     :: Vk.Pipeline
  , pLayout      :: Tagged dsl Vk.PipelineLayout
  , pDescLayouts :: Tagged dsl DsLayouts
  }

allocateWith
  :: ( MonadVulkan env m
     , Resource.MonadResource m
     )
  => m (Pipeline dsl vertices instances)
  -> m (Resource.ReleaseKey, Pipeline dsl vertices instances)
allocateWith action = withFrozenCallStack do
  res <- action
  device <- asks getDevice
  key <- Resource.register $
    destroy device res
  pure (key, res)

destroy
  :: MonadIO io
  => Vk.Device
  -> Pipeline dsl vertices instances
  -> io ()
destroy device Pipeline{..} = do
  -- FIXME: leave layout alone
  Vector.forM_ (unTagged pDescLayouts) \dsLayout ->
    Vk.destroyDescriptorSetLayout device dsLayout Nothing
  Vk.destroyPipeline device pipeline Nothing
  Vk.destroyPipelineLayout device (unTagged pLayout) Nothing

type family Specialization pipeline