{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE GADTs, TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.DescriptorSet.Write.Sources (

	-- * WRITE SOURCES

	-- ** Types

	WriteSources(..), WriteSourcesArg(..),
	DstBinding, DstArrayElement, DescriptorCount,

	-- ** WriteSourcesToMiddle

	WriteSourcesToMiddle(..),
	BindingAndArrayElemImage, BindingAndArrayElemImageWithImmutableSampler,
	BindingAndArrayElemBuffer, BindingAndArrayElemBufferView,

	-- ** WriteSourcesUpdateDynamicLengths

	WriteSourcesUpdateDynamicLengths(..), UpdateDynamicLength

	) where

import GHC.TypeLits
import Data.Kind
import Data.TypeLevel.Tuple.Uncurry
import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex
import Data.HeteroParList qualified as HeteroParList
import Data.HeteroParList.Tuple qualified as HeteroParList
import Data.Word
import Data.IORef

import Gpu.Vulkan.Object qualified as VObj

import Gpu.Vulkan.TypeEnum qualified as T

import Gpu.Vulkan.Descriptor.Internal qualified as Descriptor
import Gpu.Vulkan.Descriptor.Middle qualified as Descriptor.M

import Gpu.Vulkan.DescriptorSet.Type
import Gpu.Vulkan.DescriptorSet.BindingAndArrayElem
import Gpu.Vulkan.DescriptorSet.BindingAndArrayElem.Buffer
import Gpu.Vulkan.DescriptorSet.Middle qualified as M
import Gpu.Vulkan.DescriptorSetLayout.Type qualified as Layout
import Gpu.Vulkan.DescriptorSetLayout.UpdateDynamicLengths

import Gpu.Vulkan.Buffer.Type qualified as Buffer
import Gpu.Vulkan.BufferView.Internal qualified as BufferView
import Gpu.Vulkan.BufferView.Middle qualified as BufferView.M

-- * WRITE SOURCES

-- ** Types

data WriteSources arg where
	ImageInfos ::
		HeteroParList.PL (U4 Descriptor.ImageInfo) iiargs ->
		WriteSources ('WriteSourcesArgImage iiargs)
	ImageInfosNoSampler ::
		HeteroParList.PL (U3 Descriptor.ImageInfoNoSampler) iiargs ->
		WriteSources ('WriteSourcesArgImageNoSampler iiargs)
	BufferInfos ::
		HeteroParList.PL (U5 Descriptor.BufferInfo) biargs ->
		WriteSources ('WriteSourcesArgBuffer biargs)
	TexelBufferViews ::
		HeteroParList.PL (U3 BufferView.B) tbvargs ->
		WriteSources ('WriteSourcesArgBufferView tbvargs)
	WriteSourcesInNext :: DstBinding -> DstArrayElement ->
		DescriptorCount -> WriteSources 'WriteSourcesArgInNext

data WriteSourcesArg
	= WriteSourcesArgImage [(Type, Symbol, T.Format, Type)]
	| WriteSourcesArgImageNoSampler [(Symbol, T.Format, Type)]
	| WriteSourcesArgBuffer [(Type, Type, Symbol, VObj.O, Nat)]
	| WriteSourcesArgBufferView [(Type, Symbol, Type)]
	| WriteSourcesArgInNext

type DstBinding = Word32
type DstArrayElement = Word32
type DescriptorCount = Word32

-- ** WriteSourcesToMiddle

class WriteSourcesToMiddle (lbts :: [Layout.BindingType]) wsarg (i :: Nat) where
	writeSourcesToMiddle ::
		WriteSources wsarg -> ((Word32, Word32), M.WriteSources)

instance (BindingAndArrayElemBuffer lbts (TMapIndex.M3_5 barg) i) =>
	WriteSourcesToMiddle lbts ('WriteSourcesArgBuffer barg) i where
	writeSourcesToMiddle :: WriteSources ('WriteSourcesArgBuffer barg)
-> ((Word32, Word32), WriteSources)
writeSourcesToMiddle (BufferInfos PL (U5 BufferInfo) biargs
bis) = (
		forall (lbts :: [BindingType]) (objs :: [O]) (i :: Nat) n.
(BindingAndArrayElemBuffer lbts objs i, Integral n) =>
n -> n -> (n, n)
bindingAndArrayElemBuffer @lbts @(TMapIndex.M3_5 barg) @i Word32
0 Word32
0,
		[BufferInfo] -> WriteSources
M.WriteSourcesBufferInfo ([BufferInfo] -> WriteSources) -> [BufferInfo] -> WriteSources
forall a b. (a -> b) -> a -> b
$ PL (U5 BufferInfo) biargs -> [BufferInfo]
forall (biargs :: [(*, *, Symbol, O, Nat)]).
PL (U5 BufferInfo) biargs -> [BufferInfo]
bufferInfoListToMiddle PL (U5 BufferInfo) biargs
bis )
		where
		bufferInfoListToMiddle ::
			HeteroParList.PL (U5 Descriptor.BufferInfo) biargs ->
			[Descriptor.M.BufferInfo]
		bufferInfoListToMiddle :: forall (biargs :: [(*, *, Symbol, O, Nat)]).
PL (U5 BufferInfo) biargs -> [BufferInfo]
bufferInfoListToMiddle = (forall (s :: (*, *, Symbol, O, Nat)).
 U5 BufferInfo s -> BufferInfo)
-> PL (U5 BufferInfo) biargs -> [BufferInfo]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList \(U5 BufferInfo s1 s2 s3 s4 s5
bi) ->
			BufferInfo s1 s2 s3 s4 s5 -> BufferInfo
forall sb sm (nm :: Symbol) (obj :: O) (i :: Nat).
BufferInfo sm sb nm obj i -> BufferInfo
Descriptor.bufferInfoToMiddle BufferInfo s1 s2 s3 s4 s5
bi

instance BindingAndArrayElemImage lbts (TMapIndex.M1'2_4 iarg) i =>
	WriteSourcesToMiddle lbts ('WriteSourcesArgImage iarg) i where
	writeSourcesToMiddle :: WriteSources ('WriteSourcesArgImage iarg)
-> ((Word32, Word32), WriteSources)
writeSourcesToMiddle (ImageInfos PL (U4 ImageInfo) iiargs
iis) = (
		forall (lbts :: [BindingType]) (iargs :: [(Symbol, Format)])
       (i :: Nat) n.
(BindingAndArrayElemImage lbts iargs i, Integral n) =>
n -> n -> (n, n)
bindingAndArrayElemImage @lbts @(TMapIndex.M1'2_4 iarg) @i Word32
0 Word32
0,
		[ImageInfo] -> WriteSources
M.WriteSourcesImageInfo ([ImageInfo] -> WriteSources) -> [ImageInfo] -> WriteSources
forall a b. (a -> b) -> a -> b
$ PL (U4 ImageInfo) iiargs -> [ImageInfo]
forall (iiargs :: [(*, Symbol, Format, *)]).
PL (U4 ImageInfo) iiargs -> [ImageInfo]
imageInfosToMiddle PL (U4 ImageInfo) iiargs
iis )
		where
		imageInfosToMiddle ::
			HeteroParList.PL (U4 Descriptor.ImageInfo) iiargs ->
			[Descriptor.M.ImageInfo]
		imageInfosToMiddle :: forall (iiargs :: [(*, Symbol, Format, *)]).
PL (U4 ImageInfo) iiargs -> [ImageInfo]
imageInfosToMiddle = (forall (s :: (*, Symbol, Format, *)). U4 ImageInfo s -> ImageInfo)
-> PL (U4 ImageInfo) iiargs -> [ImageInfo]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList \(U4 ImageInfo s1 s2 s3 s4
ii) ->
			ImageInfo s1 s2 s3 s4 -> ImageInfo
forall ss (fmt :: Symbol) (nm :: Format) si.
ImageInfo ss fmt nm si -> ImageInfo
Descriptor.imageInfoToMiddle ImageInfo s1 s2 s3 s4
ii

instance BindingAndArrayElemImageWithImmutableSampler
		lbts (TMapIndex.M0'1_3 iarg) i =>
	WriteSourcesToMiddle lbts ('WriteSourcesArgImageNoSampler iarg) i where
	writeSourcesToMiddle :: WriteSources ('WriteSourcesArgImageNoSampler iarg)
-> ((Word32, Word32), WriteSources)
writeSourcesToMiddle (ImageInfosNoSampler PL (U3 ImageInfoNoSampler) iiargs
iis) = (
		forall (lbts :: [BindingType]) (iargs :: [(Symbol, Format)])
       (i :: Nat) n.
(BindingAndArrayElemImageWithImmutableSampler lbts iargs i,
 Integral n) =>
n -> n -> (n, n)
bindingAndArrayElemImageWithImmutableSampler
			@lbts @(TMapIndex.M0'1_3 iarg) @i Word32
0 Word32
0,
		[ImageInfo] -> WriteSources
M.WriteSourcesImageInfo ([ImageInfo] -> WriteSources) -> [ImageInfo] -> WriteSources
forall a b. (a -> b) -> a -> b
$ PL (U3 ImageInfoNoSampler) iiargs -> [ImageInfo]
forall (iiargs :: [(Symbol, Format, *)]).
PL (U3 ImageInfoNoSampler) iiargs -> [ImageInfo]
imageInfosToMiddle PL (U3 ImageInfoNoSampler) iiargs
iis )
		where
		imageInfosToMiddle ::
			HeteroParList.PL
				(U3 Descriptor.ImageInfoNoSampler) iiargs ->
			[Descriptor.M.ImageInfo]
		imageInfosToMiddle :: forall (iiargs :: [(Symbol, Format, *)]).
PL (U3 ImageInfoNoSampler) iiargs -> [ImageInfo]
imageInfosToMiddle = (forall (s :: (Symbol, Format, *)).
 U3 ImageInfoNoSampler s -> ImageInfo)
-> PL (U3 ImageInfoNoSampler) iiargs -> [ImageInfo]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList \(U3 ImageInfoNoSampler s1 s2 s3
ii) ->
			ImageInfoNoSampler s1 s2 s3 -> ImageInfo
forall (fmt :: Symbol) (nm :: Format) si.
ImageInfoNoSampler fmt nm si -> ImageInfo
Descriptor.imageInfoNoSamplerToMiddle ImageInfoNoSampler s1 s2 s3
ii

instance BindingAndArrayElemBufferView lbts (TMapIndex.M1'2_3 bvarg) i =>
	WriteSourcesToMiddle lbts ('WriteSourcesArgBufferView bvarg) i where
	writeSourcesToMiddle :: WriteSources ('WriteSourcesArgBufferView bvarg)
-> ((Word32, Word32), WriteSources)
writeSourcesToMiddle (TexelBufferViews PL (U3 B) tbvargs
bvarg) = (
		forall (bt :: [BindingType]) (bvargs :: [(Symbol, *)]) (i :: Nat)
       n.
(BindingAndArrayElemBufferView bt bvargs i, Integral n) =>
n -> n -> (n, n)
bindingAndArrayElemBufferView
			@lbts @(TMapIndex.M1'2_3 bvarg) @i Word32
0 Word32
0,
		[B] -> WriteSources
M.WriteSourcesBufferView ([B] -> WriteSources) -> [B] -> WriteSources
forall a b. (a -> b) -> a -> b
$ PL (U3 B) tbvargs -> [B]
forall (bvs :: [(*, Symbol, *)]). PL (U3 B) bvs -> [B]
bvsToMiddle PL (U3 B) tbvargs
bvarg )
		where
		bvsToMiddle :: HeteroParList.PL (U3 BufferView.B) bvs ->
			[BufferView.M.B]
		bvsToMiddle :: forall (bvs :: [(*, Symbol, *)]). PL (U3 B) bvs -> [B]
bvsToMiddle =
			(forall (s :: (*, Symbol, *)). U3 B s -> B) -> PL (U3 B) bvs -> [B]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList \(U3 (BufferView.B B
mbv)) -> B
mbv

instance WriteSourcesToMiddle lbts 'WriteSourcesArgInNext i where
	writeSourcesToMiddle :: WriteSources 'WriteSourcesArgInNext
-> ((Word32, Word32), WriteSources)
writeSourcesToMiddle (WriteSourcesInNext Word32
bdg Word32
ae Word32
cnt) =
		((Word32
bdg, Word32
ae), Word32 -> WriteSources
M.WriteSourcesInNext Word32
cnt)

-- ** WriteSourcesUpdateDynamicLengths

class WriteSourcesUpdateDynamicLengths lbts wsarg where
	writeSourcesUpdateDynamicLength ::
		D sds '(sl, lbts) -> WriteSources wsarg -> IO ()

instance (
	TMapIndex.M3_5 bargs ~ objs, UpdateDynamicLength lbts objs,
	HeteroParList.Map3_5 bargs ) =>
	WriteSourcesUpdateDynamicLengths
		lbts (WriteSourcesArgBuffer bargs) where
	writeSourcesUpdateDynamicLength :: forall sds sl.
D sds '(sl, lbts)
-> WriteSources ('WriteSourcesArgBuffer bargs) -> IO ()
writeSourcesUpdateDynamicLength (D IORef
  (PL2 Length (BindingTypeListBufferOnlyDynamics (I1_2 '(sl, lbts))))
rlns D
_) (BufferInfos PL (U5 BufferInfo) biargs
bis) = do
		lns <- IORef (PL2 Length (BindingTypeListBufferOnlyDynamics lbts))
-> IO (PL2 Length (BindingTypeListBufferOnlyDynamics lbts))
forall a. IORef a -> IO a
readIORef IORef (PL2 Length (BindingTypeListBufferOnlyDynamics lbts))
IORef
  (PL2 Length (BindingTypeListBufferOnlyDynamics (I1_2 '(sl, lbts))))
rlns
		writeIORef rlns
			. updateDynamicLength @lbts @objs lns
			. VObj.onlyDynamicLength @objs
			$ HeteroParList.map3_5 (toLength . unU5) bis
		where
		toLength :: Descriptor.BufferInfo sm sb nm obj i ->
			VObj.Length obj
		toLength :: forall sm sb (nm :: Symbol) (obj :: O) (i :: Nat).
BufferInfo sm sb nm obj i -> Length obj
toLength (Descriptor.BufferInfo (Buffer.Binded PL Length objs
lns B
_)) =
			PL Length objs -> Length obj
forall k (obj :: k) (objs :: [k]) (t :: k -> *).
TypeIndex obj objs =>
PL t objs -> t obj
forall (t :: O -> *). PL t objs -> t obj
HeteroParList.typeIndex PL Length objs
lns

instance {-# OVERLAPPABLE #-} WriteSourcesUpdateDynamicLengths lbts wsarg where
	writeSourcesUpdateDynamicLength :: forall sds sl. D sds '(sl, lbts) -> WriteSources wsarg -> IO ()
writeSourcesUpdateDynamicLength D sds '(sl, lbts)
_ WriteSources wsarg
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()