module Resource.Vulkan.DescriptorLayout where

import RIO

import Data.Vector qualified as Vector
import Engine.Vulkan.Types (getDevice, MonadVulkan)
import RIO.List qualified as List
import Vulkan.Core10 qualified as Vk
import Vulkan.Core12 qualified as Vk12
import Vulkan.CStruct.Extends (pattern (:&), pattern (::&))
import Vulkan.Zero (zero)

create
  :: MonadVulkan env m
  => Vector [(Vk.DescriptorSetLayoutBinding, Vk12.DescriptorBindingFlags)]
  -> m (Vector Vk.DescriptorSetLayout)
create :: forall env (m :: * -> *).
MonadVulkan env m =>
Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
-> m (Vector DescriptorSetLayout)
create Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
dsBindings = do
  Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
  forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
Vector.forM Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
dsBindings \[(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
bindsFlags -> do
    let
      ([DescriptorSetLayoutBinding]
binds, [DescriptorBindingFlags]
flags) = forall a b. [(a, b)] -> ([a], [b])
List.unzip [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
bindsFlags

      setCI :: DescriptorSetLayoutCreateInfo
  '[DescriptorSetLayoutBindingFlagsCreateInfo]
setCI =
        forall a. Zero a => a
zero
          { $sel:bindings:DescriptorSetLayoutCreateInfo :: Vector DescriptorSetLayoutBinding
Vk.bindings = forall a. [a] -> Vector a
Vector.fromList [DescriptorSetLayoutBinding]
binds
          }
        forall (a :: [*] -> *) (es :: [*]) (es' :: [*]).
Extensible a =>
a es' -> Chain es -> a es
::& forall a. Zero a => a
zero
          { $sel:bindingFlags:DescriptorSetLayoutBindingFlagsCreateInfo :: Vector DescriptorBindingFlags
Vk12.bindingFlags = forall a. [a] -> Vector a
Vector.fromList [DescriptorBindingFlags]
flags
          }
        forall e (es :: [*]). e -> Chain es -> Chain (e : es)
:& ()

    forall (a :: [*]) (io :: * -> *).
(Extendss DescriptorSetLayoutCreateInfo a, PokeChain a,
 MonadIO io) =>
Device
-> DescriptorSetLayoutCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DescriptorSetLayout
Vk.createDescriptorSetLayout Device
device DescriptorSetLayoutCreateInfo
  '[DescriptorSetLayoutBindingFlagsCreateInfo]
setCI forall a. Maybe a
Nothing

forPipeline
  :: MonadVulkan env m
  => Vector Vk.DescriptorSetLayout
  -> Vector Vk.PushConstantRange
  -> m Vk.PipelineLayout
forPipeline :: forall env (m :: * -> *).
MonadVulkan env m =>
Vector DescriptorSetLayout
-> Vector PushConstantRange -> m PipelineLayout
forPipeline Vector DescriptorSetLayout
dsLayouts Vector PushConstantRange
pushConstantRanges = do
  Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
  forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineLayoutCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io PipelineLayout
Vk.createPipelineLayout Device
device PipelineLayoutCreateInfo
layoutCI forall a. Maybe a
Nothing
  where
    layoutCI :: PipelineLayoutCreateInfo
layoutCI = Vk.PipelineLayoutCreateInfo
      { $sel:flags:PipelineLayoutCreateInfo :: PipelineLayoutCreateFlags
flags              = forall a. Zero a => a
zero
      , $sel:setLayouts:PipelineLayoutCreateInfo :: Vector DescriptorSetLayout
setLayouts         = Vector DescriptorSetLayout
dsLayouts
      , $sel:pushConstantRanges:PipelineLayoutCreateInfo :: Vector PushConstantRange
pushConstantRanges = Vector PushConstantRange
pushConstantRanges
      }