module Resource.Vulkan.DescriptorPool
  ( allocate

  , allocateSetsFrom
  ) where

import RIO

import Data.Vector qualified as Vector
import UnliftIO.Resource (MonadResource, ReleaseKey)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk
import Vulkan.Zero (zero)

import Engine.Vulkan.Types (MonadVulkan, getDevice)
import Resource.Vulkan.Named qualified as Named

allocate
  :: ( MonadVulkan env m
    , MonadResource m
    )
  => Maybe Text
  -> Word32
  -> [(Vk.DescriptorType, Word32)]
  -> m  (ReleaseKey, Vk.DescriptorPool)
allocate name maxSets sizes = do
  device <- asks getDevice
  res <- Vk.withDescriptorPool
    device
    poolCI
    Nothing
    Resource.allocate
  for_ name $
    Named.object (snd res)
  pure res
  where
    poolCI = zero
      { Vk.maxSets =
          maxSets
      , Vk.poolSizes =
          Vector.fromList $
            map (uncurry Vk.DescriptorPoolSize) sizes
      }

-- TODO: extract to Resource.Vulkan.DescriptorSets ?
allocateSetsFrom
  :: MonadVulkan env m
  => Vk.DescriptorPool
  -> Maybe Text
  -> Vector Vk.DescriptorSetLayout
  -> m (Vector Vk.DescriptorSet)
allocateSetsFrom pool name layouts = do
  device <- asks getDevice
  descSets <- Vk.allocateDescriptorSets device zero
    { Vk.descriptorPool = pool
    , Vk.setLayouts     = layouts
    }
  for_ name \prefix ->
    Vector.iforM_ descSets \ix ds ->
      Named.object ds $ mconcat
        [ prefix
        , "(set=", fromString (show ix), ")"
        ]
  pure descSets