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 <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
  Device
-> DescriptorPoolCreateInfo '[]
-> Maybe AllocationCallbacks
-> (IO DescriptorPool
    -> (DescriptorPool -> IO ()) -> m (ReleaseKey, DescriptorPool))
-> m (ReleaseKey, DescriptorPool)
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) Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO DescriptorPool
-> (DescriptorPool -> IO ()) -> m (ReleaseKey, DescriptorPool)
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 = DescriptorPoolCreateInfo '[]
forall a. Zero a => a
zero
  { $sel:maxSets:DescriptorPoolCreateInfo :: Word32
Vk.maxSets   = Word32
maxSets
  , $sel:poolSizes:DescriptorPoolCreateInfo :: Vector DescriptorPoolSize
Vk.poolSizes = [DescriptorPoolSize] -> Vector DescriptorPoolSize
forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList ([DescriptorPoolSize] -> Vector DescriptorPoolSize)
-> [DescriptorPoolSize] -> Vector DescriptorPoolSize
forall a b. (a -> b) -> a -> b
$ ((DescriptorType, Word32) -> DescriptorPoolSize)
-> TypeMap Word32 -> [DescriptorPoolSize]
forall a b. (a -> b) -> [a] -> [b]
map ((DescriptorType -> Word32 -> DescriptorPoolSize)
-> (DescriptorType, Word32) -> DescriptorPoolSize
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DescriptorType -> Word32 -> DescriptorPoolSize
Vk.DescriptorPoolSize) TypeMap Word32
sizes
  }