{-# language CPP #-}
module Vulkan.Core10.Shader  ( createShaderModule
                             , withShaderModule
                             , destroyShaderModule
                             , ShaderModuleCreateInfo(..)
                             ) where

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 Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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(CSize))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
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 (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
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.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateShaderModule
  :: FunPtr (Ptr Device_T -> Ptr (ShaderModuleCreateInfo a) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result) -> Ptr Device_T -> Ptr (ShaderModuleCreateInfo a) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result

-- | vkCreateShaderModule - Creates a new shader module object
--
-- = Parameters
--
-- -   @device@ is the logical device that creates the shader module.
--
-- -   @pCreateInfo@ is a pointer to a 'ShaderModuleCreateInfo' structure.
--
-- -   @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.
--
-- -   @pShaderModule@ is a pointer to a
--     'Vulkan.Core10.Handles.ShaderModule' handle in which the resulting
--     shader module object is returned.
--
-- = 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>.
--
-- If the shader stage fails to compile
-- 'Vulkan.Core10.Enums.Result.ERROR_INVALID_SHADER_NV' will be generated
-- and the compile log will be reported back to the application by
-- @VK_EXT_debug_report@ if enabled.
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'ShaderModuleCreateInfo' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @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
--
-- '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 -> 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 (ShaderModuleCreateInfo a))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pShaderModule" ::: Ptr ShaderModule)
   -> IO Result)
vkCreateShaderModulePtr = DeviceCmds
-> forall (a :: [*]).
   FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
      -> ("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 (ShaderModuleCreateInfo a))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pShaderModule" ::: Ptr ShaderModule)
   -> IO Result)
vkCreateShaderModulePtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pShaderModule" ::: Ptr ShaderModule)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pShaderModule" ::: Ptr ShaderModule)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
   -> ("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 (ShaderModuleCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pShaderModule" ::: Ptr ShaderModule)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
forall (a :: [*]).
FunPtr
  (Ptr Device_T
   -> Ptr (ShaderModuleCreateInfo a)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pShaderModule" ::: Ptr ShaderModule)
   -> IO Result)
-> Ptr Device_T
-> Ptr (ShaderModuleCreateInfo a)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
mkVkCreateShaderModule FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pShaderModule" ::: Ptr ShaderModule)
   -> IO Result)
vkCreateShaderModulePtr
  "pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a)
pCreateInfo <- ((("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
  -> IO ShaderModule)
 -> IO ShaderModule)
-> ContT
     ShaderModule IO ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
   -> IO ShaderModule)
  -> IO ShaderModule)
 -> ContT
      ShaderModule IO ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a)))
-> ((("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
     -> IO ShaderModule)
    -> IO ShaderModule)
-> ContT
     ShaderModule IO ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
forall a b. (a -> b) -> a -> b
$ ShaderModuleCreateInfo a
-> (("pCreateInfo" ::: 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
$ Ptr Device_T
-> ("pCreateInfo" ::: Ptr (ShaderModuleCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pCreateInfo" ::: 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 first argument.
-- To just extract the pair pass '(,)' as the first 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
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 ()

-- | vkDestroyShaderModule - Destroy a shader module
--
-- = Parameters
--
-- -   @device@ is the logical device that destroys the shader module.
--
-- -   @shaderModule@ is the handle of the shader module to destroy.
--
-- -   @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.
--
-- = Description
--
-- A shader module /can/ be destroyed while pipelines created using its
-- shaders are still in use.
--
-- == Valid Usage
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @shaderModule@ was created, a compatible set of
--     callbacks /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @shaderModule@ was created, @pAllocator@ /must/ be
--     @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @shaderModule@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shaderModule@ /must/ be a valid
--     'Vulkan.Core10.Handles.ShaderModule' handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   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
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.ShaderModule'
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
$ 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
--
-- -   @codeSize@ /must/ be greater than 0
--
-- -   If @pCode@ is a pointer to SPIR-V code, @codeSize@ /must/ be a
--     multiple of 4
--
-- -   @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
--
-- -   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
--
-- -   If @pCode@ is a pointer to GLSL code, it /must/ be valid GLSL code
--     written to the @GL_KHR_vulkan_glsl@ GLSL extension specification
--
-- -   @pCode@ /must/ declare the @Shader@ capability for SPIR-V code
--
-- -   @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
--
-- -   If @pCode@ declares any of the capabilities listed as /optional/ in
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#spirvenv-capabilities-table SPIR-V Environment>
--     appendix, the corresponding feature(s) /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO'
--
-- -   @pNext@ /must/ be @NULL@ or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_validation_cache.ShaderModuleValidationCacheCreateInfoEXT'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique
--
-- -   @flags@ /must/ be @0@
--
-- -   @pCode@ /must/ be a valid pointer to an array of
--     \(\textrm{codeSize} \over 4\) @uint32_t@ values
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.ShaderModuleCreateFlagBits.ShaderModuleCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createShaderModule'
data ShaderModuleCreateInfo (es :: [Type]) = ShaderModuleCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to an extension-specific 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)
deriving instance Show (Chain es) => Show (ShaderModuleCreateInfo es)

instance Extensible ShaderModuleCreateInfo where
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO
  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
      -- 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 -> 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 a :: Word64
a) -> Word64
a) 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