{-# LINE 1 "src/Gpu/Vulkan/PipelineLayout/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.PipelineLayout.Middle.Internal (
	P(..), CreateInfo(..), CreateFlags, create, destroy
	) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Foreign.C.Enum
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Default
import Data.Bits
import Data.Word

import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.DescriptorSetLayout.Middle.Internal as DescriptorSet.Layout
import qualified Gpu.Vulkan.PushConstant.Middle.Internal as PushConstant
import qualified Gpu.Vulkan.PipelineLayout.Core as C



enum "CreateFlags" ''Word32
{-# LINE 40 "src/Gpu/Vulkan/PipelineLayout/Middle/Internal.hsc" #-}
	[''Show, ''Storable, ''Eq, ''Bits] [("CreateFlagsZero", 0)]

instance Default CreateFlags where def :: CreateFlags
def = CreateFlags
CreateFlagsZero

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> [D]
createInfoSetLayouts :: [DescriptorSet.Layout.D],
	forall (mn :: Maybe (*)). CreateInfo mn -> [Range]
createInfoPushConstantRanges :: [PushConstant.Range] }

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

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlags Word32
flgs,
	createInfoSetLayouts :: forall (mn :: Maybe (*)). CreateInfo mn -> [D]
createInfoSetLayouts =
		([D] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([D] -> Int) -> ([D] -> [D]) -> [D] -> (Int, [D])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((\(DescriptorSet.Layout.D D
lyt) -> D
lyt) (D -> D) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) ->
			(Int
slc, [D]
sls),
	createInfoPushConstantRanges :: forall (mn :: Maybe (*)). CreateInfo mn -> [Range]
createInfoPushConstantRanges = (
		[Range] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Range] -> Int)
-> ([Range] -> [Range]) -> [Range] -> (Int, [Range])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
		(Range -> Range
PushConstant.rangeToCore (Range -> Range) -> [Range] -> [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) -> (Int
pcrc, [Range]
pcrs) } Ptr CreateInfo -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') -> 
	Int -> (Ptr D -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
slc \Ptr D
psls ->
	Ptr D -> [D] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr D
psls [D]
sls IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> (Ptr Range -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
pcrc \Ptr Range
ppcrs ->
	Ptr Range -> [Range] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Range
ppcrs [Range]
pcrs IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	let ci :: CreateInfo
ci = C.CreateInfo {
		createInfoSType :: ()
C.createInfoSType = (),
		createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
		createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
		createInfoSetLayoutCount :: Word32
C.createInfoSetLayoutCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slc,
		createInfoPSetLayouts :: Ptr D
C.createInfoPSetLayouts = Ptr D
psls,
		createInfoPushConstantRangeCount :: Word32
C.createInfoPushConstantRangeCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pcrc,
		createInfoPPushConstantRanges :: Ptr Range
C.createInfoPPushConstantRanges = Ptr Range
ppcrs } in
	CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked CreateInfo
ci Ptr CreateInfo -> IO a
f

newtype P = P C.P deriving Int -> P -> ShowS
[P] -> ShowS
P -> String
(Int -> P -> ShowS) -> (P -> String) -> ([P] -> ShowS) -> Show P
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P -> ShowS
showsPrec :: Int -> P -> ShowS
$cshow :: P -> String
show :: P -> String
$cshowList :: [P] -> ShowS
showList :: [P] -> ShowS
Show

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO P
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO P
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = P -> P
P (P -> P) -> IO P -> IO P
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr P -> IO P) -> IO P
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr P
pl -> do
	CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn
ci \Ptr CreateInfo
pci ->
		M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac -> do
			r <- D -> Ptr CreateInfo -> Ptr A -> Ptr P -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr P
pl
			throwUnlessSuccess $ Result r
	Ptr P -> IO P
forall a. Storable a => Ptr a -> IO a
peek Ptr P
pl

destroy :: Device.D -> P -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> P -> M A md -> IO ()
destroy (Device.D D
dvc) (P P
lyt) M A md
mac =
	M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ D -> P -> Ptr A -> IO ()
C.destroy D
dvc P
lyt