{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications, RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.DescriptorSetLayout (

	-- * CREATE

	create, D, CreateInfo(..),

	-- ** Binding

	Binding(..), BindingListToMiddle,

	-- ** BindingType

	BindingType(..), BindingTypeListBufferOnlyDynamics,

	-- * ENUM

	module Gpu.Vulkan.DescriptorSetLayout.Enum

	) where

import Prelude hiding (length)

import Foreign.Storable.PeekPoke
import Control.Exception
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.List
import Data.TypeLevel.Tuple.Uncurry
import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex
import Data.HeteroParList qualified as HeteroParList
import Data.HeteroParList (pattern (:**))
import Data.Word

import Gpu.Vulkan.Enum
import Gpu.Vulkan.DescriptorSetLayout.Type
import Gpu.Vulkan.DescriptorSetLayout.Enum

import qualified Gpu.Vulkan.AllocationCallbacks as AllocationCallbacks
import qualified Gpu.Vulkan.AllocationCallbacks.Type as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Type as Device
import qualified Gpu.Vulkan.Descriptor.Enum as Descriptor
import qualified Gpu.Vulkan.DescriptorSetLayout.Middle as M
import qualified Gpu.Vulkan.Sampler.Type as Sampler

create :: (
	WithPoked (TMaybe.M mn), BindingListToMiddle bts,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> CreateInfo mn bts ->
	TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	(forall s . D s bts -> IO a) -> IO a
create :: forall (mn :: Maybe (*)) (bts :: [BindingType])
       (mac :: Maybe (*, *)) sd a.
(WithPoked (M mn), BindingListToMiddle bts, ToMiddle mac) =>
D sd
-> CreateInfo mn bts
-> M (U2 A) mac
-> (forall s. D s bts -> IO a)
-> IO a
create (Device.D D
dvc) CreateInfo mn bts
ci (M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) forall s. D s bts -> IO a
f =
	IO D -> (D -> IO ()) -> (D -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (D -> CreateInfo mn -> M A (Snd mac) -> IO D
forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO D
M.create D
dvc (CreateInfo mn bts -> CreateInfo mn
forall (bts :: [BindingType]) (mn :: Maybe (*)).
BindingListToMiddle bts =>
CreateInfo mn bts -> CreateInfo mn
createInfoToMiddle CreateInfo mn bts
ci) M A (Snd mac)
mac)
		(\D
l -> D -> D -> M A (Snd mac) -> IO ()
forall (md :: Maybe (*)). D -> D -> M A md -> IO ()
M.destroy D
dvc D
l M A (Snd mac)
mac) (D Any bts -> IO a
forall s. D s bts -> IO a
f (D Any bts -> IO a) -> (D -> D Any bts) -> D -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D Any bts
forall {k} (s :: k) (bts :: [BindingType]). D -> D s bts
D)

data CreateInfo mn bts = CreateInfo {
	forall (mn :: Maybe (*)) (bts :: [BindingType]).
CreateInfo mn bts -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (bts :: [BindingType]).
CreateInfo mn bts -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)) (bts :: [BindingType]).
CreateInfo mn bts -> PL Binding bts
createInfoBindings :: HeteroParList.PL Binding bts }

-- deriving instance (Show (TMaybe.M mn), Show (HeteroParList.PL Binding bts)) =>
--	Show (CreateInfo mn bts)

createInfoToMiddle ::
	BindingListToMiddle bts => CreateInfo mn bts -> M.CreateInfo mn
createInfoToMiddle :: forall (bts :: [BindingType]) (mn :: Maybe (*)).
BindingListToMiddle bts =>
CreateInfo mn bts -> CreateInfo mn
createInfoToMiddle CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)) (bts :: [BindingType]).
CreateInfo mn bts -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)) (bts :: [BindingType]).
CreateInfo mn bts -> CreateFlags
createInfoFlags = CreateFlags
flgs,
	createInfoBindings :: forall (mn :: Maybe (*)) (bts :: [BindingType]).
CreateInfo mn bts -> PL Binding bts
createInfoBindings = PL Binding bts
bds } = M.CreateInfo {
		createInfoNext :: M mn
M.createInfoNext = M mn
mnxt,
		createInfoFlags :: CreateFlags
M.createInfoFlags = CreateFlags
flgs,
		createInfoBindings :: [Binding]
M.createInfoBindings = PL Binding bts -> Word32 -> [Binding]
forall (bts :: [BindingType]).
BindingListToMiddle bts =>
PL Binding bts -> Word32 -> [Binding]
bindingListToMiddle PL Binding bts
bds Word32
0 }

data Binding (bt :: BindingType) where
	BindingBuffer :: {
		forall (iargs :: [O]). Binding ('Buffer iargs) -> Type
bindingBufferDescriptorType :: Descriptor.Type,
		forall (iargs :: [O]). Binding ('Buffer iargs) -> ShaderStageFlags
bindingBufferStageFlags :: ShaderStageFlags
		} -> Binding ('Buffer objs)
	BindingBufferView :: {
		forall (iargs :: [(Symbol, *)]).
Binding ('BufferView iargs) -> Type
bindingBufferViewDescriptorType :: Descriptor.Type,
		forall (iargs :: [(Symbol, *)]).
Binding ('BufferView iargs) -> ShaderStageFlags
bindingBufferViewStageFlags :: ShaderStageFlags
		} -> Binding ('BufferView bvargs)
	BindingImage :: {
		forall (iargs :: [(Symbol, Format)]).
Binding ('Image iargs) -> Type
bindingImageDescriptorType :: Descriptor.Type,
		forall (iargs :: [(Symbol, Format)]).
Binding ('Image iargs) -> ShaderStageFlags
bindingImageStageFlags :: ShaderStageFlags
		} -> Binding ('Image iargs)
	BindingImageSampler :: {
		forall (iargs :: [(Symbol, Format, *)]).
Binding ('ImageSampler iargs) -> Type
bindingImageSamplerDescriptorType :: Descriptor.Type,
		forall (iargs :: [(Symbol, Format, *)]).
Binding ('ImageSampler iargs) -> ShaderStageFlags
bindingImageSamplerStageFlags :: ShaderStageFlags,
		forall (iargs :: [(Symbol, Format, *)]).
Binding ('ImageSampler iargs) -> PL S (M2_3 iargs)
bindingImageSamplerImmutableSamplers ::
			HeteroParList.PL Sampler.S (TMapIndex.M2_3 iargs)
		} -> Binding ('ImageSampler iargs)

class BindingListToMiddle bts where
	bindingListToMiddle ::
		HeteroParList.PL Binding bts -> Word32 -> [M.Binding]

instance BindingListToMiddle '[] where
	bindingListToMiddle :: PL Binding '[] -> Word32 -> [Binding]
bindingListToMiddle PL Binding '[]
HeteroParList.Nil Word32
_ = []

instance (BindingToMiddle bt, BindingListToMiddle bts) =>
	BindingListToMiddle (bt ': bts) where
	bindingListToMiddle :: PL Binding (bt : bts) -> Word32 -> [Binding]
bindingListToMiddle (Binding s
bd :** PL Binding ss1
bds) Word32
bb =
		Binding s -> Word32 -> Binding
forall (bt :: BindingType).
BindingToMiddle bt =>
Binding bt -> Word32 -> Binding
bindingToMiddle Binding s
bd Word32
bb Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: PL Binding ss1 -> Word32 -> [Binding]
forall (bts :: [BindingType]).
BindingListToMiddle bts =>
PL Binding bts -> Word32 -> [Binding]
bindingListToMiddle PL Binding ss1
bds (Word32
bb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)

class BindingToMiddle bt where
	bindingToMiddle :: Binding bt -> Word32 -> M.Binding

instance Length objs => BindingToMiddle ('Buffer objs) where
	bindingToMiddle :: Binding ('Buffer objs) -> Word32 -> Binding
bindingToMiddle BindingBuffer {
		bindingBufferDescriptorType :: forall (iargs :: [O]). Binding ('Buffer iargs) -> Type
bindingBufferDescriptorType = Type
dt,
		bindingBufferStageFlags :: forall (iargs :: [O]). Binding ('Buffer iargs) -> ShaderStageFlags
bindingBufferStageFlags = ShaderStageFlags
sfs } Word32
bb = M.Binding {
			bindingBinding :: Word32
M.bindingBinding = Word32
bb,
			bindingDescriptorType :: Type
M.bindingDescriptorType = Type
dt,
			bindingDescriptorCountOrImmutableSamplers :: Either Word32 [S]
M.bindingDescriptorCountOrImmutableSamplers =
				Word32 -> Either Word32 [S]
forall a b. a -> Either a b
Left (forall k (as :: [k]) n. (Length as, Integral n) => n
length @_ @objs),
			bindingStageFlags :: ShaderStageFlags
M.bindingStageFlags = ShaderStageFlags
sfs }

instance Length bvargs => BindingToMiddle ('BufferView bvargs) where
	bindingToMiddle :: Binding ('BufferView bvargs) -> Word32 -> Binding
bindingToMiddle BindingBufferView {
		bindingBufferViewDescriptorType :: forall (iargs :: [(Symbol, *)]).
Binding ('BufferView iargs) -> Type
bindingBufferViewDescriptorType = Type
dt,
		bindingBufferViewStageFlags :: forall (iargs :: [(Symbol, *)]).
Binding ('BufferView iargs) -> ShaderStageFlags
bindingBufferViewStageFlags = ShaderStageFlags
sfs } Word32
bb = M.Binding {
			bindingBinding :: Word32
M.bindingBinding = Word32
bb,
			bindingDescriptorType :: Type
M.bindingDescriptorType = Type
dt,
			bindingDescriptorCountOrImmutableSamplers :: Either Word32 [S]
M.bindingDescriptorCountOrImmutableSamplers =
				Word32 -> Either Word32 [S]
forall a b. a -> Either a b
Left (forall k (as :: [k]) n. (Length as, Integral n) => n
length @_ @bvargs),
			bindingStageFlags :: ShaderStageFlags
M.bindingStageFlags = ShaderStageFlags
sfs }

instance Length iargs => BindingToMiddle ('Image iargs) where
	bindingToMiddle :: Binding ('Image iargs) -> Word32 -> Binding
bindingToMiddle BindingImage {
		bindingImageDescriptorType :: forall (iargs :: [(Symbol, Format)]).
Binding ('Image iargs) -> Type
bindingImageDescriptorType = Type
dt,
		bindingImageStageFlags :: forall (iargs :: [(Symbol, Format)]).
Binding ('Image iargs) -> ShaderStageFlags
bindingImageStageFlags = ShaderStageFlags
sfs } Word32
bb = M.Binding {
			bindingBinding :: Word32
M.bindingBinding = Word32
bb,
			bindingDescriptorType :: Type
M.bindingDescriptorType = Type
dt,
			bindingDescriptorCountOrImmutableSamplers :: Either Word32 [S]
M.bindingDescriptorCountOrImmutableSamplers =
				Word32 -> Either Word32 [S]
forall a b. a -> Either a b
Left (forall k (as :: [k]) n. (Length as, Integral n) => n
length @_ @iargs),
			bindingStageFlags :: ShaderStageFlags
M.bindingStageFlags = ShaderStageFlags
sfs }

instance BindingToMiddle ('ImageSampler iargs) where
	bindingToMiddle :: Binding ('ImageSampler iargs) -> Word32 -> Binding
bindingToMiddle BindingImageSampler {
		bindingImageSamplerDescriptorType :: forall (iargs :: [(Symbol, Format, *)]).
Binding ('ImageSampler iargs) -> Type
bindingImageSamplerDescriptorType = Type
dt,
		bindingImageSamplerStageFlags :: forall (iargs :: [(Symbol, Format, *)]).
Binding ('ImageSampler iargs) -> ShaderStageFlags
bindingImageSamplerStageFlags = ShaderStageFlags
sfs,
		bindingImageSamplerImmutableSamplers :: forall (iargs :: [(Symbol, Format, *)]).
Binding ('ImageSampler iargs) -> PL S (M2_3 iargs)
bindingImageSamplerImmutableSamplers = PL S (M2_3 iargs)
iss } Word32
bb = M.Binding {
			bindingBinding :: Word32
M.bindingBinding = Word32
bb,
			bindingDescriptorType :: Type
M.bindingDescriptorType = Type
dt,
			bindingDescriptorCountOrImmutableSamplers :: Either Word32 [S]
M.bindingDescriptorCountOrImmutableSamplers = [S] -> Either Word32 [S]
forall a b. b -> Either a b
Right
				([S] -> Either Word32 [S]) -> [S] -> Either Word32 [S]
forall a b. (a -> b) -> a -> b
$ (forall s. S s -> S) -> PL S (M2_3 iargs) -> [S]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList S s -> S
forall s. S s -> S
Sampler.sToMiddle PL S (M2_3 iargs)
PL S (M2_3 iargs)
iss,
			bindingStageFlags :: ShaderStageFlags
M.bindingStageFlags = ShaderStageFlags
sfs }