{-# language CPP #-}
-- No documentation found for Chapter "Shader"
module Vulkan.Core10.Shader  ( createShaderModule
                             , withShaderModule
                             , destroyShaderModule
                             , ShaderModuleCreateInfo(..)
                             , ShaderModule(..)
                             , 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 (allocaBytes)
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.Core10.Handles (Device(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.ShaderModuleCreateFlags (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.ShaderModuleCreateFlags (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

-- | vkCreateShaderModule - Creates a new shader module object
--
-- = Description
--
-- Once a shader module has been created, any entry points it contains
-- /can/ be used in pipeline shader stages as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#pipelines-compute Compute Pipelines>
-- and
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#pipelines-graphics Graphics Pipelines>.
--
-- == Valid Usage
--
-- -   #VUID-vkCreateShaderModule-pCreateInfo-06904# If @pCreateInfo@ is
--     not @NULL@, @pCreateInfo->pNext@ /must/ be @NULL@ or a pointer to a
--     'Vulkan.Extensions.VK_EXT_validation_cache.ShaderModuleValidationCacheCreateInfoEXT'
--     structure
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateShaderModule-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateShaderModule-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'ShaderModuleCreateInfo'
--     structure
--
-- -   #VUID-vkCreateShaderModule-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateShaderModule-pShaderModule-parameter# @pShaderModule@
--     /must/ be a valid pointer to a 'Vulkan.Core10.Handles.ShaderModule'
--     handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INVALID_SHADER_NV'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.ShaderModule',
-- 'ShaderModuleCreateInfo'
createShaderModule :: forall a io
                    . ( Extendss ShaderModuleCreateInfo a
                      , PokeChain a
                      , MonadIO io )
                   => -- | @device@ is the logical device that creates the shader module.
                      Device
                   -> -- | @pCreateInfo@ is a pointer to a 'ShaderModuleCreateInfo' structure.
                      (ShaderModuleCreateInfo a)
                   -> -- | @pAllocator@ controls host memory allocation as described in the
                      -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                      -- chapter.
                      ("allocator" ::: Maybe AllocationCallbacks)
                   -> io (ShaderModule)
createShaderModule :: forall (a :: [*]) (io :: * -> *).
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT 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 (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateShaderModule is null" forall a. Maybe a
Nothing 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 <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ 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
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pShaderModule" ::: Ptr ShaderModule
pPShaderModule <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @ShaderModule Int
8) forall a. Ptr a -> IO ()
free
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateShaderModule" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule'
                                                         (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                         (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ShaderModuleCreateInfo a)
pCreateInfo)
                                                         "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                         ("pShaderModule" ::: Ptr ShaderModule
pPShaderModule))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  ShaderModule
pShaderModule <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @ShaderModule "pShaderModule" ::: Ptr ShaderModule
pPShaderModule
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ShaderModule
pShaderModule)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createShaderModule' and 'destroyShaderModule'
--
-- To ensure that 'destroyShaderModule' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withShaderModule :: forall a io r . (Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) => Device -> ShaderModuleCreateInfo a -> Maybe AllocationCallbacks -> (io ShaderModule -> (ShaderModule -> io ()) -> r) -> r
withShaderModule :: forall (a :: [*]) (io :: * -> *) r.
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io ShaderModule -> (ShaderModule -> io ()) -> r)
-> r
withShaderModule Device
device ShaderModuleCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io ShaderModule -> (ShaderModule -> io ()) -> r
b =
  io ShaderModule -> (ShaderModule -> io ()) -> r
b (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) -> 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 ()

-- | vkDestroyShaderModule - Destroy a shader module
--
-- = Description
--
-- A shader module /can/ be destroyed while pipelines created using its
-- shaders are still in use.
--
-- == Valid Usage
--
-- -   #VUID-vkDestroyShaderModule-shaderModule-01092# If
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @shaderModule@ was created, a compatible set of
--     callbacks /must/ be provided here
--
-- -   #VUID-vkDestroyShaderModule-shaderModule-01093# If no
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @shaderModule@ was created, @pAllocator@ /must/ be
--     @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyShaderModule-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyShaderModule-shaderModule-parameter# If
--     @shaderModule@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shaderModule@ /must/ be a valid
--     'Vulkan.Core10.Handles.ShaderModule' handle
--
-- -   #VUID-vkDestroyShaderModule-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyShaderModule-shaderModule-parent# If @shaderModule@
--     is a valid handle, it /must/ have been created, allocated, or
--     retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @shaderModule@ /must/ be externally synchronized
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.ShaderModule'
destroyShaderModule :: forall io
                     . (MonadIO io)
                    => -- | @device@ is the logical device that destroys the shader module.
                       Device
                    -> -- | @shaderModule@ is the handle of the shader module to destroy.
                       ShaderModule
                    -> -- | @pAllocator@ controls host memory allocation as described in the
                       -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                       -- chapter.
                       ("allocator" ::: Maybe AllocationCallbacks)
                    -> io ()
destroyShaderModule :: forall (io :: * -> *).
MonadIO io =>
Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
shaderModule "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT 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 (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ShaderModule
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyShaderModulePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyShaderModule is null" forall a. Maybe a
Nothing 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
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyShaderModule" (Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyShaderModule'
                                                     (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                     (ShaderModule
shaderModule)
                                                     "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


-- | VkShaderModuleCreateInfo - Structure specifying parameters of a newly
-- created shader module
--
-- == Valid Usage
--
-- -   #VUID-VkShaderModuleCreateInfo-codeSize-01085# @codeSize@ /must/ be
--     greater than 0
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01376# If @pCode@ is a pointer
--     to SPIR-V code, @codeSize@ /must/ be a multiple of 4
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01377# @pCode@ /must/ point to
--     either valid SPIR-V code, formatted and packed as described by the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirv-spec Khronos SPIR-V Specification>
--     or valid GLSL code which /must/ be written to the
--     @GL_KHR_vulkan_glsl@ extension specification
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01378# If @pCode@ is a pointer
--     to SPIR-V code, that code /must/ adhere to the validation rules
--     described by the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-module-validation Validation Rules within a Module>
--     section of the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-capabilities SPIR-V Environment>
--     appendix
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01379# If @pCode@ is a pointer
--     to GLSL code, it /must/ be valid GLSL code written to the
--     @GL_KHR_vulkan_glsl@ GLSL extension specification
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01089# @pCode@ /must/ declare
--     the @Shader@ capability for SPIR-V code
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01090# @pCode@ /must/ not
--     declare any capability that is not supported by the API, as
--     described by the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-module-validation Capabilities>
--     section of the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-capabilities SPIR-V Environment>
--     appendix
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-01091# If @pCode@ declares any
--     of the capabilities listed in the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-capabilities-table SPIR-V Environment>
--     appendix, one of the corresponding requirements /must/ be satisfied
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-04146# @pCode@ /must/ not
--     declare any SPIR-V extension that is not supported by the API, as
--     described by the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-extensions Extension>
--     section of the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-capabilities SPIR-V Environment>
--     appendix
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-04147# If @pCode@ declares any
--     of the SPIR-V extensions listed in the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-extensions-table SPIR-V Environment>
--     appendix, one of the corresponding requirements /must/ be satisfied
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkShaderModuleCreateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO'
--
-- -   #VUID-VkShaderModuleCreateInfo-flags-zerobitmask# @flags@ /must/ be
--     @0@
--
-- -   #VUID-VkShaderModuleCreateInfo-pCode-parameter# @pCode@ /must/ be a
--     valid pointer to an array of \(\textrm{codeSize} \over 4\)
--     @uint32_t@ values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.ShaderModuleCreateFlags.ShaderModuleCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createShaderModule',
-- 'Vulkan.Extensions.VK_EXT_shader_module_identifier.getShaderModuleCreateInfoIdentifierEXT'
data ShaderModuleCreateInfo (es :: [Type]) = ShaderModuleCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
flags :: ShaderModuleCreateFlags
  , -- | @pCode@ is a pointer to code that is used to create the shader module.
    -- The type and format of the code is determined from the content of the
    -- memory addressed by @pCode@.
    forall (es :: [*]). 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 = String
"ShaderModuleCreateInfo"
  setNext :: forall (ds :: [*]) (es :: [*]).
ShaderModuleCreateInfo ds -> Chain es -> ShaderModuleCreateInfo es
setNext ShaderModuleCreateInfo{ByteString
Chain ds
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
next :: Chain ds
$sel:code:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
$sel:flags:ShaderModuleCreateInfo :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
$sel:next:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
..} Chain es
next' = ShaderModuleCreateInfo{$sel:next:ShaderModuleCreateInfo :: Chain es
next = Chain es
next', ByteString
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
$sel:code:ShaderModuleCreateInfo :: ByteString
$sel:flags:ShaderModuleCreateInfo :: ShaderModuleCreateFlags
..}
  getNext :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
getNext ShaderModuleCreateInfo{ByteString
Chain es
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
next :: Chain es
$sel:code:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
$sel:flags:ShaderModuleCreateInfo :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
$sel:next:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends ShaderModuleCreateInfo e => b
f
    | Just e :~: ShaderModuleValidationCacheCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ShaderModuleValidationCacheCreateInfoEXT = forall a. a -> Maybe a
Just Extends ShaderModuleCreateInfo e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss ShaderModuleCreateInfo es
         , PokeChain es ) => ToCStruct (ShaderModuleCreateInfo es) where
  withCStruct :: forall b.
ShaderModuleCreateInfo es
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
withCStruct ShaderModuleCreateInfo es
x Ptr (ShaderModuleCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr (ShaderModuleCreateInfo es)
p -> 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 :: forall b.
Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo{ByteString
Chain es
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
next :: Chain es
$sel:code:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
$sel:flags:ShaderModuleCreateInfo :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
$sel:next:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderModuleCreateFlags)) (ShaderModuleCreateFlags
flags)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CSize)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Data.ByteString.length (ByteString
code))
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
Data.ByteString.length (ByteString
code) forall a. Bits a => a -> a -> a
.&. Int
3 forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
      forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"code size must be a multiple of 4" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    CString
unalignedCode <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString (ByteString
code)
    Ptr Word32
pCode'' <- if forall a. Ptr a -> WordPtr
ptrToWordPtr CString
unalignedCode forall a. Bits a => a -> a -> a
.&. WordPtr
3 forall a. Eq a => a -> a -> Bool
== WordPtr
0
      -- If this pointer is already aligned properly then use it
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr @CChar @Word32 CString
unalignedCode
      -- Otherwise allocate and copy the bytes
      else do
        let len :: Int
len = ByteString -> Int
Data.ByteString.length (ByteString
code)
        Ptr Word32
mem <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 Int
len
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word32
mem (forall a b. Ptr a -> Ptr b
castPtr @CChar @Word32 CString
unalignedCode) Int
len
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Word32
mem
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word32))) Ptr Word32
pCode''
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (ShaderModuleCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (ShaderModuleCreateInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 Ptr (ShaderModuleCreateInfo es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    ShaderModuleCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @ShaderModuleCreateFlags ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderModuleCreateFlags))
    CSize
codeSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CSize))
    Ptr Word32
pCode <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word32)))
    ByteString
code <- CStringLen -> IO ByteString
packCStringLen ( forall a b. Ptr a -> Ptr b
castPtr @Word32 @CChar Ptr Word32
pCode
                           , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
codeSize) forall a. Num a => a -> a -> a
* Word64
4 )
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 = forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
ShaderModuleCreateInfo
           ()
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty