{-# 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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#pipelines-compute Compute Pipelines>
-- and
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#pipelines-graphics Graphics Pipelines>.
--
-- == 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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                      -- chapter.
                      ("allocator" ::: Maybe AllocationCallbacks)
                   -> io (ShaderModule)
createShaderModule :: Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
createInfo "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 (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 String
"" String
"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
    "allocator" ::: Maybe AllocationCallbacks
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 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 Int
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 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)) (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)

-- | 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 :: 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 (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 ()

-- | 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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                       -- chapter.
                       ("allocator" ::: Maybe AllocationCallbacks)
                    -> io ()
destroyShaderModule :: Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
shaderModule "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 (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 String
"" String
"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
    "allocator" ::: Maybe AllocationCallbacks
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 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 String
"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
$ ()


-- | 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://www.khronos.org/registry/vulkan/specs/1.2-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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#spirvenv-module-validation Validation Rules within a Module>
--     section of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#spirvenv-module-validation Capabilities>
--     section of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-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://www.khronos.org/registry/vulkan/specs/1.2-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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#spirvenv-extensions Extension>
--     section of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-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://www.khronos.org/registry/vulkan/specs/1.2-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-pNext-pNext# @pNext@ /must/ be @NULL@
--     or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_validation_cache.ShaderModuleValidationCacheCreateInfoEXT'
--
-- -   #VUID-VkShaderModuleCreateInfo-sType-unique# The @sType@ value of
--     each struct in the @pNext@ chain /must/ be unique
--
-- -   #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'
data ShaderModuleCreateInfo (es :: [Type]) = ShaderModuleCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    ShaderModuleCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    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@.
    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 :: 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 :: forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
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 :: 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 :: proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends ShaderModuleCreateInfo e => b
f
    | Just e :~: ShaderModuleValidationCacheCreateInfoEXT
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 ShaderModuleCreateInfo es
x Ptr (ShaderModuleCreateInfo es) -> IO b
f = Int -> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b)
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \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 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 = 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` Int
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` Int
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` Int
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` Int
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
.&. Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 String
"" String
"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
.&. WordPtr
3 WordPtr -> WordPtr -> Bool
forall a. Eq a => a -> a -> Bool
== WordPtr
0
      -- If this pointer is already aligned properly then use it
      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
      -- Otherwise allocate and copy the bytes
      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 -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 Int
len
        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` Int
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 = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (ShaderModuleCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (ShaderModuleCreateInfo es)
p 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` Int
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` Int
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 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` Int
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` Int
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` Int
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` Int
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
coerce @CSize @Word64 CSize
codeSize) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
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