{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Pipeline.VertexInputState.Internal (

	-- * CREATE INFO

	CreateInfo(..),

	-- * CREATE INFO TO MIDDLE

	createInfoToMiddle,
	BindingStrideList, AttributeDescriptions, Formattable(..)

	) where

import GHC.TypeNats
import GHC.Generics
import Foreign.Storable.PeekPoke
import Data.TypeLevel.TypeVal qualified as TypeVal
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex
import Data.Kind
import Data.Bits
import Data.Default

import qualified Gpu.Vulkan.Pipeline.VertexInputState.Middle as M
import qualified Gpu.Vulkan.VertexInput.Internal as VtxInp
import qualified Gpu.Vulkan.VertexInput.Middle as VtxInp.M

import Gpu.Vulkan.Pipeline.VertexInputState.BindingOffset
import Gpu.Vulkan.Pipeline.VertexInputState.Formattable
import Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment
import Gpu.Vulkan.Pipeline.VertexInputState.Data.Type.TypeValMap
import Gpu.Vulkan.Pipeline.VertexInputState.GHC.Generics.TypeFam

-- CREATE INFO

data CreateInfo mn (vibs :: [(Type, VtxInp.Rate)]) (vias :: [(Nat, Type)]) =
	CreateInfo {
		forall (mn :: Maybe (*)) (vibs :: [(*, Rate)])
       (vias :: [(Nat, *)]).
CreateInfo mn vibs vias -> M mn
createInfoNext :: TMaybe.M mn,
		forall (mn :: Maybe (*)) (vibs :: [(*, Rate)])
       (vias :: [(Nat, *)]).
CreateInfo mn vibs vias -> CreateFlags
createInfoFlags :: M.CreateFlags }

deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn vibs vias)

instance Default (CreateInfo 'Nothing vibs vias) where
	def :: CreateInfo 'Nothing vibs vias
def = CreateInfo {
		createInfoNext :: M 'Nothing
createInfoNext = M 'Nothing
TMaybe.N, createInfoFlags :: CreateFlags
createInfoFlags = CreateFlags
forall a. Bits a => a
zeroBits }

-- CREATE INFO TO MIDDLE

createInfoToMiddle :: forall n vibs vias . (
	BindingStrideList vibs VtxInp.Rate,
	AttributeDescriptions vibs vias ) =>
	CreateInfo n vibs vias -> M.CreateInfo n
createInfoToMiddle :: forall (n :: Maybe (*)) (vibs :: [(*, Rate)]) (vias :: [(Nat, *)]).
(BindingStrideList vibs Rate, AttributeDescriptions vibs vias) =>
CreateInfo n vibs vias -> CreateInfo n
createInfoToMiddle CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)) (vibs :: [(*, Rate)])
       (vias :: [(Nat, *)]).
CreateInfo mn vibs vias -> M mn
createInfoNext = M n
mnxt, createInfoFlags :: forall (mn :: Maybe (*)) (vibs :: [(*, Rate)])
       (vias :: [(Nat, *)]).
CreateInfo mn vibs vias -> CreateFlags
createInfoFlags = CreateFlags
flgs } = M.CreateInfo {
	createInfoNext :: M n
M.createInfoNext = M n
mnxt,
	createInfoFlags :: CreateFlags
M.createInfoFlags = CreateFlags
flgs,
	createInfoVertexBindingDescriptions :: [BindingDescription]
M.createInfoVertexBindingDescriptions = forall (vibs :: [(*, Rate)]).
BindingStrideList vibs Rate =>
[BindingDescription]
forall {k} (vibs :: [(*, k)]).
BindingStrideList vibs Rate =>
[BindingDescription]
bindingDescriptions @vibs,
	createInfoVertexAttributeDescriptions :: [AttributeDescription]
M.createInfoVertexAttributeDescriptions =
		forall (vibs :: [(*, Rate)]) (vias :: [(Nat, *)]).
AttributeDescriptions vibs vias =>
[AttributeDescription]
attributeDescriptions @vibs @vias }

-- Binding Descriptions

bindingDescriptions ::
	forall vibs . BindingStrideList vibs VtxInp.Rate =>
	[VtxInp.M.BindingDescription]
bindingDescriptions :: forall {k} (vibs :: [(*, k)]).
BindingStrideList vibs Rate =>
[BindingDescription]
bindingDescriptions = (BindingDescription -> BindingDescription)
-> [BindingDescription] -> [BindingDescription]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BindingDescription -> BindingDescription
VtxInp.bindingDescriptionToMiddle
	([BindingDescription] -> [BindingDescription])
-> ([(SizeAlignment, Rate)] -> [BindingDescription])
-> [(SizeAlignment, Rate)]
-> [BindingDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SizeAlignment, Rate)] -> [BindingDescription]
VtxInp.bindingDescriptionFromRaw
	([(SizeAlignment, Rate)] -> [BindingDescription])
-> [(SizeAlignment, Rate)] -> [BindingDescription]
forall a b. (a -> b) -> a -> b
$ forall k (ts :: [(*, k)]) v.
BindingStrideList ts v =>
[(SizeAlignment, v)]
bindingStrideList @_ @vibs @VtxInp.Rate

class BindingStrideList (ts :: [(Type, k)]) v where
	bindingStrideList :: [(SizeAlignment, v)]

instance BindingStrideList '[] v where bindingStrideList :: [(SizeAlignment, v)]
bindingStrideList = []

instance (MapTypeVal2 Sizable (Flatten (Rep t)), BindingStrideList ts v, TypeVal.T a v) =>
	BindingStrideList ('(t, a) ': ts) v where
	bindingStrideList :: [(SizeAlignment, v)]
bindingStrideList =
		(forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => SizeAlignment
wholeSizeAlignment @t, forall k (t :: k) v. T t v => v
TypeVal.t @_ @a @v) (SizeAlignment, v) -> [(SizeAlignment, v)] -> [(SizeAlignment, v)]
forall a. a -> [a] -> [a]
:
		forall k (ts :: [(*, k)]) v.
BindingStrideList ts v =>
[(SizeAlignment, v)]
bindingStrideList @_ @ts @v

-- Attribute Descriptions

class AttributeDescriptions
	(vibs :: [(Type, VtxInp.Rate)]) (vias :: [(Nat, Type)]) where
	attributeDescriptions :: [VtxInp.AttributeDescription]

instance AttributeDescriptions vibs '[] where attributeDescriptions :: [AttributeDescription]
attributeDescriptions = []

instance (
	KnownNat i, BindingOffsetNew (TMapIndex.M0_2 vibs) t, Formattable t,
	AttributeDescriptions vibs vias ) =>
	AttributeDescriptions vibs ('(i, t) ': vias) where
	attributeDescriptions :: [AttributeDescription]
attributeDescriptions = VtxInp.AttributeDescription {
		attributeDescriptionLocation :: Word32
VtxInp.attributeDescriptionLocation =
			Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Word32) -> Nat -> Word32
forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal @i Any i
forall a. HasCallStack => a
undefined,
		attributeDescriptionBinding :: Word32
VtxInp.attributeDescriptionBinding = Word32
bdng,
		attributeDescriptionFormat :: Format
VtxInp.attributeDescriptionFormat = forall a. Formattable a => Format
formatOf @t,
		attributeDescriptionOffset :: Word32
VtxInp.attributeDescriptionOffset = Word32
ost } AttributeDescription
-> [AttributeDescription] -> [AttributeDescription]
forall a. a -> [a] -> [a]
: [AttributeDescription]
ads
		where
		(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
bdng, Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
ost) =
			forall (ts :: [*]) a. BindingOffsetNew ts a => SizeAlignment
bindingOffsetNew @(TMapIndex.M0_2 vibs) @t
		ads :: [AttributeDescription]
ads = forall (vibs :: [(*, Rate)]) (vias :: [(Nat, *)]).
AttributeDescriptions vibs vias =>
[AttributeDescription]
attributeDescriptions @vibs @vias