{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.DescriptorSetLayout.Type where

import GHC.TypeLits
import Data.Kind
import Gpu.Vulkan.Object qualified as VObj

import qualified Gpu.Vulkan.TypeEnum as T
import qualified Gpu.Vulkan.DescriptorSetLayout.Middle as M

newtype D s (bts :: [BindingType]) = D { forall {k} (s :: k) (bts :: [BindingType]). D s bts -> D
unL :: M.D } deriving Int -> D s bts -> ShowS
[D s bts] -> ShowS
D s bts -> String
(Int -> D s bts -> ShowS)
-> (D s bts -> String) -> ([D s bts] -> ShowS) -> Show (D s bts)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) (bts :: [BindingType]). Int -> D s bts -> ShowS
forall k (s :: k) (bts :: [BindingType]). [D s bts] -> ShowS
forall k (s :: k) (bts :: [BindingType]). D s bts -> String
$cshowsPrec :: forall k (s :: k) (bts :: [BindingType]). Int -> D s bts -> ShowS
showsPrec :: Int -> D s bts -> ShowS
$cshow :: forall k (s :: k) (bts :: [BindingType]). D s bts -> String
show :: D s bts -> String
$cshowList :: forall k (s :: k) (bts :: [BindingType]). [D s bts] -> ShowS
showList :: [D s bts] -> ShowS
Show

data BindingType
	= Image [(Symbol, T.Format)] | ImageSampler [(Symbol, T.Format, Type)]
	| Buffer [VObj.O] | BufferView [(Symbol, Type)]

type family BindingTypeListBufferOnlyDynamics bts where
	BindingTypeListBufferOnlyDynamics '[] = '[]
	BindingTypeListBufferOnlyDynamics (bt ': bts) =
		BindingTypeBufferOnlyDynamics bt ':
		BindingTypeListBufferOnlyDynamics bts

type family BindingTypeBufferOnlyDynamics bt where
	BindingTypeBufferOnlyDynamics bt =
		VObj.OnlyDynamics (BindingTypeBufferObjects bt)

type family BindingTypeBufferObjects bt where
	BindingTypeBufferObjects (Buffer os) = os
	BindingTypeBufferObjects _ = '[]