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

module Gpu.Vulkan.PipelineLayout (

	-- * CREATE

	create, P, CreateInfo(..), M.CreateFlags

	) where

import Foreign.Storable.PeekPoke
import Control.Exception
import Data.Kind
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.Tuple.Uncurry
import qualified Data.HeteroParList as HeteroParList

import Gpu.Vulkan.PipelineLayout.Type

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.DescriptorSetLayout.Type as DscStLyt
import qualified Gpu.Vulkan.PushConstant.Internal as PushConstant
import qualified Gpu.Vulkan.PipelineLayout.Middle as M

-- CREATE

create :: (
	WithPoked (TMaybe.M mn),
	HeteroParList.ToListT2 Type [DscStLyt.BindingType] lytas,
	PushConstant.RangeListToMiddle whole ranges,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd ->
	CreateInfo mn lytas ('PushConstant.Layout whole ranges) ->
	TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	(forall s . P s lytas whole -> IO a) -> IO a
create :: forall (mn :: Maybe (*)) (lytas :: [(*, [BindingType])])
       (whole :: [*]) (ranges :: [Range]) (mac :: Maybe (*, *)) sd a.
(WithPoked (M mn), ToListT2 (*) [BindingType] lytas,
 RangeListToMiddle whole ranges, ToMiddle mac) =>
D sd
-> CreateInfo mn lytas ('Layout whole ranges)
-> M (U2 A) mac
-> (forall s. P s lytas whole -> IO a)
-> IO a
create (Device.D D
dvc) (CreateInfo mn lytas ('Layout whole ranges) -> CreateInfo mn
forall (n :: Maybe (*)) k (lytas :: [(k, [BindingType])])
       (whole :: [*]) (ranges :: [Range]).
(RangeListToMiddle whole ranges, ToListT2 k [BindingType] lytas) =>
CreateInfo n lytas ('Layout whole ranges) -> CreateInfo n
createInfoToMiddle -> CreateInfo mn
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. P s lytas whole -> IO a
f =
	IO P -> (P -> IO ()) -> (P -> 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 P
forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO P
M.create D
dvc CreateInfo mn
ci M A (Snd mac)
mac) (\P
l -> D -> P -> M A (Snd mac) -> IO ()
forall (md :: Maybe (*)). D -> P -> M A md -> IO ()
M.destroy D
dvc P
l M A (Snd mac)
mac) (P Any lytas whole -> IO a
forall s. P s lytas whole -> IO a
f (P Any lytas whole -> IO a)
-> (P -> P Any lytas whole) -> P -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P -> P Any lytas whole
forall s (sbtss :: [(*, [BindingType])]) (pcw :: [*]).
P -> P s sbtss pcw
P)

-- CREATE INFO

data CreateInfo mn lytas (pcl :: PushConstant.Layout) = CreateInfo {
	forall {k} (mn :: Maybe (*)) (lytas :: [(k, [BindingType])])
       (pcl :: Layout).
CreateInfo mn lytas pcl -> M mn
createInfoNext :: TMaybe.M mn, forall {k} (mn :: Maybe (*)) (lytas :: [(k, [BindingType])])
       (pcl :: Layout).
CreateInfo mn lytas pcl -> CreateFlags
createInfoFlags :: M.CreateFlags,
	forall {k} (mn :: Maybe (*)) (lytas :: [(k, [BindingType])])
       (pcl :: Layout).
CreateInfo mn lytas pcl -> PL (U2 D) lytas
createInfoSetLayouts :: HeteroParList.PL (U2 DscStLyt.D) lytas }

deriving instance (
	Show (TMaybe.M mn), Show (HeteroParList.PL (U2 DscStLyt.D) lytas) ) =>
	Show (CreateInfo mn lytas pcl)

createInfoToMiddle :: forall n k lytas whole ranges . (
	PushConstant.RangeListToMiddle whole ranges,
	HeteroParList.ToListT2 k [DscStLyt.BindingType] lytas ) =>
	CreateInfo n lytas ('PushConstant.Layout whole ranges) -> M.CreateInfo n
createInfoToMiddle :: forall (n :: Maybe (*)) k (lytas :: [(k, [BindingType])])
       (whole :: [*]) (ranges :: [Range]).
(RangeListToMiddle whole ranges, ToListT2 k [BindingType] lytas) =>
CreateInfo n lytas ('Layout whole ranges) -> CreateInfo n
createInfoToMiddle CreateInfo {
	createInfoNext :: forall {k} (mn :: Maybe (*)) (lytas :: [(k, [BindingType])])
       (pcl :: Layout).
CreateInfo mn lytas pcl -> M mn
createInfoNext = M n
mnxt,
	createInfoFlags :: forall {k} (mn :: Maybe (*)) (lytas :: [(k, [BindingType])])
       (pcl :: Layout).
CreateInfo mn lytas pcl -> CreateFlags
createInfoFlags = CreateFlags
flgs,
	createInfoSetLayouts :: forall {k} (mn :: Maybe (*)) (lytas :: [(k, [BindingType])])
       (pcl :: Layout).
CreateInfo mn lytas pcl -> PL (U2 D) lytas
createInfoSetLayouts = (forall (s1 :: k) (s2 :: [BindingType]). U2 D '(s1, s2) -> D)
-> PL (U2 D) lytas -> [D]
forall k1 k2 (ss :: [(k1, k2)]) (t :: (k1, k2) -> *) a.
ToListT2 k1 k2 ss =>
(forall (s1 :: k1) (s2 :: k2). t '(s1, s2) -> a) -> PL t ss -> [a]
forall (t :: (k, [BindingType]) -> *) a.
(forall (s1 :: k) (s2 :: [BindingType]). t '(s1, s2) -> a)
-> PL t lytas -> [a]
HeteroParList.toListT2
		((forall (s1 :: k) (s2 :: [BindingType]). U2 D '(s1, s2) -> D)
 -> PL (U2 D) lytas -> [D])
-> (forall (s1 :: k) (s2 :: [BindingType]). U2 D '(s1, s2) -> D)
-> PL (U2 D) lytas
-> [D]
forall a b. (a -> b) -> a -> b
$ D s1 s2 -> D
forall {k} (s :: k) (bts :: [BindingType]). D s bts -> D
DscStLyt.unL (D s1 s2 -> D)
-> (U2 D '(s1, s2) -> D s1 s2) -> U2 D '(s1, s2) -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U2 D '(s1, s2) -> D s1 s2
forall {k1} {k2} (t :: k1 -> k2 -> *) (s1 :: k1) (s2 :: k2).
U2 t '(s1, s2) -> t s1 s2
unU2 -> [D]
sls } = M.CreateInfo {
	createInfoNext :: M n
M.createInfoNext = M n
mnxt,
	createInfoFlags :: CreateFlags
M.createInfoFlags = CreateFlags
flgs,
	createInfoSetLayouts :: [D]
M.createInfoSetLayouts = [D]
sls,
	createInfoPushConstantRanges :: [Range]
M.createInfoPushConstantRanges =
		forall (whole :: [*]) (ranges :: [Range]).
RangeListToMiddle whole ranges =>
[Range]
PushConstant.rangeListToMiddle @whole @ranges }