{-# language CPP #-}
-- | = Name
--
-- VK_KHR_pipeline_executable_properties - device extension
--
-- == VK_KHR_pipeline_executable_properties
--
-- [__Name String__]
--     @VK_KHR_pipeline_executable_properties@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     270
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@ to be enabled
--         for any device-level functionality
--
-- [__Special Use__]
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse Developer tools>
--
-- [__Contact__]
--
--     -   Jason Ekstrand
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_pipeline_executable_properties] @jekstrand%0A*Here describe the issue or question you have about the VK_KHR_pipeline_executable_properties extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2019-05-28
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Interactions and External Dependencies__; __Contributors__]
--
--     -   Jason Ekstrand, Intel
--
--     -   Ian Romanick, Intel
--
--     -   Kenneth Graunke, Intel
--
--     -   Baldur Karlsson, Valve
--
--     -   Jesse Hall, Google
--
--     -   Jeff Bolz, Nvidia
--
--     -   Piers Daniel, Nvidia
--
--     -   Tobias Hector, AMD
--
--     -   Jan-Harald Fredriksen, ARM
--
--     -   Tom Olson, ARM
--
--     -   Daniel Koch, Nvidia
--
--     -   Spencer Fricke, Samsung
--
-- == Description
--
-- When a pipeline is created, its state and shaders are compiled into zero
-- or more device-specific executables, which are used when executing
-- commands against that pipeline. This extension adds a mechanism to query
-- properties and statistics about the different executables produced by
-- the pipeline compilation process. This is intended to be used by
-- debugging and performance tools to allow them to provide more detailed
-- information to the user. Certain compile-time shader statistics provided
-- through this extension may be useful to developers for debugging or
-- performance analysis.
--
-- == New Commands
--
-- -   'getPipelineExecutableInternalRepresentationsKHR'
--
-- -   'getPipelineExecutablePropertiesKHR'
--
-- -   'getPipelineExecutableStatisticsKHR'
--
-- == New Structures
--
-- -   'PipelineExecutableInfoKHR'
--
-- -   'PipelineExecutableInternalRepresentationKHR'
--
-- -   'PipelineExecutablePropertiesKHR'
--
-- -   'PipelineExecutableStatisticKHR'
--
-- -   'PipelineInfoKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDevicePipelineExecutablePropertiesFeaturesKHR'
--
-- == New Unions
--
-- -   'PipelineExecutableStatisticValueKHR'
--
-- == New Enums
--
-- -   'PipelineExecutableStatisticFormatKHR'
--
-- == New Enum Constants
--
-- -   'KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME'
--
-- -   'KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_CAPTURE_INTERNAL_REPRESENTATIONS_BIT_KHR'
--
--     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_CAPTURE_STATISTICS_BIT_KHR'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_INFO_KHR'
--
-- == Issues
--
-- 1) What should we call the pieces of the pipeline which are produced by
-- the compilation process and about which you can query properties and
-- statistics?
--
-- __RESOLVED__: Call them “executables”. The name “binary” was used in
-- early drafts of the extension but it was determined that “pipeline
-- binary” could have a fairly broad meaning (such as a binary serialized
-- form of an entire pipeline) and was too big of a namespace for the very
-- specific needs of this extension.
--
-- == Version History
--
-- -   Revision 1, 2019-05-28 (Jason Ekstrand)
--
--     -   Initial draft
--
-- == See Also
--
-- 'PhysicalDevicePipelineExecutablePropertiesFeaturesKHR',
-- 'PipelineExecutableInfoKHR',
-- 'PipelineExecutableInternalRepresentationKHR',
-- 'PipelineExecutablePropertiesKHR',
-- 'PipelineExecutableStatisticFormatKHR',
-- 'PipelineExecutableStatisticKHR', 'PipelineExecutableStatisticValueKHR',
-- 'PipelineInfoKHR', 'getPipelineExecutableInternalRepresentationsKHR',
-- 'getPipelineExecutablePropertiesKHR',
-- 'getPipelineExecutableStatisticsKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_pipeline_executable_properties  ( getPipelineExecutablePropertiesKHR
                                                                , getPipelineExecutableStatisticsKHR
                                                                , getPipelineExecutableInternalRepresentationsKHR
                                                                , PhysicalDevicePipelineExecutablePropertiesFeaturesKHR(..)
                                                                , PipelineInfoKHR(..)
                                                                , PipelineExecutablePropertiesKHR(..)
                                                                , PipelineExecutableInfoKHR(..)
                                                                , PipelineExecutableStatisticKHR(..)
                                                                , PipelineExecutableInternalRepresentationKHR(..)
                                                                , PipelineExecutableStatisticValueKHR(..)
                                                                , peekPipelineExecutableStatisticValueKHR
                                                                , PipelineExecutableStatisticFormatKHR( PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
                                                                                                      , PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
                                                                                                      , PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
                                                                                                      , PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR
                                                                                                      , ..
                                                                                                      )
                                                                , KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION
                                                                , pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION
                                                                , KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME
                                                                , pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME
                                                                ) where

import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
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 GHC.Show (showsPrec)
import Data.ByteString (packCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.Trans.Cont (runContT)
import Data.Vector (generateM)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CDouble)
import Foreign.C.Types (CDouble(..))
import Foreign.C.Types (CDouble(CDouble))
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Data.Int (Int64)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineExecutableInternalRepresentationsKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineExecutablePropertiesKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineExecutableStatisticsKHR))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.APIConstants (MAX_DESCRIPTION_SIZE)
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_INFO_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPipelineExecutablePropertiesKHR
  :: FunPtr (Ptr Device_T -> Ptr PipelineInfoKHR -> Ptr Word32 -> Ptr PipelineExecutablePropertiesKHR -> IO Result) -> Ptr Device_T -> Ptr PipelineInfoKHR -> Ptr Word32 -> Ptr PipelineExecutablePropertiesKHR -> IO Result

-- | vkGetPipelineExecutablePropertiesKHR - Get the executables associated
-- with a pipeline
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of pipeline executables
-- associated with the pipeline is returned in @pExecutableCount@.
-- Otherwise, @pExecutableCount@ /must/ point to a variable set by the user
-- to the number of elements in the @pProperties@ array, and on return the
-- variable is overwritten with the number of structures actually written
-- to @pProperties@. If @pExecutableCount@ is less than the number of
-- pipeline executables associated with the pipeline, at most
-- @pExecutableCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available properties were returned.
--
-- == Valid Usage
--
-- -   #VUID-vkGetPipelineExecutablePropertiesKHR-pipelineExecutableInfo-03270#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-pipelineExecutableInfo pipelineExecutableInfo>
--     feature /must/ be enabled
--
-- -   #VUID-vkGetPipelineExecutablePropertiesKHR-pipeline-03271# The
--     @pipeline@ member of @pPipelineInfo@ /must/ have been created with
--     @device@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPipelineExecutablePropertiesKHR-device-parameter#
--     @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetPipelineExecutablePropertiesKHR-pPipelineInfo-parameter#
--     @pPipelineInfo@ /must/ be a valid pointer to a valid
--     'PipelineInfoKHR' structure
--
-- -   #VUID-vkGetPipelineExecutablePropertiesKHR-pExecutableCount-parameter#
--     @pExecutableCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPipelineExecutablePropertiesKHR-pProperties-parameter# If
--     the value referenced by @pExecutableCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pExecutableCount@ 'PipelineExecutablePropertiesKHR'
--     structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.Handles.Device', 'PipelineExecutablePropertiesKHR',
-- 'PipelineInfoKHR'
getPipelineExecutablePropertiesKHR :: forall io
                                    . (MonadIO io)
                                   => -- | @device@ is the device that created the pipeline.
                                      Device
                                   -> -- | @pPipelineInfo@ describes the pipeline being queried.
                                      PipelineInfoKHR
                                   -> io (Result, ("properties" ::: Vector PipelineExecutablePropertiesKHR))
getPipelineExecutablePropertiesKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineInfoKHR
-> io
     (Result, "properties" ::: Vector PipelineExecutablePropertiesKHR)
getPipelineExecutablePropertiesKHR Device
device PipelineInfoKHR
pipelineInfo = 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 vkGetPipelineExecutablePropertiesKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
   -> IO Result)
vkGetPipelineExecutablePropertiesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
      -> ("pExecutableCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
      -> IO Result)
pVkGetPipelineExecutablePropertiesKHR (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
   -> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
   -> IO Result)
vkGetPipelineExecutablePropertiesKHRPtr 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 vkGetPipelineExecutablePropertiesKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPipelineExecutablePropertiesKHR' :: Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
vkGetPipelineExecutablePropertiesKHR' = FunPtr
  (Ptr Device_T
   -> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
   -> IO Result)
-> Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
mkVkGetPipelineExecutablePropertiesKHR FunPtr
  (Ptr Device_T
   -> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
   -> IO Result)
vkGetPipelineExecutablePropertiesKHRPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pPipelineInfo" ::: Ptr PipelineInfoKHR
pPipelineInfo <- 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 (PipelineInfoKHR
pipelineInfo)
  "pExecutableCount" ::: Ptr Word32
pPExecutableCount <- 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 @Word32 Int
4) 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
"vkGetPipelineExecutablePropertiesKHR" (Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
vkGetPipelineExecutablePropertiesKHR'
                                                                         Ptr Device_T
device'
                                                                         "pPipelineInfo" ::: Ptr PipelineInfoKHR
pPipelineInfo
                                                                         ("pExecutableCount" ::: Ptr Word32
pPExecutableCount)
                                                                         (forall a. Ptr a
nullPtr))
  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))
  Word32
pExecutableCount <- 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 @Word32 "pExecutableCount" ::: Ptr Word32
pPExecutableCount
  "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties <- 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 @PipelineExecutablePropertiesKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pExecutableCount)) forall a. Num a => a -> a -> a
* Int
536)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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 => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
536) :: Ptr PipelineExecutablePropertiesKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pExecutableCount)) forall a. Num a => a -> a -> a
- Int
1]
  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
"vkGetPipelineExecutablePropertiesKHR" (Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
vkGetPipelineExecutablePropertiesKHR'
                                                                          Ptr Device_T
device'
                                                                          "pPipelineInfo" ::: Ptr PipelineInfoKHR
pPipelineInfo
                                                                          ("pExecutableCount" ::: Ptr Word32
pPExecutableCount)
                                                                          (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties)))
  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'))
  Word32
pExecutableCount' <- 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 @Word32 "pExecutableCount" ::: Ptr Word32
pPExecutableCount
  "properties" ::: Vector PipelineExecutablePropertiesKHR
pProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pExecutableCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineExecutablePropertiesKHR ((("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
536 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PipelineExecutablePropertiesKHR)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector PipelineExecutablePropertiesKHR
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPipelineExecutableStatisticsKHR
  :: FunPtr (Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableStatisticKHR -> IO Result) -> Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableStatisticKHR -> IO Result

-- | vkGetPipelineExecutableStatisticsKHR - Get compile time statistics
-- associated with a pipeline executable
--
-- = Description
--
-- If @pStatistics@ is @NULL@, then the number of statistics associated
-- with the pipeline executable is returned in @pStatisticCount@.
-- Otherwise, @pStatisticCount@ /must/ point to a variable set by the user
-- to the number of elements in the @pStatistics@ array, and on return the
-- variable is overwritten with the number of structures actually written
-- to @pStatistics@. If @pStatisticCount@ is less than the number of
-- statistics associated with the pipeline executable, at most
-- @pStatisticCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available statistics were returned.
--
-- == Valid Usage
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-pipelineExecutableInfo-03272#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-pipelineExecutableInfo pipelineExecutableInfo>
--     feature /must/ be enabled
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-pipeline-03273# The
--     @pipeline@ member of @pExecutableInfo@ /must/ have been created with
--     @device@
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-pipeline-03274# The
--     @pipeline@ member of @pExecutableInfo@ /must/ have been created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_CAPTURE_STATISTICS_BIT_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-device-parameter#
--     @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-pExecutableInfo-parameter#
--     @pExecutableInfo@ /must/ be a valid pointer to a valid
--     'PipelineExecutableInfoKHR' structure
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-pStatisticCount-parameter#
--     @pStatisticCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPipelineExecutableStatisticsKHR-pStatistics-parameter# If
--     the value referenced by @pStatisticCount@ is not @0@, and
--     @pStatistics@ is not @NULL@, @pStatistics@ /must/ be a valid pointer
--     to an array of @pStatisticCount@ 'PipelineExecutableStatisticKHR'
--     structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.Handles.Device', 'PipelineExecutableInfoKHR',
-- 'PipelineExecutableStatisticKHR'
getPipelineExecutableStatisticsKHR :: forall io
                                    . (MonadIO io)
                                   => -- | @device@ is the device that created the pipeline.
                                      Device
                                   -> -- | @pExecutableInfo@ describes the pipeline executable being queried.
                                      PipelineExecutableInfoKHR
                                   -> io (Result, ("statistics" ::: Vector PipelineExecutableStatisticKHR))
getPipelineExecutableStatisticsKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineExecutableInfoKHR
-> io
     (Result, "statistics" ::: Vector PipelineExecutableStatisticKHR)
getPipelineExecutableStatisticsKHR Device
device
                                     PipelineExecutableInfoKHR
executableInfo = 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 vkGetPipelineExecutableStatisticsKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
   -> IO Result)
vkGetPipelineExecutableStatisticsKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
      -> ("pExecutableCount" ::: Ptr Word32)
      -> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
      -> IO Result)
pVkGetPipelineExecutableStatisticsKHR (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
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
   -> IO Result)
vkGetPipelineExecutableStatisticsKHRPtr 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 vkGetPipelineExecutableStatisticsKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPipelineExecutableStatisticsKHR' :: Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
vkGetPipelineExecutableStatisticsKHR' = FunPtr
  (Ptr Device_T
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
   -> IO Result)
-> Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
mkVkGetPipelineExecutableStatisticsKHR FunPtr
  (Ptr Device_T
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
   -> IO Result)
vkGetPipelineExecutableStatisticsKHRPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo <- 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 (PipelineExecutableInfoKHR
executableInfo)
  "pExecutableCount" ::: Ptr Word32
pPStatisticCount <- 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 @Word32 Int
4) 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
"vkGetPipelineExecutableStatisticsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
vkGetPipelineExecutableStatisticsKHR'
                                                                         Ptr Device_T
device'
                                                                         "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
                                                                         ("pExecutableCount" ::: Ptr Word32
pPStatisticCount)
                                                                         (forall a. Ptr a
nullPtr))
  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))
  Word32
pStatisticCount <- 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 @Word32 "pExecutableCount" ::: Ptr Word32
pPStatisticCount
  "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics <- 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 @PipelineExecutableStatisticKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pStatisticCount)) forall a. Num a => a -> a -> a
* Int
544)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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 => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
544) :: Ptr PipelineExecutableStatisticKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pStatisticCount)) forall a. Num a => a -> a -> a
- Int
1]
  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
"vkGetPipelineExecutableStatisticsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
vkGetPipelineExecutableStatisticsKHR'
                                                                          Ptr Device_T
device'
                                                                          "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
                                                                          ("pExecutableCount" ::: Ptr Word32
pPStatisticCount)
                                                                          (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics)))
  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'))
  Word32
pStatisticCount' <- 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 @Word32 "pExecutableCount" ::: Ptr Word32
pPStatisticCount
  "statistics" ::: Vector PipelineExecutableStatisticKHR
pStatistics' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pStatisticCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineExecutableStatisticKHR ((("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
544 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PipelineExecutableStatisticKHR)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "statistics" ::: Vector PipelineExecutableStatisticKHR
pStatistics')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPipelineExecutableInternalRepresentationsKHR
  :: FunPtr (Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableInternalRepresentationKHR -> IO Result) -> Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableInternalRepresentationKHR -> IO Result

-- | vkGetPipelineExecutableInternalRepresentationsKHR - Get internal
-- representations of the pipeline executable
--
-- = Description
--
-- If @pInternalRepresentations@ is @NULL@, then the number of internal
-- representations associated with the pipeline executable is returned in
-- @pInternalRepresentationCount@. Otherwise,
-- @pInternalRepresentationCount@ /must/ point to a variable set by the
-- user to the number of elements in the @pInternalRepresentations@ array,
-- and on return the variable is overwritten with the number of structures
-- actually written to @pInternalRepresentations@. If
-- @pInternalRepresentationCount@ is less than the number of internal
-- representations associated with the pipeline executable, at most
-- @pInternalRepresentationCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available representations were returned.
--
-- While the details of the internal representations remain
-- implementation-dependent, the implementation /should/ order the internal
-- representations in the order in which they occur in the compiled
-- pipeline with the final shader assembly (if any) last.
--
-- == Valid Usage
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-pipelineExecutableInfo-03276#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-pipelineExecutableInfo pipelineExecutableInfo>
--     feature /must/ be enabled
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-pipeline-03277#
--     The @pipeline@ member of @pExecutableInfo@ /must/ have been created
--     with @device@
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-pipeline-03278#
--     The @pipeline@ member of @pExecutableInfo@ /must/ have been created
--     with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_CAPTURE_INTERNAL_REPRESENTATIONS_BIT_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-device-parameter#
--     @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-pExecutableInfo-parameter#
--     @pExecutableInfo@ /must/ be a valid pointer to a valid
--     'PipelineExecutableInfoKHR' structure
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-pInternalRepresentationCount-parameter#
--     @pInternalRepresentationCount@ /must/ be a valid pointer to a
--     @uint32_t@ value
--
-- -   #VUID-vkGetPipelineExecutableInternalRepresentationsKHR-pInternalRepresentations-parameter#
--     If the value referenced by @pInternalRepresentationCount@ is not
--     @0@, and @pInternalRepresentations@ is not @NULL@,
--     @pInternalRepresentations@ /must/ be a valid pointer to an array of
--     @pInternalRepresentationCount@
--     'PipelineExecutableInternalRepresentationKHR' structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.Handles.Device', 'PipelineExecutableInfoKHR',
-- 'PipelineExecutableInternalRepresentationKHR'
getPipelineExecutableInternalRepresentationsKHR :: forall io
                                                 . (MonadIO io)
                                                => -- | @device@ is the device that created the pipeline.
                                                   Device
                                                -> -- | @pExecutableInfo@ describes the pipeline executable being queried.
                                                   PipelineExecutableInfoKHR
                                                -> io (Result, ("internalRepresentations" ::: Vector PipelineExecutableInternalRepresentationKHR))
getPipelineExecutableInternalRepresentationsKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineExecutableInfoKHR
-> io
     (Result,
      "internalRepresentations"
      ::: Vector PipelineExecutableInternalRepresentationKHR)
getPipelineExecutableInternalRepresentationsKHR Device
device
                                                  PipelineExecutableInfoKHR
executableInfo = 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 vkGetPipelineExecutableInternalRepresentationsKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pInternalRepresentations"
       ::: Ptr PipelineExecutableInternalRepresentationKHR)
   -> IO Result)
vkGetPipelineExecutableInternalRepresentationsKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
      -> ("pExecutableCount" ::: Ptr Word32)
      -> ("pInternalRepresentations"
          ::: Ptr PipelineExecutableInternalRepresentationKHR)
      -> IO Result)
pVkGetPipelineExecutableInternalRepresentationsKHR (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
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pInternalRepresentations"
       ::: Ptr PipelineExecutableInternalRepresentationKHR)
   -> IO Result)
vkGetPipelineExecutableInternalRepresentationsKHRPtr 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 vkGetPipelineExecutableInternalRepresentationsKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPipelineExecutableInternalRepresentationsKHR' :: Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
    ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
vkGetPipelineExecutableInternalRepresentationsKHR' = FunPtr
  (Ptr Device_T
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pInternalRepresentations"
       ::: Ptr PipelineExecutableInternalRepresentationKHR)
   -> IO Result)
-> Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
    ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
mkVkGetPipelineExecutableInternalRepresentationsKHR FunPtr
  (Ptr Device_T
   -> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
   -> ("pExecutableCount" ::: Ptr Word32)
   -> ("pInternalRepresentations"
       ::: Ptr PipelineExecutableInternalRepresentationKHR)
   -> IO Result)
vkGetPipelineExecutableInternalRepresentationsKHRPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo <- 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 (PipelineExecutableInfoKHR
executableInfo)
  "pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount <- 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 @Word32 Int
4) 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
"vkGetPipelineExecutableInternalRepresentationsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
    ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
vkGetPipelineExecutableInternalRepresentationsKHR'
                                                                                      Ptr Device_T
device'
                                                                                      "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
                                                                                      ("pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount)
                                                                                      (forall a. Ptr a
nullPtr))
  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))
  Word32
pInternalRepresentationCount <- 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 @Word32 "pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount
  "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations <- 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 @PipelineExecutableInternalRepresentationKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pInternalRepresentationCount)) forall a. Num a => a -> a -> a
* Int
552)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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 => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
552) :: Ptr PipelineExecutableInternalRepresentationKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pInternalRepresentationCount)) forall a. Num a => a -> a -> a
- Int
1]
  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
"vkGetPipelineExecutableInternalRepresentationsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
    ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
vkGetPipelineExecutableInternalRepresentationsKHR'
                                                                                       Ptr Device_T
device'
                                                                                       "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
                                                                                       ("pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount)
                                                                                       (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations)))
  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'))
  Word32
pInternalRepresentationCount' <- 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 @Word32 "pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount
  "internalRepresentations"
::: Vector PipelineExecutableInternalRepresentationKHR
pInternalRepresentations' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pInternalRepresentationCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineExecutableInternalRepresentationKHR ((("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
552 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PipelineExecutableInternalRepresentationKHR)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "internalRepresentations"
::: Vector PipelineExecutableInternalRepresentationKHR
pInternalRepresentations')


-- | VkPhysicalDevicePipelineExecutablePropertiesFeaturesKHR - Structure
-- describing whether pipeline executable properties are available
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDevicePipelineExecutablePropertiesFeaturesKHR' structure
-- is included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDevicePipelineExecutablePropertiesFeaturesKHR' /can/
-- also be used in the @pNext@ chain of
-- 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively enable these
-- features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePipelineExecutablePropertiesFeaturesKHR = PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
  { -- | #features-pipelineExecutableInfo# @pipelineExecutableInfo@ indicates
    -- that the implementation supports reporting properties and statistics
    -- about the pipeline executables associated with a compiled pipeline.
    PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
pipelineExecutableInfo :: Bool }
  deriving (Typeable, PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
$c/= :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
== :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
$c== :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePipelineExecutablePropertiesFeaturesKHR)
#endif
deriving instance Show PhysicalDevicePipelineExecutablePropertiesFeaturesKHR

instance ToCStruct PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
  withCStruct :: forall b.
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> (Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
    -> IO b)
-> IO b
withCStruct PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
x Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
x (Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> IO b
f Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p)
  pokeCStruct :: forall b.
Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p PhysicalDevicePipelineExecutablePropertiesFeaturesKHR{Bool
pipelineExecutableInfo :: Bool
$sel:pipelineExecutableInfo:PhysicalDevicePipelineExecutablePropertiesFeaturesKHR :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
pipelineExecutableInfo))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
  peekCStruct :: Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
peekCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p = do
    Bool32
pipelineExecutableInfo <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
             (Bool32 -> Bool
bool32ToBool Bool32
pipelineExecutableInfo)

instance Storable PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
  sizeOf :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Int
sizeOf ~PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
_ = Int
24
  alignment :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Int
alignment ~PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
_ = Int
8
  peek :: Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> IO ()
poke Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
  zero :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
zero = Bool -> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
           forall a. Zero a => a
zero


-- | VkPipelineInfoKHR - Structure describing a pipeline
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_pipeline_properties VK_EXT_pipeline_properties>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.Handles.Pipeline',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPipelineExecutablePropertiesKHR',
-- 'Vulkan.Extensions.VK_EXT_pipeline_properties.getPipelinePropertiesEXT'
data PipelineInfoKHR = PipelineInfoKHR
  { -- | @pipeline@ is a 'Vulkan.Core10.Handles.Pipeline' handle.
    --
    -- #VUID-VkPipelineInfoKHR-pipeline-parameter# @pipeline@ /must/ be a valid
    -- 'Vulkan.Core10.Handles.Pipeline' handle
    PipelineInfoKHR -> Pipeline
pipeline :: Pipeline }
  deriving (Typeable, PipelineInfoKHR -> PipelineInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
$c/= :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
== :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
$c== :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineInfoKHR)
#endif
deriving instance Show PipelineInfoKHR

instance ToCStruct PipelineInfoKHR where
  withCStruct :: forall b.
PipelineInfoKHR
-> (("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b) -> IO b
withCStruct PipelineInfoKHR
x ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pPipelineInfo" ::: Ptr PipelineInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p PipelineInfoKHR
x (("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b
f "pPipelineInfo" ::: Ptr PipelineInfoKHR
p)
  pokeCStruct :: forall b.
("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> PipelineInfoKHR -> IO b -> IO b
pokeCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p PipelineInfoKHR{Pipeline
pipeline :: Pipeline
$sel:pipeline:PipelineInfoKHR :: PipelineInfoKHR -> Pipeline
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (Pipeline
pipeline)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b -> IO b
pokeZeroCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineInfoKHR where
  peekCStruct :: ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO PipelineInfoKHR
peekCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p = do
    Pipeline
pipeline <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pipeline -> PipelineInfoKHR
PipelineInfoKHR
             Pipeline
pipeline

instance Storable PipelineInfoKHR where
  sizeOf :: PipelineInfoKHR -> Int
sizeOf ~PipelineInfoKHR
_ = Int
24
  alignment :: PipelineInfoKHR -> Int
alignment ~PipelineInfoKHR
_ = Int
8
  peek :: ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO PipelineInfoKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> PipelineInfoKHR -> IO ()
poke "pPipelineInfo" ::: Ptr PipelineInfoKHR
ptr PipelineInfoKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
ptr PipelineInfoKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PipelineInfoKHR where
  zero :: PipelineInfoKHR
zero = Pipeline -> PipelineInfoKHR
PipelineInfoKHR
           forall a. Zero a => a
zero


-- | VkPipelineExecutablePropertiesKHR - Structure describing a pipeline
-- executable
--
-- = Description
--
-- Not all implementations have a 1:1 mapping between shader stages and
-- pipeline executables and some implementations /may/ reduce a given
-- shader stage to fixed function hardware programming such that no
-- pipeline executable is available. No guarantees are provided about the
-- mapping between shader stages and pipeline executables and @stages@
-- /should/ be considered a best effort hint. Because the application
-- /cannot/ rely on the @stages@ field to provide an exact description,
-- @name@ and @description@ provide a human readable name and description
-- which more accurately describes the given pipeline executable.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPipelineExecutablePropertiesKHR'
data PipelineExecutablePropertiesKHR = PipelineExecutablePropertiesKHR
  { -- | @stages@ is a bitmask of zero or more
    -- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlagBits' indicating
    -- which shader stages (if any) were principally used as inputs to compile
    -- this pipeline executable.
    PipelineExecutablePropertiesKHR -> ShaderStageFlags
stages :: ShaderStageFlags
  , -- | @name@ is an array of 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE'
    -- @char@ containing a null-terminated UTF-8 string which is a short human
    -- readable name for this pipeline executable.
    PipelineExecutablePropertiesKHR -> ByteString
name :: ByteString
  , -- | @description@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which is a human readable description for
    -- this pipeline executable.
    PipelineExecutablePropertiesKHR -> ByteString
description :: ByteString
  , -- | @subgroupSize@ is the subgroup size with which this pipeline executable
    -- is dispatched.
    PipelineExecutablePropertiesKHR -> Word32
subgroupSize :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutablePropertiesKHR)
#endif
deriving instance Show PipelineExecutablePropertiesKHR

instance ToCStruct PipelineExecutablePropertiesKHR where
  withCStruct :: forall b.
PipelineExecutablePropertiesKHR
-> (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
    -> IO b)
-> IO b
withCStruct PipelineExecutablePropertiesKHR
x ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
536 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p PipelineExecutablePropertiesKHR
x (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR) -> IO b
f "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p)
  pokeCStruct :: forall b.
("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> PipelineExecutablePropertiesKHR -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p PipelineExecutablePropertiesKHR{Word32
ByteString
ShaderStageFlags
subgroupSize :: Word32
description :: ByteString
name :: ByteString
stages :: ShaderStageFlags
$sel:subgroupSize:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> Word32
$sel:description:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> ByteString
$sel:name:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> ByteString
$sel:stages:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> ShaderStageFlags
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (ShaderStageFlags
stages)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
name)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr Word32)) (Word32
subgroupSize)
    IO b
f
  cStructSize :: Int
cStructSize = Int
536
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (forall a. Zero a => a
zero)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineExecutablePropertiesKHR where
  peekCStruct :: ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO PipelineExecutablePropertiesKHR
peekCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p = do
    ShaderStageFlags
stages <- forall a. Storable a => Ptr a -> IO a
peek @ShaderStageFlags (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags))
    ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    Word32
subgroupSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ShaderStageFlags
-> ByteString
-> ByteString
-> Word32
-> PipelineExecutablePropertiesKHR
PipelineExecutablePropertiesKHR
             ShaderStageFlags
stages ByteString
name ByteString
description Word32
subgroupSize

instance Storable PipelineExecutablePropertiesKHR where
  sizeOf :: PipelineExecutablePropertiesKHR -> Int
sizeOf ~PipelineExecutablePropertiesKHR
_ = Int
536
  alignment :: PipelineExecutablePropertiesKHR -> Int
alignment ~PipelineExecutablePropertiesKHR
_ = Int
8
  peek :: ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO PipelineExecutablePropertiesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> PipelineExecutablePropertiesKHR -> IO ()
poke "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
ptr PipelineExecutablePropertiesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
ptr PipelineExecutablePropertiesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PipelineExecutablePropertiesKHR where
  zero :: PipelineExecutablePropertiesKHR
zero = ShaderStageFlags
-> ByteString
-> ByteString
-> Word32
-> PipelineExecutablePropertiesKHR
PipelineExecutablePropertiesKHR
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero


-- | VkPipelineExecutableInfoKHR - Structure describing a pipeline executable
-- to query for associated statistics or internal representations
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.Handles.Pipeline',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPipelineExecutableInternalRepresentationsKHR',
-- 'getPipelineExecutableStatisticsKHR'
data PipelineExecutableInfoKHR = PipelineExecutableInfoKHR
  { -- | @pipeline@ is the pipeline to query.
    --
    -- #VUID-VkPipelineExecutableInfoKHR-pipeline-parameter# @pipeline@ /must/
    -- be a valid 'Vulkan.Core10.Handles.Pipeline' handle
    PipelineExecutableInfoKHR -> Pipeline
pipeline :: Pipeline
  , -- | @executableIndex@ is the index of the pipeline executable to query in
    -- the array of executable properties returned by
    -- 'getPipelineExecutablePropertiesKHR'.
    --
    -- #VUID-VkPipelineExecutableInfoKHR-executableIndex-03275#
    -- @executableIndex@ /must/ be less than the number of pipeline executables
    -- associated with @pipeline@ as returned in the @pExecutableCount@
    -- parameter of 'getPipelineExecutablePropertiesKHR'
    PipelineExecutableInfoKHR -> Word32
executableIndex :: Word32
  }
  deriving (Typeable, PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
$c/= :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
== :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
$c== :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutableInfoKHR)
#endif
deriving instance Show PipelineExecutableInfoKHR

instance ToCStruct PipelineExecutableInfoKHR where
  withCStruct :: forall b.
PipelineExecutableInfoKHR
-> (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR) -> IO b)
-> IO b
withCStruct PipelineExecutableInfoKHR
x ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p PipelineExecutableInfoKHR
x (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR) -> IO b
f "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p)
  pokeCStruct :: forall b.
("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> PipelineExecutableInfoKHR -> IO b -> IO b
pokeCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p PipelineExecutableInfoKHR{Word32
Pipeline
executableIndex :: Word32
pipeline :: Pipeline
$sel:executableIndex:PipelineExecutableInfoKHR :: PipelineExecutableInfoKHR -> Word32
$sel:pipeline:PipelineExecutableInfoKHR :: PipelineExecutableInfoKHR -> Pipeline
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (Pipeline
pipeline)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
executableIndex)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> IO b -> IO b
pokeZeroCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineExecutableInfoKHR where
  peekCStruct :: ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> IO PipelineExecutableInfoKHR
peekCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p = do
    Pipeline
pipeline <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline))
    Word32
executableIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pipeline -> Word32 -> PipelineExecutableInfoKHR
PipelineExecutableInfoKHR
             Pipeline
pipeline Word32
executableIndex

instance Storable PipelineExecutableInfoKHR where
  sizeOf :: PipelineExecutableInfoKHR -> Int
sizeOf ~PipelineExecutableInfoKHR
_ = Int
32
  alignment :: PipelineExecutableInfoKHR -> Int
alignment ~PipelineExecutableInfoKHR
_ = Int
8
  peek :: ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> IO PipelineExecutableInfoKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> PipelineExecutableInfoKHR -> IO ()
poke "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
ptr PipelineExecutableInfoKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
ptr PipelineExecutableInfoKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PipelineExecutableInfoKHR where
  zero :: PipelineExecutableInfoKHR
zero = Pipeline -> Word32 -> PipelineExecutableInfoKHR
PipelineExecutableInfoKHR
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPipelineExecutableStatisticKHR - Structure describing a compile-time
-- pipeline executable statistic
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'PipelineExecutableStatisticFormatKHR',
-- 'PipelineExecutableStatisticValueKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPipelineExecutableStatisticsKHR'
data PipelineExecutableStatisticKHR = PipelineExecutableStatisticKHR
  { -- | @name@ is an array of 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE'
    -- @char@ containing a null-terminated UTF-8 string which is a short human
    -- readable name for this statistic.
    PipelineExecutableStatisticKHR -> ByteString
name :: ByteString
  , -- | @description@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which is a human readable description for
    -- this statistic.
    PipelineExecutableStatisticKHR -> ByteString
description :: ByteString
  , -- | @format@ is a 'PipelineExecutableStatisticFormatKHR' value specifying
    -- the format of the data found in @value@.
    PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticFormatKHR
format :: PipelineExecutableStatisticFormatKHR
  , -- | @value@ is the value of this statistic.
    PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticValueKHR
value :: PipelineExecutableStatisticValueKHR
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutableStatisticKHR)
#endif
deriving instance Show PipelineExecutableStatisticKHR

instance ToCStruct PipelineExecutableStatisticKHR where
  withCStruct :: forall b.
PipelineExecutableStatisticKHR
-> (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR) -> IO b)
-> IO b
withCStruct PipelineExecutableStatisticKHR
x ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
544 forall a b. (a -> b) -> a -> b
$ \"pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p PipelineExecutableStatisticKHR
x (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR) -> IO b
f "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p)
  pokeCStruct :: forall b.
("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> PipelineExecutableStatisticKHR -> IO b -> IO b
pokeCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p PipelineExecutableStatisticKHR{ByteString
PipelineExecutableStatisticFormatKHR
PipelineExecutableStatisticValueKHR
value :: PipelineExecutableStatisticValueKHR
format :: PipelineExecutableStatisticFormatKHR
description :: ByteString
name :: ByteString
$sel:value:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticValueKHR
$sel:format:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticFormatKHR
$sel:description:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR -> ByteString
$sel:name:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR -> ByteString
..} 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 (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR)
    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 (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
name)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    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 (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr PipelineExecutableStatisticFormatKHR)) (PipelineExecutableStatisticFormatKHR
format)
    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 => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr PipelineExecutableStatisticValueKHR)) (PipelineExecutableStatisticValueKHR
value) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
    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
544
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO b -> IO b
pokeZeroCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
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 (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR)
    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 (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    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 (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr PipelineExecutableStatisticFormatKHR)) (forall a. Zero a => a
zero)
    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 => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr PipelineExecutableStatisticValueKHR)) (forall a. Zero a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
    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 FromCStruct PipelineExecutableStatisticKHR where
  peekCStruct :: ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO PipelineExecutableStatisticKHR
peekCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p = do
    ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    PipelineExecutableStatisticFormatKHR
format <- forall a. Storable a => Ptr a -> IO a
peek @PipelineExecutableStatisticFormatKHR (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr PipelineExecutableStatisticFormatKHR))
    PipelineExecutableStatisticValueKHR
value <- PipelineExecutableStatisticFormatKHR
-> Ptr PipelineExecutableStatisticValueKHR
-> IO PipelineExecutableStatisticValueKHR
peekPipelineExecutableStatisticValueKHR PipelineExecutableStatisticFormatKHR
format (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr PipelineExecutableStatisticValueKHR))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticValueKHR
-> PipelineExecutableStatisticKHR
PipelineExecutableStatisticKHR
             ByteString
name ByteString
description PipelineExecutableStatisticFormatKHR
format PipelineExecutableStatisticValueKHR
value

instance Zero PipelineExecutableStatisticKHR where
  zero :: PipelineExecutableStatisticKHR
zero = ByteString
-> ByteString
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticValueKHR
-> PipelineExecutableStatisticKHR
PipelineExecutableStatisticKHR
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPipelineExecutableInternalRepresentationKHR - Structure describing the
-- textual form of a pipeline executable internal representation
--
-- = Description
--
-- If @pData@ is @NULL@, then the size, in bytes, of the internal
-- representation data is returned in @dataSize@. Otherwise, @dataSize@
-- must be the size of the buffer, in bytes, pointed to by @pData@ and on
-- return @dataSize@ is overwritten with the number of bytes of data
-- actually written to @pData@ including any trailing null character. If
-- @dataSize@ is less than the size, in bytes, of the internal
-- representation’s data, at most @dataSize@ bytes of data will be written
-- to @pData@, and 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned
-- instead of 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not
-- all the available representation was returned.
--
-- If @isText@ is 'Vulkan.Core10.FundamentalTypes.TRUE' and @pData@ is not
-- @NULL@ and @dataSize@ is not zero, the last byte written to @pData@ will
-- be a null character.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPipelineExecutableInternalRepresentationsKHR'
data PipelineExecutableInternalRepresentationKHR = PipelineExecutableInternalRepresentationKHR
  { -- | @name@ is an array of 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE'
    -- @char@ containing a null-terminated UTF-8 string which is a short human
    -- readable name for this internal representation.
    PipelineExecutableInternalRepresentationKHR -> ByteString
name :: ByteString
  , -- | @description@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which is a human readable description for
    -- this internal representation.
    PipelineExecutableInternalRepresentationKHR -> ByteString
description :: ByteString
  , -- | @isText@ specifies whether the returned data is text or opaque data. If
    -- @isText@ is 'Vulkan.Core10.FundamentalTypes.TRUE' then the data returned
    -- in @pData@ is text and is guaranteed to be a null-terminated UTF-8
    -- string.
    PipelineExecutableInternalRepresentationKHR -> Bool
isText :: Bool
  , -- | @dataSize@ is an integer related to the size, in bytes, of the internal
    -- representation’s data, as described below.
    PipelineExecutableInternalRepresentationKHR -> Word64
dataSize :: Word64
  , -- | @pData@ is either @NULL@ or a pointer to a block of data into which the
    -- implementation will write the internal representation.
    PipelineExecutableInternalRepresentationKHR -> Ptr ()
data' :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutableInternalRepresentationKHR)
#endif
deriving instance Show PipelineExecutableInternalRepresentationKHR

instance ToCStruct PipelineExecutableInternalRepresentationKHR where
  withCStruct :: forall b.
PipelineExecutableInternalRepresentationKHR
-> (("pInternalRepresentations"
     ::: Ptr PipelineExecutableInternalRepresentationKHR)
    -> IO b)
-> IO b
withCStruct PipelineExecutableInternalRepresentationKHR
x ("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
552 forall a b. (a -> b) -> a -> b
$ \"pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p PipelineExecutableInternalRepresentationKHR
x (("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b
f "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p)
  pokeCStruct :: forall b.
("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> PipelineExecutableInternalRepresentationKHR -> IO b -> IO b
pokeCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p PipelineExecutableInternalRepresentationKHR{Bool
Word64
Ptr ()
ByteString
data' :: Ptr ()
dataSize :: Word64
isText :: Bool
description :: ByteString
name :: ByteString
$sel:data':PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> Ptr ()
$sel:dataSize:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> Word64
$sel:isText:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> Bool
$sel:description:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> ByteString
$sel:name:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> ByteString
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
name)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
isText))
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
dataSize))
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
544 :: Ptr (Ptr ()))) (Ptr ()
data')
    IO b
f
  cStructSize :: Int
cStructSize = Int
552
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b -> IO b
pokeZeroCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr CSize)) (Word64 -> CSize
CSize (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PipelineExecutableInternalRepresentationKHR where
  peekCStruct :: ("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO PipelineExecutableInternalRepresentationKHR
peekCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p = do
    ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    Bool32
isText <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr Bool32))
    CSize
dataSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr CSize))
    Ptr ()
pData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
544 :: Ptr (Ptr ())))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> Bool
-> Word64
-> Ptr ()
-> PipelineExecutableInternalRepresentationKHR
PipelineExecutableInternalRepresentationKHR
             ByteString
name
             ByteString
description
             (Bool32 -> Bool
bool32ToBool Bool32
isText)
             (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
dataSize)
             Ptr ()
pData

instance Storable PipelineExecutableInternalRepresentationKHR where
  sizeOf :: PipelineExecutableInternalRepresentationKHR -> Int
sizeOf ~PipelineExecutableInternalRepresentationKHR
_ = Int
552
  alignment :: PipelineExecutableInternalRepresentationKHR -> Int
alignment ~PipelineExecutableInternalRepresentationKHR
_ = Int
8
  peek :: ("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO PipelineExecutableInternalRepresentationKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pInternalRepresentations"
 ::: Ptr PipelineExecutableInternalRepresentationKHR)
-> PipelineExecutableInternalRepresentationKHR -> IO ()
poke "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
ptr PipelineExecutableInternalRepresentationKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
ptr PipelineExecutableInternalRepresentationKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PipelineExecutableInternalRepresentationKHR where
  zero :: PipelineExecutableInternalRepresentationKHR
zero = ByteString
-> ByteString
-> Bool
-> Word64
-> Ptr ()
-> PipelineExecutableInternalRepresentationKHR
PipelineExecutableInternalRepresentationKHR
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


data PipelineExecutableStatisticValueKHR
  = B32 Bool
  | I64 Int64
  | U64 Word64
  | F64 Double
  deriving (Int -> PipelineExecutableStatisticValueKHR -> ShowS
[PipelineExecutableStatisticValueKHR] -> ShowS
PipelineExecutableStatisticValueKHR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PipelineExecutableStatisticValueKHR] -> ShowS
$cshowList :: [PipelineExecutableStatisticValueKHR] -> ShowS
show :: PipelineExecutableStatisticValueKHR -> String
$cshow :: PipelineExecutableStatisticValueKHR -> String
showsPrec :: Int -> PipelineExecutableStatisticValueKHR -> ShowS
$cshowsPrec :: Int -> PipelineExecutableStatisticValueKHR -> ShowS
Show)

instance ToCStruct PipelineExecutableStatisticValueKHR where
  withCStruct :: forall b.
PipelineExecutableStatisticValueKHR
-> (Ptr PipelineExecutableStatisticValueKHR -> IO b) -> IO b
withCStruct PipelineExecutableStatisticValueKHR
x Ptr PipelineExecutableStatisticValueKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr PipelineExecutableStatisticValueKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineExecutableStatisticValueKHR
p PipelineExecutableStatisticValueKHR
x (Ptr PipelineExecutableStatisticValueKHR -> IO b
f Ptr PipelineExecutableStatisticValueKHR
p)
  pokeCStruct :: Ptr PipelineExecutableStatisticValueKHR -> PipelineExecutableStatisticValueKHR -> IO a -> IO a
  pokeCStruct :: forall b.
Ptr PipelineExecutableStatisticValueKHR
-> PipelineExecutableStatisticValueKHR -> IO b -> IO b
pokeCStruct Ptr PipelineExecutableStatisticValueKHR
p = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT forall b c a. (b -> c) -> (a -> b) -> a -> c
.  \case
    B32 Bool
v -> 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 (forall a b. Ptr a -> Ptr b
castPtr @_ @Bool32 Ptr PipelineExecutableStatisticValueKHR
p) (Bool -> Bool32
boolToBool32 (Bool
v))
    I64 Int64
v -> 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 (forall a b. Ptr a -> Ptr b
castPtr @_ @Int64 Ptr PipelineExecutableStatisticValueKHR
p) (Int64
v)
    U64 Word64
v -> 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 (forall a b. Ptr a -> Ptr b
castPtr @_ @Word64 Ptr PipelineExecutableStatisticValueKHR
p) (Word64
v)
    F64 Double
v -> 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 (forall a b. Ptr a -> Ptr b
castPtr @_ @CDouble Ptr PipelineExecutableStatisticValueKHR
p) (Double -> CDouble
CDouble (Double
v))
  pokeZeroCStruct :: Ptr PipelineExecutableStatisticValueKHR -> IO b -> IO b
  pokeZeroCStruct :: forall b. Ptr PipelineExecutableStatisticValueKHR -> IO b -> IO b
pokeZeroCStruct Ptr PipelineExecutableStatisticValueKHR
_ IO b
f = IO b
f
  cStructSize :: Int
cStructSize = Int
8
  cStructAlignment :: Int
cStructAlignment = Int
8

instance Zero PipelineExecutableStatisticValueKHR where
  zero :: PipelineExecutableStatisticValueKHR
zero = Int64 -> PipelineExecutableStatisticValueKHR
I64 forall a. Zero a => a
zero

peekPipelineExecutableStatisticValueKHR :: PipelineExecutableStatisticFormatKHR -> Ptr PipelineExecutableStatisticValueKHR -> IO PipelineExecutableStatisticValueKHR
peekPipelineExecutableStatisticValueKHR :: PipelineExecutableStatisticFormatKHR
-> Ptr PipelineExecutableStatisticValueKHR
-> IO PipelineExecutableStatisticValueKHR
peekPipelineExecutableStatisticValueKHR PipelineExecutableStatisticFormatKHR
tag Ptr PipelineExecutableStatisticValueKHR
p = case PipelineExecutableStatisticFormatKHR
tag of
  PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR -> Bool -> PipelineExecutableStatisticValueKHR
B32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
    Bool32
b32 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (forall a b. Ptr a -> Ptr b
castPtr @_ @Bool32 Ptr PipelineExecutableStatisticValueKHR
p)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool32 -> Bool
bool32ToBool Bool32
b32)
  PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR -> Int64 -> PipelineExecutableStatisticValueKHR
I64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek @Int64 (forall a b. Ptr a -> Ptr b
castPtr @_ @Int64 Ptr PipelineExecutableStatisticValueKHR
p))
  PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR -> Word64 -> PipelineExecutableStatisticValueKHR
U64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek @Word64 (forall a b. Ptr a -> Ptr b
castPtr @_ @Word64 Ptr PipelineExecutableStatisticValueKHR
p))
  PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR -> Double -> PipelineExecutableStatisticValueKHR
F64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
    CDouble
f64 <- forall a. Storable a => Ptr a -> IO a
peek @CDouble (forall a b. Ptr a -> Ptr b
castPtr @_ @CDouble Ptr PipelineExecutableStatisticValueKHR
p)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce @CDouble @Double CDouble
f64)


-- | VkPipelineExecutableStatisticFormatKHR - Enum describing a pipeline
-- executable statistic
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_executable_properties VK_KHR_pipeline_executable_properties>,
-- 'PipelineExecutableStatisticKHR'
newtype PipelineExecutableStatisticFormatKHR = PipelineExecutableStatisticFormatKHR Int32
  deriving newtype (PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c/= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
== :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c== :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
Eq, Eq PipelineExecutableStatisticFormatKHR
PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Ordering
PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
$cmin :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
max :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
$cmax :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
>= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c>= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
> :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c> :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
<= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c<= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
< :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c< :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
compare :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Ordering
$ccompare :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Ordering
Ord, Ptr PipelineExecutableStatisticFormatKHR
-> IO PipelineExecutableStatisticFormatKHR
Ptr PipelineExecutableStatisticFormatKHR
-> Int -> IO PipelineExecutableStatisticFormatKHR
Ptr PipelineExecutableStatisticFormatKHR
-> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
Ptr PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> IO ()
PipelineExecutableStatisticFormatKHR -> Int
forall b. Ptr b -> Int -> IO PipelineExecutableStatisticFormatKHR
forall b.
Ptr b -> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> IO ()
$cpoke :: Ptr PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> IO ()
peek :: Ptr PipelineExecutableStatisticFormatKHR
-> IO PipelineExecutableStatisticFormatKHR
$cpeek :: Ptr PipelineExecutableStatisticFormatKHR
-> IO PipelineExecutableStatisticFormatKHR
pokeByteOff :: forall b.
Ptr b -> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
$cpokeByteOff :: forall b.
Ptr b -> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO PipelineExecutableStatisticFormatKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PipelineExecutableStatisticFormatKHR
pokeElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
$cpokeElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
peekElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> IO PipelineExecutableStatisticFormatKHR
$cpeekElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> IO PipelineExecutableStatisticFormatKHR
alignment :: PipelineExecutableStatisticFormatKHR -> Int
$calignment :: PipelineExecutableStatisticFormatKHR -> Int
sizeOf :: PipelineExecutableStatisticFormatKHR -> Int
$csizeOf :: PipelineExecutableStatisticFormatKHR -> Int
Storable, PipelineExecutableStatisticFormatKHR
forall a. a -> Zero a
zero :: PipelineExecutableStatisticFormatKHR
$czero :: PipelineExecutableStatisticFormatKHR
Zero)

-- | 'PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR' specifies that the
-- statistic is returned as a 32-bit boolean value which /must/ be either
-- 'Vulkan.Core10.FundamentalTypes.TRUE' or
-- 'Vulkan.Core10.FundamentalTypes.FALSE' and /should/ be read from the
-- @b32@ field of 'PipelineExecutableStatisticValueKHR'.
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR = PipelineExecutableStatisticFormatKHR 0

-- | 'PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR' specifies that the
-- statistic is returned as a signed 64-bit integer and /should/ be read
-- from the @i64@ field of 'PipelineExecutableStatisticValueKHR'.
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR = PipelineExecutableStatisticFormatKHR 1

-- | 'PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR' specifies that the
-- statistic is returned as an unsigned 64-bit integer and /should/ be read
-- from the @u64@ field of 'PipelineExecutableStatisticValueKHR'.
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR = PipelineExecutableStatisticFormatKHR 2

-- | 'PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR' specifies that the
-- statistic is returned as a 64-bit floating-point value and /should/ be
-- read from the @f64@ field of 'PipelineExecutableStatisticValueKHR'.
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR = PipelineExecutableStatisticFormatKHR 3

{-# COMPLETE
  PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
  , PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
  , PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
  , PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR ::
    PipelineExecutableStatisticFormatKHR
  #-}

conNamePipelineExecutableStatisticFormatKHR :: String
conNamePipelineExecutableStatisticFormatKHR :: String
conNamePipelineExecutableStatisticFormatKHR = String
"PipelineExecutableStatisticFormatKHR"

enumPrefixPipelineExecutableStatisticFormatKHR :: String
enumPrefixPipelineExecutableStatisticFormatKHR :: String
enumPrefixPipelineExecutableStatisticFormatKHR = String
"PIPELINE_EXECUTABLE_STATISTIC_FORMAT_"

showTablePipelineExecutableStatisticFormatKHR :: [(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR :: [(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR =
  [
    ( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
    , String
"BOOL32_KHR"
    )
  ,
    ( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
    , String
"INT64_KHR"
    )
  ,
    ( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
    , String
"UINT64_KHR"
    )
  ,
    ( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR
    , String
"FLOAT64_KHR"
    )
  ]

instance Show PipelineExecutableStatisticFormatKHR where
  showsPrec :: Int -> PipelineExecutableStatisticFormatKHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixPipelineExecutableStatisticFormatKHR
      [(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR
      String
conNamePipelineExecutableStatisticFormatKHR
      (\(PipelineExecutableStatisticFormatKHR Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read PipelineExecutableStatisticFormatKHR where
  readPrec :: ReadPrec PipelineExecutableStatisticFormatKHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixPipelineExecutableStatisticFormatKHR
      [(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR
      String
conNamePipelineExecutableStatisticFormatKHR
      Int32 -> PipelineExecutableStatisticFormatKHR
PipelineExecutableStatisticFormatKHR

type KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION"
pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION :: forall a. Integral a => a
$mKHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION = 1


type KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME = "VK_KHR_pipeline_executable_properties"

-- No documentation found for TopLevel "VK_KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME"
pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME = "VK_KHR_pipeline_executable_properties"