{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Internal (

	-- * INFO

	-- ** ApplicationINfo

	M.ApplicationInfo(..),
	M.ApiVersion, M.makeApiVersion, M.apiVersion_1_0, M.apiVersion_1_1,

	-- ** SubmitInfo

	SubmitInfo(..),
	SubmitInfoListToMiddle(..), SemaphorePipelineStageFlags(..),

	-- * PROPERTIES

	LayerProperties(..), layerPropertiesFromMiddle,
	M.FormatProperties(..),

	-- * NAME

	LayerName(..), layerKhronosValidation,

	-- * PIPELINE VALUES

	-- ** ViewPort

	M.Viewport, pattern M.Viewport,
	M.viewportX, M.viewportY, M.viewportWidth, M.viewportHeight,
	M.viewportMinDepth, M.viewportMaxDepth,

	-- ** StencilOpState

	M.StencilOpState(..),

	-- ** ClearValue

	M.ClearValue(..), M.ClearValueListToCore,

	-- *** ClearType

	M.ClearType(..), M.ClearColorType(..),

	-- *** ClearColorValue

	-- *** ClearDepthStencilValue

	M.ClearDepthStencilValue, pattern M.ClearDepthStencilValue,
	M.clearDepthStencilValueDepth, M.clearDepthStencilValueStencil,

	-- * RECT, OFFSET AND EXTENT

	-- ** Rect

	M.Rect2d, pattern M.Rect2d, M.rect2dExtent, M.rect2dOffset,

	-- ** Offset

	M.Offset2d, pattern M.Offset2d, M.offset2dX, M.offset2dY,
	M.Offset3d, pattern M.Offset3d, M.offset3dX, M.offset3dY, M.offset3dZ,

	-- ** Extent

	M.Extent2d, pattern M.Extent2d,
	M.extent2dWidth, M.extent2dHeight,

	M.Extent3d, pattern M.Extent3d,
	M.extent3dWidth, M.extent3dHeight, M.extent3dDepth,

	-- * OTHERS

	M.Size(..)

	) where

import Foreign.Storable.PeekPoke
import Data.Kind
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.Tuple.Uncurry
import Data.HeteroParList qualified as HeteroParList
import Data.HeteroParList (pattern (:**))
import Data.Text qualified as T

import qualified Gpu.Vulkan.Middle as M
import qualified Gpu.Vulkan.Semaphore.Type as Semaphore
import qualified Gpu.Vulkan.Semaphore.Middle as Semaphore.M
import qualified Gpu.Vulkan.CommandBuffer.Type as CommandBuffer
import qualified Gpu.Vulkan.Pipeline.Enum as Pipeline

data SubmitInfo n sss ss ssss = SubmitInfo {
	forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> M n
submitInfoNext :: TMaybe.M n,
	forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> PL SemaphorePipelineStageFlags sss
submitInfoWaitSemaphoreDstStageMasks ::
		HeteroParList.PL SemaphorePipelineStageFlags sss,
	forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> PL C ss
submitInfoCommandBuffers :: HeteroParList.PL CommandBuffer.C ss,
	forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> PL S ssss
submitInfoSignalSemaphores ::
		HeteroParList.PL Semaphore.S ssss }

class M.SubmitInfoListToCore (MiddleNextList ns3s2s4) => SubmitInfoListToMiddle
	(ns3s2s4 :: [(Maybe Type, [Type], [Type], [Type])]) where
	type MiddleNextList ns3s2s4 :: [Maybe Type]
	submitInfoListToMiddle ::
		HeteroParList.PL (U4 SubmitInfo) ns3s2s4 ->
		HeteroParList.PL M.SubmitInfo (MiddleNextList ns3s2s4)

instance SubmitInfoListToMiddle '[] where
	type MiddleNextList '[] = '[]
	submitInfoListToMiddle :: PL (U4 SubmitInfo) '[] -> PL SubmitInfo (MiddleNextList '[])
submitInfoListToMiddle PL (U4 SubmitInfo) '[]
HeteroParList.Nil = PL SubmitInfo '[]
PL SubmitInfo (MiddleNextList '[])
forall {k} (t :: k -> *). PL t '[]
HeteroParList.Nil

instance (
	WithPoked (TMaybe.M n),
	SubmitInfoListToMiddle nssvsss ) =>
	SubmitInfoListToMiddle ('(n, sss, svss, ssss) ': nssvsss) where
	type MiddleNextList ('(n, sss, svss, ssss) ': nssvsss) =
		n ': MiddleNextList nssvsss
	submitInfoListToMiddle :: PL (U4 SubmitInfo) ('(n, sss, svss, ssss) : nssvsss)
-> PL SubmitInfo (MiddleNextList ('(n, sss, svss, ssss) : nssvsss))
submitInfoListToMiddle (U4 SubmitInfo s1 s2 s3 s4
si :** PL (U4 SubmitInfo) ss1
sis) =
		SubmitInfo s1 s2 s3 s4 -> SubmitInfo s1
forall (n :: Maybe (*)) (sss :: [*]) (svss :: [*]) (ssss :: [*]).
SubmitInfo n sss svss ssss -> SubmitInfo n
submitInfoToMiddle SubmitInfo s1 s2 s3 s4
si SubmitInfo s1
-> PL SubmitInfo (MiddleNextList nssvsss)
-> PL SubmitInfo (s1 : MiddleNextList nssvsss)
forall {k} (t :: k -> *) (s :: k) (ss1 :: [k]).
t s -> PL t ss1 -> PL t (s : ss1)
:** PL (U4 SubmitInfo) ss1 -> PL SubmitInfo (MiddleNextList ss1)
forall (ns3s2s4 :: [(Maybe (*), [*], [*], [*])]).
SubmitInfoListToMiddle ns3s2s4 =>
PL (U4 SubmitInfo) ns3s2s4
-> PL SubmitInfo (MiddleNextList ns3s2s4)
submitInfoListToMiddle PL (U4 SubmitInfo) ss1
sis

submitInfoToMiddle ::
	SubmitInfo n sss svss ssss -> M.SubmitInfo n
submitInfoToMiddle :: forall (n :: Maybe (*)) (sss :: [*]) (svss :: [*]) (ssss :: [*]).
SubmitInfo n sss svss ssss -> SubmitInfo n
submitInfoToMiddle SubmitInfo {
	submitInfoNext :: forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> M n
submitInfoNext = M n
mnxt,
	submitInfoWaitSemaphoreDstStageMasks :: forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> PL SemaphorePipelineStageFlags sss
submitInfoWaitSemaphoreDstStageMasks =
		PL SemaphorePipelineStageFlags sss -> [(S, StageFlags)]
forall (sss :: [*]).
PL SemaphorePipelineStageFlags sss -> [(S, StageFlags)]
semaphorePipelineStageFlagsToMiddle -> [(S, StageFlags)]
wsdsms,
	submitInfoCommandBuffers :: forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> PL C ss
submitInfoCommandBuffers = (forall s. C s -> C) -> PL C svss -> [C]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList (\C s
x -> C s -> C
forall s. C s -> C
CommandBuffer.unC C s
x) -> [C]
cbs,
	submitInfoSignalSemaphores :: forall (n :: Maybe (*)) (sss :: [*]) (ss :: [*]) (ssss :: [*]).
SubmitInfo n sss ss ssss -> PL S ssss
submitInfoSignalSemaphores =
		(forall s. S s -> S) -> PL S ssss -> [S]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList (\(Semaphore.S S
s) -> S
s) -> [S]
ssmprs
	} = M.SubmitInfo {
	submitInfoNext :: M n
M.submitInfoNext = M n
mnxt,
	submitInfoWaitSemaphoreDstStageMasks :: [(S, StageFlags)]
M.submitInfoWaitSemaphoreDstStageMasks = [(S, StageFlags)]
wsdsms,
	submitInfoCommandBuffers :: [C]
M.submitInfoCommandBuffers = [C]
cbs,
	submitInfoSignalSemaphores :: [S]
M.submitInfoSignalSemaphores = [S]
ssmprs }

data SemaphorePipelineStageFlags ss =
	SemaphorePipelineStageFlags (Semaphore.S ss) Pipeline.StageFlags
	deriving Int -> SemaphorePipelineStageFlags ss -> ShowS
[SemaphorePipelineStageFlags ss] -> ShowS
SemaphorePipelineStageFlags ss -> String
(Int -> SemaphorePipelineStageFlags ss -> ShowS)
-> (SemaphorePipelineStageFlags ss -> String)
-> ([SemaphorePipelineStageFlags ss] -> ShowS)
-> Show (SemaphorePipelineStageFlags ss)
forall ss. Int -> SemaphorePipelineStageFlags ss -> ShowS
forall ss. [SemaphorePipelineStageFlags ss] -> ShowS
forall ss. SemaphorePipelineStageFlags ss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ss. Int -> SemaphorePipelineStageFlags ss -> ShowS
showsPrec :: Int -> SemaphorePipelineStageFlags ss -> ShowS
$cshow :: forall ss. SemaphorePipelineStageFlags ss -> String
show :: SemaphorePipelineStageFlags ss -> String
$cshowList :: forall ss. [SemaphorePipelineStageFlags ss] -> ShowS
showList :: [SemaphorePipelineStageFlags ss] -> ShowS
Show

-- deriving instance (Show n, Show (HeteroParList SemaphorePipelineStageFlags sss)) =>
--	Show (SubmitInfo n sss s vs)

-- deriving instance Show (HeteroParList Semaphore.S ss)

semaphorePipelineStageFlagsToMiddle ::
	HeteroParList.PL SemaphorePipelineStageFlags sss ->
	[(Semaphore.M.S, Pipeline.StageFlags)]
semaphorePipelineStageFlagsToMiddle :: forall (sss :: [*]).
PL SemaphorePipelineStageFlags sss -> [(S, StageFlags)]
semaphorePipelineStageFlagsToMiddle = (forall s. SemaphorePipelineStageFlags s -> (S, StageFlags))
-> PL SemaphorePipelineStageFlags sss -> [(S, StageFlags)]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList
	\(SemaphorePipelineStageFlags (Semaphore.S S
s) StageFlags
psfs) -> (S
s, StageFlags
psfs)

class SemaphorePipelineStageFlagsFromMiddle sss where
	semaphorePipelineStageFlagsFromMiddle ::
		[(Semaphore.M.S, Pipeline.StageFlags)] ->
		HeteroParList.PL SemaphorePipelineStageFlags sss

instance SemaphorePipelineStageFlagsFromMiddle '[] where
	semaphorePipelineStageFlagsFromMiddle :: [(S, StageFlags)] -> PL SemaphorePipelineStageFlags '[]
semaphorePipelineStageFlagsFromMiddle = \case
		[] -> PL SemaphorePipelineStageFlags '[]
forall {k} (t :: k -> *). PL t '[]
HeteroParList.Nil
		[(S, StageFlags)]
_ -> String -> PL SemaphorePipelineStageFlags '[]
forall a. HasCallStack => String -> a
error (String -> PL SemaphorePipelineStageFlags '[])
-> String -> PL SemaphorePipelineStageFlags '[]
forall a b. (a -> b) -> a -> b
$
			String
"semaphorePipelineStageFlagsFromMiddle @'[] xs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
			String
"xs should be null"

instance SemaphorePipelineStageFlagsFromMiddle sss =>
	SemaphorePipelineStageFlagsFromMiddle (ss ': sss) where
	semaphorePipelineStageFlagsFromMiddle :: [(S, StageFlags)] -> PL SemaphorePipelineStageFlags (ss : sss)
semaphorePipelineStageFlagsFromMiddle = \case
		(S
s, StageFlags
psfs) : [(S, StageFlags)]
spsfss ->
			S ss -> StageFlags -> SemaphorePipelineStageFlags ss
forall ss. S ss -> StageFlags -> SemaphorePipelineStageFlags ss
SemaphorePipelineStageFlags (S -> S ss
forall s. S -> S s
Semaphore.S S
s) StageFlags
psfs SemaphorePipelineStageFlags ss
-> PL SemaphorePipelineStageFlags sss
-> PL SemaphorePipelineStageFlags (ss : sss)
forall {k} (t :: k -> *) (s :: k) (ss1 :: [k]).
t s -> PL t ss1 -> PL t (s : ss1)
:**
			[(S, StageFlags)] -> PL SemaphorePipelineStageFlags sss
forall (sss :: [*]).
SemaphorePipelineStageFlagsFromMiddle sss =>
[(S, StageFlags)] -> PL SemaphorePipelineStageFlags sss
semaphorePipelineStageFlagsFromMiddle [(S, StageFlags)]
spsfss
		[] -> String -> PL SemaphorePipelineStageFlags (ss : sss)
forall a. HasCallStack => String -> a
error (String -> PL SemaphorePipelineStageFlags (ss : sss))
-> String -> PL SemaphorePipelineStageFlags (ss : sss)
forall a b. (a -> b) -> a -> b
$
			String
"semaphorePipelineStageFlagsFromMiddle " String -> ShowS
forall a. [a] -> [a] -> [a]
++
			String
"@(ss ': sss) xs: xs should not be null"

data LayerProperties = LayerProperties {
	LayerProperties -> LayerName
layerPropertiesLayerName :: LayerName,
	LayerProperties -> ApiVersion
layerPropertiesSpecVersion :: M.ApiVersion,
	LayerProperties -> ApiVersion
layerPropertiesImplementationVersion :: M.ApiVersion,
	LayerProperties -> Text
layerPropertiesDescription :: T.Text }
	deriving Int -> LayerProperties -> ShowS
[LayerProperties] -> ShowS
LayerProperties -> String
(Int -> LayerProperties -> ShowS)
-> (LayerProperties -> String)
-> ([LayerProperties] -> ShowS)
-> Show LayerProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayerProperties -> ShowS
showsPrec :: Int -> LayerProperties -> ShowS
$cshow :: LayerProperties -> String
show :: LayerProperties -> String
$cshowList :: [LayerProperties] -> ShowS
showList :: [LayerProperties] -> ShowS
Show

layerPropertiesFromMiddle :: M.LayerProperties -> LayerProperties
layerPropertiesFromMiddle :: LayerProperties -> LayerProperties
layerPropertiesFromMiddle M.LayerProperties {
	layerPropertiesLayerName :: LayerProperties -> Text
M.layerPropertiesLayerName = Text
ln,
	layerPropertiesSpecVersion :: LayerProperties -> ApiVersion
M.layerPropertiesSpecVersion = ApiVersion
sv,
	layerPropertiesImplementationVersion :: LayerProperties -> ApiVersion
M.layerPropertiesImplementationVersion = ApiVersion
iv,
	layerPropertiesDescription :: LayerProperties -> Text
M.layerPropertiesDescription = Text
dsc } = LayerProperties {
	layerPropertiesLayerName :: LayerName
layerPropertiesLayerName = Text -> LayerName
LayerName Text
ln,
	layerPropertiesSpecVersion :: ApiVersion
layerPropertiesSpecVersion = ApiVersion
sv,
	layerPropertiesImplementationVersion :: ApiVersion
layerPropertiesImplementationVersion = ApiVersion
iv,
	layerPropertiesDescription :: Text
layerPropertiesDescription = Text
dsc }

newtype LayerName = LayerName { LayerName -> Text
unLayerName :: T.Text } deriving (Int -> LayerName -> ShowS
[LayerName] -> ShowS
LayerName -> String
(Int -> LayerName -> ShowS)
-> (LayerName -> String)
-> ([LayerName] -> ShowS)
-> Show LayerName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayerName -> ShowS
showsPrec :: Int -> LayerName -> ShowS
$cshow :: LayerName -> String
show :: LayerName -> String
$cshowList :: [LayerName] -> ShowS
showList :: [LayerName] -> ShowS
Show, LayerName -> LayerName -> Bool
(LayerName -> LayerName -> Bool)
-> (LayerName -> LayerName -> Bool) -> Eq LayerName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayerName -> LayerName -> Bool
== :: LayerName -> LayerName -> Bool
$c/= :: LayerName -> LayerName -> Bool
/= :: LayerName -> LayerName -> Bool
Eq)

layerKhronosValidation :: LayerName
layerKhronosValidation :: LayerName
layerKhronosValidation = Text -> LayerName
LayerName Text
"VK_LAYER_KHRONOS_validation"