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

module Gpu.Vulkan.ShaderModule.Middle.Internal where

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

import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS

import Language.SpirV.Internal qualified as SpirV
import Language.SpirV.ShaderKind qualified as SpirV

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.ShaderModule.Core as C



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

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

type CreateFlags = CreateFlagBits

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

data CreateInfo mn sknd = CreateInfo {
	forall (mn :: Maybe (*)) (sknd :: ShaderKind).
CreateInfo mn sknd -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (sknd :: ShaderKind).
CreateInfo mn sknd -> CreateFlagBits
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)) (sknd :: ShaderKind).
CreateInfo mn sknd -> S sknd
createInfoCode :: SpirV.S sknd }

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

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn sknd -> (Ptr C.CreateInfo -> IO r) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) (sknd :: ShaderKind) r.
WithPoked (M mn) =>
CreateInfo mn sknd -> (Ptr CreateInfo -> IO r) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)) (sknd :: ShaderKind).
CreateInfo mn sknd -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)) (sknd :: ShaderKind).
CreateInfo mn sknd -> CreateFlagBits
createInfoFlags = CreateFlagBits Word32
flgs,
	createInfoCode :: forall (mn :: Maybe (*)) (sknd :: ShaderKind).
CreateInfo mn sknd -> S sknd
createInfoCode = S sknd
cd } Ptr CreateInfo -> IO r
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 r) -> 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') -> do
		(p, n) <- ByteString -> IO (Ptr Word32, Word64)
readFromByteString (ByteString -> IO (Ptr Word32, Word64))
-> ByteString -> IO (Ptr Word32, Word64)
forall a b. (a -> b) -> a -> b
$ (\(SpirV.S ByteString
spv) -> ByteString
spv) S sknd
cd
		let ci = C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoCodeSize :: Word64
C.createInfoCodeSize = Word64
n,
			createInfoPCode :: Ptr Word32
C.createInfoPCode = Ptr Word32
p }
		withPoked ci f

readFromByteString :: BS.ByteString -> IO (Ptr Word32, Word64)
readFromByteString :: ByteString -> IO (Ptr Word32, Word64)
readFromByteString (BS.PS ForeignPtr Word8
f Int
o Int
l) = do
	p' <- Int -> IO (Ptr Word32)
forall a. Int -> IO (Ptr a)
mallocBytes Int
l
	withForeignPtr f \Ptr Word8
p -> Ptr Word32 -> Ptr Word32 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word32
p' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) Int
l
	pure (p', fromIntegral l)

create :: WithPoked (TMaybe.M mn) =>
	Device.D ->
	CreateInfo mn sknd -> TPMaybe.M AllocationCallbacks.A mc -> IO (S sknd)
create :: forall (mn :: Maybe (*)) (sknd :: ShaderKind) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn sknd -> M A mc -> IO (S sknd)
create (Device.D D
dvc) CreateInfo mn sknd
ci M A mc
mac = S -> S sknd
forall (sknd :: ShaderKind). S -> S sknd
S (S -> S sknd) -> IO S -> IO (S sknd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr S -> IO S) -> IO S
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr S
pm -> do
	CreateInfo mn sknd -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (sknd :: ShaderKind) r.
WithPoked (M mn) =>
CreateInfo mn sknd -> (Ptr CreateInfo -> IO r) -> IO ()
createInfoToCore CreateInfo mn sknd
ci \Ptr CreateInfo
pcci ->
		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 S -> IO Int32
C.create D
dvc Ptr CreateInfo
pcci Ptr A
pac Ptr S
pm
			throwUnlessSuccess $ Result r
	Ptr S -> IO S
forall a. Storable a => Ptr a -> IO a
peek Ptr S
pm

destroy :: Device.D -> S sknd -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (sknd :: ShaderKind) (md :: Maybe (*)).
D -> S sknd -> M A md -> IO ()
destroy (Device.D D
dvc) (S S
m) 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 -> S -> Ptr A -> IO ()
C.destroy D
dvc S
m