{-# language CPP #-}
module Vulkan.Core10.Shader ( createShaderModule
, withShaderModule
, destroyShaderModule
, ShaderModuleCreateInfo(..)
, ShaderModule(..)
, ShaderModuleCreateFlagBits(..)
, ShaderModuleCreateFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Bits ((.&.))
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (ptrToWordPtr)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import qualified Data.ByteString (length)
import Data.ByteString (packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkCreateShaderModule))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyShaderModule))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (ShaderModule)
import Vulkan.Core10.Handles (ShaderModule(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlagBits (ShaderModuleCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_cache (ShaderModuleValidationCacheCreateInfoEXT)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (ShaderModule(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlagBits (ShaderModuleCreateFlagBits(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlagBits (ShaderModuleCreateFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateShaderModule
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct ShaderModuleCreateInfo) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct ShaderModuleCreateInfo) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result
createShaderModule :: forall a io
. (Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(ShaderModuleCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (ShaderModule)
createShaderModule :: Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule device :: Device
device createInfo :: ShaderModuleCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO ShaderModule -> io ShaderModule
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShaderModule -> io ShaderModule)
-> (ContT ShaderModule IO ShaderModule -> IO ShaderModule)
-> ContT ShaderModule IO ShaderModule
-> io ShaderModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ShaderModule IO ShaderModule -> IO ShaderModule
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ShaderModule IO ShaderModule -> io ShaderModule)
-> ContT ShaderModule IO ShaderModule -> io ShaderModule
forall a b. (a -> b) -> a -> b
$ do
let vkCreateShaderModulePtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
vkCreateShaderModulePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
pVkCreateShaderModule (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT ShaderModule IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ShaderModule IO ())
-> IO () -> ContT ShaderModule IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
vkCreateShaderModulePtr FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateShaderModule is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateShaderModule' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
mkVkCreateShaderModule FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
vkCreateShaderModulePtr
Ptr (ShaderModuleCreateInfo a)
pCreateInfo <- ((Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr (ShaderModuleCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr (ShaderModuleCreateInfo a)))
-> ((Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO (Ptr (ShaderModuleCreateInfo a))
forall a b. (a -> b) -> a -> b
$ ShaderModuleCreateInfo a
-> (Ptr (ShaderModuleCreateInfo a) -> IO ShaderModule)
-> IO ShaderModule
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ShaderModuleCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT ShaderModule IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT
ShaderModule IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ShaderModule)
-> IO ShaderModule
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pShaderModule" ::: Ptr ShaderModule
pPShaderModule <- ((("pShaderModule" ::: Ptr ShaderModule) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO ("pShaderModule" ::: Ptr ShaderModule)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pShaderModule" ::: Ptr ShaderModule) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO ("pShaderModule" ::: Ptr ShaderModule))
-> ((("pShaderModule" ::: Ptr ShaderModule) -> IO ShaderModule)
-> IO ShaderModule)
-> ContT ShaderModule IO ("pShaderModule" ::: Ptr ShaderModule)
forall a b. (a -> b) -> a -> b
$ IO ("pShaderModule" ::: Ptr ShaderModule)
-> (("pShaderModule" ::: Ptr ShaderModule) -> IO ())
-> (("pShaderModule" ::: Ptr ShaderModule) -> IO ShaderModule)
-> IO ShaderModule
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pShaderModule" ::: Ptr ShaderModule)
forall a. Int -> IO (Ptr a)
callocBytes @ShaderModule 8) ("pShaderModule" ::: Ptr ShaderModule) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT ShaderModule IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ShaderModule IO Result)
-> IO Result -> ContT ShaderModule IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkCreateShaderModule" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (ShaderModuleCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ShaderModuleCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pShaderModule" ::: Ptr ShaderModule
pPShaderModule))
IO () -> ContT ShaderModule IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ShaderModule IO ())
-> IO () -> ContT ShaderModule IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
ShaderModule
pShaderModule <- IO ShaderModule -> ContT ShaderModule IO ShaderModule
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ShaderModule -> ContT ShaderModule IO ShaderModule)
-> IO ShaderModule -> ContT ShaderModule IO ShaderModule
forall a b. (a -> b) -> a -> b
$ ("pShaderModule" ::: Ptr ShaderModule) -> IO ShaderModule
forall a. Storable a => Ptr a -> IO a
peek @ShaderModule "pShaderModule" ::: Ptr ShaderModule
pPShaderModule
ShaderModule -> ContT ShaderModule IO ShaderModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShaderModule -> ContT ShaderModule IO ShaderModule)
-> ShaderModule -> ContT ShaderModule IO ShaderModule
forall a b. (a -> b) -> a -> b
$ (ShaderModule
pShaderModule)
withShaderModule :: forall a io r . (Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) => Device -> ShaderModuleCreateInfo a -> Maybe AllocationCallbacks -> (io ShaderModule -> (ShaderModule -> io ()) -> r) -> r
withShaderModule :: Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io ShaderModule -> (ShaderModule -> io ()) -> r)
-> r
withShaderModule device :: Device
device pCreateInfo :: ShaderModuleCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io ShaderModule -> (ShaderModule -> io ()) -> r
b =
io ShaderModule -> (ShaderModule -> io ()) -> r
b (Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
forall (a :: [*]) (io :: * -> *).
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(ShaderModule
o0) -> Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyShaderModule
:: FunPtr (Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()
destroyShaderModule :: forall io
. (MonadIO io)
=>
Device
->
ShaderModule
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule :: Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule device :: Device
device shaderModule :: ShaderModule
shaderModule allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkDestroyShaderModulePtr :: FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyShaderModulePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyShaderModule (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyShaderModulePtr FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroyShaderModule is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroyShaderModule' :: Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyShaderModule' = FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyShaderModule FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyShaderModulePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent "vkDestroyShaderModule" (Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyShaderModule' (Device -> Ptr Device_T
deviceHandle (Device
device)) (ShaderModule
shaderModule) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
() -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()
data ShaderModuleCreateInfo (es :: [Type]) = ShaderModuleCreateInfo
{
ShaderModuleCreateInfo es -> Chain es
next :: Chain es
,
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
flags :: ShaderModuleCreateFlags
,
ShaderModuleCreateInfo es -> ByteString
code :: ByteString
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ShaderModuleCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ShaderModuleCreateInfo es)
instance Extensible ShaderModuleCreateInfo where
extensibleTypeName :: String
extensibleTypeName = "ShaderModuleCreateInfo"
setNext :: ShaderModuleCreateInfo ds -> Chain es -> ShaderModuleCreateInfo es
setNext x :: ShaderModuleCreateInfo ds
x next :: Chain es
next = ShaderModuleCreateInfo ds
x{$sel:next:ShaderModuleCreateInfo :: Chain es
next = Chain es
next}
getNext :: ShaderModuleCreateInfo es -> Chain es
getNext ShaderModuleCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends :: proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends _ f :: Extends ShaderModuleCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable ShaderModuleValidationCacheCreateInfoEXT) =>
Maybe (e :~: ShaderModuleValidationCacheCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ShaderModuleValidationCacheCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ShaderModuleCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss ShaderModuleCreateInfo es, PokeChain es) => ToCStruct (ShaderModuleCreateInfo es) where
withCStruct :: ShaderModuleCreateInfo es
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
withCStruct x :: ShaderModuleCreateInfo es
x f :: Ptr (ShaderModuleCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b)
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (ShaderModuleCreateInfo es)
p -> Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo es
x (Ptr (ShaderModuleCreateInfo es) -> IO b
f Ptr (ShaderModuleCreateInfo es)
p)
pokeCStruct :: Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ShaderModuleCreateFlags -> ShaderModuleCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es)
-> Int -> Ptr ShaderModuleCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ShaderModuleCreateFlags)) (ShaderModuleCreateFlags
flags)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr CSize)) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Data.ByteString.length (ByteString
code))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
Data.ByteString.length (ByteString
code) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "code size must be a multiple of 4" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
CString
unalignedCode <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString (ByteString
code)
Ptr Word32
pCode'' <- if CString -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr CString
unalignedCode WordPtr -> WordPtr -> WordPtr
forall a. Bits a => a -> a -> a
.&. 3 WordPtr -> WordPtr -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then Ptr Word32 -> ContT b IO (Ptr Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word32 -> ContT b IO (Ptr Word32))
-> Ptr Word32 -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr @CChar @Word32 CString
unalignedCode
else do
let len :: Int
len = ByteString -> Int
Data.ByteString.length (ByteString
code)
Ptr Word32
mem <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 Int
len 4
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Ptr Word32 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word32
mem (CString -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr @CChar @Word32 CString
unalignedCode) Int
len
Ptr Word32 -> ContT b IO (Ptr Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Word32
mem
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Word32))) Ptr Word32
pCode''
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 40
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (ShaderModuleCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (ShaderModuleCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss ShaderModuleCreateInfo es, PeekChain es) => FromCStruct (ShaderModuleCreateInfo es) where
peekCStruct :: Ptr (ShaderModuleCreateInfo es) -> IO (ShaderModuleCreateInfo es)
peekCStruct p :: Ptr (ShaderModuleCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
ShaderModuleCreateFlags
flags <- Ptr ShaderModuleCreateFlags -> IO ShaderModuleCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @ShaderModuleCreateFlags ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es)
-> Int -> Ptr ShaderModuleCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ShaderModuleCreateFlags))
CSize
codeSize <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr CSize))
Ptr Word32
pCode <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr (ShaderModuleCreateInfo es)
p Ptr (ShaderModuleCreateInfo es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Word32)))
ByteString
code <- CStringLen -> IO ByteString
packCStringLen (Ptr Word32 -> CString
forall a b. Ptr a -> Ptr b
castPtr @Word32 @CChar Ptr Word32
pCode, Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ (CSize -> Word64
forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
codeSize) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* 4)
ShaderModuleCreateInfo es -> IO (ShaderModuleCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShaderModuleCreateInfo es -> IO (ShaderModuleCreateInfo es))
-> ShaderModuleCreateInfo es -> IO (ShaderModuleCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
ShaderModuleCreateInfo
Chain es
next ShaderModuleCreateFlags
flags ByteString
code
instance es ~ '[] => Zero (ShaderModuleCreateInfo es) where
zero :: ShaderModuleCreateInfo es
zero = Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
ShaderModuleCreateInfo
()
ShaderModuleCreateFlags
forall a. Zero a => a
zero
ByteString
forall a. Monoid a => a
mempty