module Resource.DescriptorSet
  ( allocatePool
  , TypeMap
  , mkPoolCI
  ) where

import RIO

import UnliftIO.Resource qualified as Resource
import RIO.Vector qualified as Vector
import Vulkan.Core10 qualified as Vk
import Vulkan.Zero (zero)

import Engine.Vulkan.Types (HasVulkan(getDevice))

allocatePool
  :: ( Resource.MonadResource m
     , MonadReader env m
     , HasVulkan env
     )
  => Word32
  -> TypeMap Word32
  -> m (Resource.ReleaseKey, Vk.DescriptorPool)
allocatePool :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasVulkan env) =>
Word32 -> TypeMap Word32 -> m (ReleaseKey, DescriptorPool)
allocatePool Word32
maxSets TypeMap Word32
sizes = do
  Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
  forall (a :: [*]) (io :: * -> *) r.
(Extendss DescriptorPoolCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> DescriptorPoolCreateInfo a
-> Maybe AllocationCallbacks
-> (io DescriptorPool -> (DescriptorPool -> io ()) -> r)
-> r
Vk.withDescriptorPool Device
device (Word32 -> TypeMap Word32 -> DescriptorPoolCreateInfo '[]
mkPoolCI Word32
maxSets TypeMap Word32
sizes) forall a. Maybe a
Nothing forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate

type TypeMap a = [(Vk.DescriptorType, a)]

mkPoolCI
  :: Word32
  -> TypeMap Word32
  -> Vk.DescriptorPoolCreateInfo '[]
mkPoolCI :: Word32 -> TypeMap Word32 -> DescriptorPoolCreateInfo '[]
mkPoolCI Word32
maxSets TypeMap Word32
sizes = forall a. Zero a => a
zero
  { $sel:maxSets:DescriptorPoolCreateInfo :: Word32
Vk.maxSets   = Word32
maxSets
  , $sel:poolSizes:DescriptorPoolCreateInfo :: Vector DescriptorPoolSize
Vk.poolSizes = forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DescriptorType -> Word32 -> DescriptorPoolSize
Vk.DescriptorPoolSize) TypeMap Word32
sizes
  }