{-# language CPP #-}
-- | = Name
--
-- VK_KHR_performance_query - device extension
--
-- == VK_KHR_performance_query
--
-- [__Name String__]
--     @VK_KHR_performance_query@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     117
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1 Version 1.1>
--
-- [__Special Use__]
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse Developer tools>
--
-- [__Contact__]
--
--     -   Alon Or-bach
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_performance_query] @alonorbach%0A*Here describe the issue or question you have about the VK_KHR_performance_query extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2019-10-08
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Jesse Barker, Unity Technologies
--
--     -   Kenneth Benzie, Codeplay
--
--     -   Jan-Harald Fredriksen, ARM
--
--     -   Jeff Leger, Qualcomm
--
--     -   Jesse Hall, Google
--
--     -   Tobias Hector, AMD
--
--     -   Neil Henning, Codeplay
--
--     -   Baldur Karlsson
--
--     -   Lionel Landwerlin, Intel
--
--     -   Peter Lohrmann, AMD
--
--     -   Alon Or-bach, Samsung
--
--     -   Daniel Rakos, AMD
--
--     -   Niklas Smedberg, Unity Technologies
--
--     -   Igor Ostrowski, Intel
--
-- == Description
--
-- The @VK_KHR_performance_query@ extension adds a mechanism to allow
-- querying of performance counters for use in applications and by
-- profiling tools.
--
-- Each queue family /may/ expose counters that /can/ be enabled on a queue
-- of that family. We extend 'Vulkan.Core10.Enums.QueryType.QueryType' to
-- add a new query type for performance queries, and chain a structure on
-- 'Vulkan.Core10.Query.QueryPoolCreateInfo' to specify the performance
-- queries to enable.
--
-- == New Commands
--
-- -   'acquireProfilingLockKHR'
--
-- -   'enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR'
--
-- -   'getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR'
--
-- -   'releaseProfilingLockKHR'
--
-- == New Structures
--
-- -   'AcquireProfilingLockInfoKHR'
--
-- -   'PerformanceCounterDescriptionKHR'
--
-- -   'PerformanceCounterKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDevicePerformanceQueryFeaturesKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDevicePerformanceQueryPropertiesKHR'
--
-- -   Extending 'Vulkan.Core10.Query.QueryPoolCreateInfo':
--
--     -   'QueryPoolPerformanceCreateInfoKHR'
--
-- -   Extending 'Vulkan.Core10.Queue.SubmitInfo',
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.SubmitInfo2':
--
--     -   'PerformanceQuerySubmitInfoKHR'
--
-- == New Unions
--
-- -   'PerformanceCounterResultKHR'
--
-- == New Enums
--
-- -   'AcquireProfilingLockFlagBitsKHR'
--
-- -   'PerformanceCounterDescriptionFlagBitsKHR'
--
-- -   'PerformanceCounterScopeKHR'
--
-- -   'PerformanceCounterStorageKHR'
--
-- -   'PerformanceCounterUnitKHR'
--
-- == New Bitmasks
--
-- -   'AcquireProfilingLockFlagsKHR'
--
-- -   'PerformanceCounterDescriptionFlagsKHR'
--
-- == New Enum Constants
--
-- -   'KHR_PERFORMANCE_QUERY_EXTENSION_NAME'
--
-- -   'KHR_PERFORMANCE_QUERY_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.QueryType.QueryType':
--
--     -   'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ACQUIRE_PROFILING_LOCK_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PERFORMANCE_COUNTER_DESCRIPTION_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PERFORMANCE_COUNTER_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PERFORMANCE_QUERY_SUBMIT_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_FEATURES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_PROPERTIES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_QUERY_POOL_PERFORMANCE_CREATE_INFO_KHR'
--
-- == Issues
--
-- 1) Should this extension include a mechanism to begin a query in command
-- buffer /A/ and end the query in command buffer /B/?
--
-- __RESOLVED__ No - queries are tied to command buffer creation and thus
-- have to be encapsulated within a single command buffer.
--
-- 2) Should this extension include a mechanism to begin and end queries
-- globally on the queue, not using the existing command buffer commands?
--
-- __RESOLVED__ No - for the same reasoning as the resolution of 1).
--
-- 3) Should this extension expose counters that require multiple passes?
--
-- __RESOLVED__ Yes - users should re-submit a command buffer with the same
-- commands in it multiple times, specifying the pass to count as the query
-- parameter in VkPerformanceQuerySubmitInfoKHR.
--
-- 4) How to handle counters across parallel workloads?
--
-- __RESOLVED__ In the spirit of Vulkan, a counter description flag
-- 'PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR' denotes
-- that the accuracy of a counter result is affected by parallel workloads.
--
-- 5) How to handle secondary command buffers?
--
-- __RESOLVED__ Secondary command buffers inherit any counter pass index
-- specified in the parent primary command buffer. Note: this is no longer
-- an issue after change from issue 10 resolution
--
-- 6) What commands does the profiling lock have to be held for?
--
-- __RESOLVED__ For any command buffer that is being queried with a
-- performance query pool, the profiling lock /must/ be held while that
-- command buffer is in the /recording/, /executable/, or /pending state/.
--
-- 7) Should we support
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyQueryPoolResults'?
--
-- __RESOLVED__ Yes.
--
-- 8) Should we allow performance queries to interact with multiview?
--
-- __RESOLVED__ Yes, but the performance queries must be performed once for
-- each pass per view.
--
-- 9) Should a @queryCount > 1@ be usable for performance queries?
--
-- __RESOLVED__ Yes. Some vendors will have costly performance counter
-- query pool creation, and would rather if a certain set of counters were
-- to be used multiple times that a @queryCount > 1@ can be used to
-- amortize the instantiation cost.
--
-- 10) Should we introduce an indirect mechanism to set the counter pass
-- index?
--
-- __RESOLVED__ Specify the counter pass index at submit time instead, to
-- avoid requiring re-recording of command buffers when multiple counter
-- passes are needed.
--
-- == Examples
--
-- The following example shows how to find what performance counters a
-- queue family supports, setup a query pool to record these performance
-- counters, how to add the query pool to the command buffer to record
-- information, and how to get the results from the query pool.
--
-- > // A previously created physical device
-- > VkPhysicalDevice physicalDevice;
-- >
-- > // One of the queue families our device supports
-- > uint32_t queueFamilyIndex;
-- >
-- > uint32_t counterCount;
-- >
-- > // Get the count of counters supported
-- > vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR(
-- >   physicalDevice,
-- >   queueFamilyIndex,
-- >   &counterCount,
-- >   NULL,
-- >   NULL);
-- >
-- > VkPerformanceCounterKHR* counters =
-- >   malloc(sizeof(VkPerformanceCounterKHR) * counterCount);
-- > VkPerformanceCounterDescriptionKHR* counterDescriptions =
-- >   malloc(sizeof(VkPerformanceCounterDescriptionKHR) * counterCount);
-- >
-- > // Get the counters supported
-- > vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR(
-- >   physicalDevice,
-- >   queueFamilyIndex,
-- >   &counterCount,
-- >   counters,
-- >   counterDescriptions);
-- >
-- > // Try to enable the first 8 counters
-- > uint32_t enabledCounters[8];
-- >
-- > const uint32_t enabledCounterCount = min(counterCount, 8));
-- >
-- > for (uint32_t i = 0; i < enabledCounterCount; i++) {
-- >   enabledCounters[i] = i;
-- > }
-- >
-- > // A previously created device that had the performanceCounterQueryPools feature
-- > // set to VK_TRUE
-- > VkDevice device;
-- >
-- > VkQueryPoolPerformanceCreateInfoKHR performanceQueryCreateInfo = {
-- >   .sType = VK_STRUCTURE_TYPE_QUERY_POOL_PERFORMANCE_CREATE_INFO_KHR,
-- >   .pNext = NULL,
-- >
-- >   // Specify the queue family that this performance query is performed on
-- >   .queueFamilyIndex = queueFamilyIndex,
-- >
-- >   // The number of counters to enable
-- >   .counterIndexCount = enabledCounterCount,
-- >
-- >   // The array of indices of counters to enable
-- >   .pCounterIndices = enabledCounters
-- > };
-- >
-- >
-- > // Get the number of passes our counters will require.
-- > uint32_t numPasses;
-- >
-- > vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR(
-- >   physicalDevice,
-- >   &performanceQueryCreateInfo,
-- >   &numPasses);
-- >
-- > VkQueryPoolCreateInfo queryPoolCreateInfo = {
-- >   .sType = VK_STRUCTURE_TYPE_QUERY_POOL_CREATE_INFO,
-- >   .pNext = &performanceQueryCreateInfo,
-- >   .flags = 0,
-- >   // Using our new query type here
-- >   .queryType = VK_QUERY_TYPE_PERFORMANCE_QUERY_KHR,
-- >   .queryCount = 1,
-- >   .pipelineStatistics = 0
-- > };
-- >
-- > VkQueryPool queryPool;
-- >
-- > VkResult result = vkCreateQueryPool(
-- >   device,
-- >   &queryPoolCreateInfo,
-- >   NULL,
-- >   &queryPool);
-- >
-- > assert(VK_SUCCESS == result);
-- >
-- > // A queue from queueFamilyIndex
-- > VkQueue queue;
-- >
-- > // A command buffer we want to record counters on
-- > VkCommandBuffer commandBuffer;
-- >
-- > VkCommandBufferBeginInfo commandBufferBeginInfo = {
-- >   .sType = VK_STRUCTURE_TYPE_COMMAND_BUFFER_BEGIN_INFO,
-- >   .pNext = NULL,
-- >   .flags = 0,
-- >   .pInheritanceInfo = NULL
-- > };
-- >
-- > VkAcquireProfilingLockInfoKHR lockInfo = {
-- >   .sType = VK_STRUCTURE_TYPE_ACQUIRE_PROFILING_LOCK_INFO_KHR,
-- >   .pNext = NULL,
-- >   .flags = 0,
-- >   .timeout = UINT64_MAX // Wait forever for the lock
-- > };
-- >
-- > // Acquire the profiling lock before we record command buffers
-- > // that will use performance queries
-- >
-- > result = vkAcquireProfilingLockKHR(device, &lockInfo);
-- >
-- > assert(VK_SUCCESS == result);
-- >
-- > result = vkBeginCommandBuffer(commandBuffer, &commandBufferBeginInfo);
-- >
-- > assert(VK_SUCCESS == result);
-- >
-- > vkCmdResetQueryPool(
-- >   commandBuffer,
-- >   queryPool,
-- >   0,
-- >   1);
-- >
-- > vkCmdBeginQuery(
-- >   commandBuffer,
-- >   queryPool,
-- >   0,
-- >   0);
-- >
-- > // Perform the commands you want to get performance information on
-- > // ...
-- >
-- > // Perform a barrier to ensure all previous commands were complete before
-- > // ending the query
-- > vkCmdPipelineBarrier(commandBuffer,
-- >   VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT,
-- >   VK_PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT,
-- >   0,
-- >   0,
-- >   NULL,
-- >   0,
-- >   NULL,
-- >   0,
-- >   NULL);
-- >
-- > vkCmdEndQuery(
-- >   commandBuffer,
-- >   queryPool,
-- >   0);
-- >
-- > result = vkEndCommandBuffer(commandBuffer);
-- >
-- > assert(VK_SUCCESS == result);
-- >
-- > for (uint32_t counterPass = 0; counterPass < numPasses; counterPass++) {
-- >
-- >   VkPerformanceQuerySubmitInfoKHR performanceQuerySubmitInfo = {
-- >     VK_STRUCTURE_TYPE_PERFORMANCE_QUERY_SUBMIT_INFO_KHR,
-- >     NULL,
-- >     counterPass
-- >   };
-- >
-- >
-- >   // Submit the command buffer and wait for its completion
-- >   // ...
-- > }
-- >
-- > // Release the profiling lock after the command buffer is no longer in the
-- > // pending state.
-- > vkReleaseProfilingLockKHR(device);
-- >
-- > result = vkResetCommandBuffer(commandBuffer, 0);
-- >
-- > assert(VK_SUCCESS == result);
-- >
-- > // Create an array to hold the results of all counters
-- > VkPerformanceCounterResultKHR* recordedCounters = malloc(
-- >   sizeof(VkPerformanceCounterResultKHR) * enabledCounterCount);
-- >
-- > result = vkGetQueryPoolResults(
-- >   device,
-- >   queryPool,
-- >   0,
-- >   1,
-- >   sizeof(VkPerformanceCounterResultKHR) * enabledCounterCount,
-- >   recordedCounters,
-- >   sizeof(VkPerformanceCounterResultKHR) * enabledCounterCount,
-- >   NULL);
-- >
-- > // recordedCounters is filled with our counters, we will look at one for posterity
-- > switch (counters[0].storage) {
-- >   case VK_PERFORMANCE_COUNTER_STORAGE_INT32:
-- >     // use recordCounters[0].int32 to get at the counter result!
-- >     break;
-- >   case VK_PERFORMANCE_COUNTER_STORAGE_INT64:
-- >     // use recordCounters[0].int64 to get at the counter result!
-- >     break;
-- >   case VK_PERFORMANCE_COUNTER_STORAGE_UINT32:
-- >     // use recordCounters[0].uint32 to get at the counter result!
-- >     break;
-- >   case VK_PERFORMANCE_COUNTER_STORAGE_UINT64:
-- >     // use recordCounters[0].uint64 to get at the counter result!
-- >     break;
-- >   case VK_PERFORMANCE_COUNTER_STORAGE_FLOAT32:
-- >     // use recordCounters[0].float32 to get at the counter result!
-- >     break;
-- >   case VK_PERFORMANCE_COUNTER_STORAGE_FLOAT64:
-- >     // use recordCounters[0].float64 to get at the counter result!
-- >     break;
-- > }
--
-- == Version History
--
-- -   Revision 1, 2019-10-08
--
-- == See Also
--
-- 'AcquireProfilingLockFlagBitsKHR', 'AcquireProfilingLockFlagsKHR',
-- 'AcquireProfilingLockInfoKHR',
-- 'PerformanceCounterDescriptionFlagBitsKHR',
-- 'PerformanceCounterDescriptionFlagsKHR',
-- 'PerformanceCounterDescriptionKHR', 'PerformanceCounterKHR',
-- 'PerformanceCounterResultKHR', 'PerformanceCounterScopeKHR',
-- 'PerformanceCounterStorageKHR', 'PerformanceCounterUnitKHR',
-- 'PerformanceQuerySubmitInfoKHR',
-- 'PhysicalDevicePerformanceQueryFeaturesKHR',
-- 'PhysicalDevicePerformanceQueryPropertiesKHR',
-- 'QueryPoolPerformanceCreateInfoKHR', 'acquireProfilingLockKHR',
-- 'enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR',
-- 'getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR',
-- 'releaseProfilingLockKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_performance_query 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_performance_query  ( enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR
                                                   , getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR
                                                   , acquireProfilingLockKHR
                                                   , releaseProfilingLockKHR
                                                   , pattern QUERY_SCOPE_COMMAND_BUFFER_KHR
                                                   , pattern QUERY_SCOPE_RENDER_PASS_KHR
                                                   , pattern QUERY_SCOPE_COMMAND_KHR
                                                   , pattern PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_KHR
                                                   , pattern PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_KHR
                                                   , PhysicalDevicePerformanceQueryFeaturesKHR(..)
                                                   , PhysicalDevicePerformanceQueryPropertiesKHR(..)
                                                   , PerformanceCounterKHR(..)
                                                   , PerformanceCounterDescriptionKHR(..)
                                                   , QueryPoolPerformanceCreateInfoKHR(..)
                                                   , AcquireProfilingLockInfoKHR(..)
                                                   , PerformanceQuerySubmitInfoKHR(..)
                                                   , PerformanceCounterResultKHR(..)
                                                   , PerformanceCounterScopeKHR( PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR
                                                                               , PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR
                                                                               , PERFORMANCE_COUNTER_SCOPE_COMMAND_KHR
                                                                               , ..
                                                                               )
                                                   , PerformanceCounterUnitKHR( PERFORMANCE_COUNTER_UNIT_GENERIC_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_BYTES_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_KELVIN_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_WATTS_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_VOLTS_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_AMPS_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_HERTZ_KHR
                                                                              , PERFORMANCE_COUNTER_UNIT_CYCLES_KHR
                                                                              , ..
                                                                              )
                                                   , PerformanceCounterStorageKHR( PERFORMANCE_COUNTER_STORAGE_INT32_KHR
                                                                                 , PERFORMANCE_COUNTER_STORAGE_INT64_KHR
                                                                                 , PERFORMANCE_COUNTER_STORAGE_UINT32_KHR
                                                                                 , PERFORMANCE_COUNTER_STORAGE_UINT64_KHR
                                                                                 , PERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR
                                                                                 , PERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR
                                                                                 , ..
                                                                                 )
                                                   , PerformanceCounterDescriptionFlagsKHR
                                                   , PerformanceCounterDescriptionFlagBitsKHR( PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR
                                                                                             , PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR
                                                                                             , ..
                                                                                             )
                                                   , AcquireProfilingLockFlagsKHR
                                                   , AcquireProfilingLockFlagBitsKHR(..)
                                                   , KHR_PERFORMANCE_QUERY_SPEC_VERSION
                                                   , pattern KHR_PERFORMANCE_QUERY_SPEC_VERSION
                                                   , KHR_PERFORMANCE_QUERY_EXTENSION_NAME
                                                   , pattern KHR_PERFORMANCE_QUERY_EXTENSION_NAME
                                                   ) where

import Data.Bits (Bits)
import Data.Bits (FiniteBits)
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 (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Data.ByteString (packCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.Trans.Cont (runContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
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(CDouble))
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(CFloat))
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.Word (Word8)
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 (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
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(pVkAcquireProfilingLockKHR))
import Vulkan.Dynamic (DeviceCmds(pVkReleaseProfilingLockKHR))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Dynamic (InstanceCmds(pVkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR))
import Vulkan.Core10.APIConstants (MAX_DESCRIPTION_SIZE)
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.APIConstants (UUID_SIZE)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACQUIRE_PROFILING_LOCK_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PERFORMANCE_COUNTER_DESCRIPTION_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PERFORMANCE_COUNTER_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PERFORMANCE_QUERY_SUBMIT_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_PROPERTIES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_QUERY_POOL_PERFORMANCE_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR
  :: FunPtr (Ptr PhysicalDevice_T -> Word32 -> Ptr Word32 -> Ptr PerformanceCounterKHR -> Ptr PerformanceCounterDescriptionKHR -> IO Result) -> Ptr PhysicalDevice_T -> Word32 -> Ptr Word32 -> Ptr PerformanceCounterKHR -> Ptr PerformanceCounterDescriptionKHR -> IO Result

-- | vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR -
-- Reports properties of the performance query counters available on a
-- queue family of a device
--
-- = Description
--
-- If @pCounters@ is @NULL@ and @pCounterDescriptions@ is @NULL@, then the
-- number of counters available is returned in @pCounterCount@. Otherwise,
-- @pCounterCount@ /must/ point to a variable set by the user to the number
-- of elements in the @pCounters@, @pCounterDescriptions@, or both arrays
-- and on return the variable is overwritten with the number of structures
-- actually written out. If @pCounterCount@ is less than the number of
-- counters available, at most @pCounterCount@ 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 counters were returned.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR-pCounterCount-parameter#
--     @pCounterCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR-pCounters-parameter#
--     If the value referenced by @pCounterCount@ is not @0@, and
--     @pCounters@ is not @NULL@, @pCounters@ /must/ be a valid pointer to
--     an array of @pCounterCount@ 'PerformanceCounterKHR' structures
--
-- -   #VUID-vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR-pCounterDescriptions-parameter#
--     If the value referenced by @pCounterCount@ is not @0@, and
--     @pCounterDescriptions@ is not @NULL@, @pCounterDescriptions@ /must/
--     be a valid pointer to an array of @pCounterCount@
--     'PerformanceCounterDescriptionKHR' 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'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterDescriptionKHR', 'PerformanceCounterKHR',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR :: forall io
                                                               . (MonadIO io)
                                                              => -- | @physicalDevice@ is the handle to the physical device whose queue family
                                                                 -- performance query counter properties will be queried.
                                                                 PhysicalDevice
                                                              -> -- | @queueFamilyIndex@ is the index into the queue family of the physical
                                                                 -- device we want to get properties for.
                                                                 ("queueFamilyIndex" ::: Word32)
                                                              -> io (Result, ("counters" ::: Vector PerformanceCounterKHR), ("counterDescriptions" ::: Vector PerformanceCounterDescriptionKHR))
enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> Flags
-> io
     (Result, "counters" ::: Vector PerformanceCounterKHR,
      "counterDescriptions" ::: Vector PerformanceCounterDescriptionKHR)
enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR PhysicalDevice
physicalDevice
                                                                Flags
queueFamilyIndex = 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 vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Flags
   -> ("pCounterCount" ::: Ptr Flags)
   -> ("pCounters" ::: Ptr PerformanceCounterKHR)
   -> ("pCounterDescriptions"
       ::: Ptr PerformanceCounterDescriptionKHR)
   -> IO Result)
vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Flags
      -> ("pCounterCount" ::: Ptr Flags)
      -> ("pCounters" ::: Ptr PerformanceCounterKHR)
      -> ("pCounterDescriptions"
          ::: Ptr PerformanceCounterDescriptionKHR)
      -> IO Result)
pVkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  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 PhysicalDevice_T
   -> Flags
   -> ("pCounterCount" ::: Ptr Flags)
   -> ("pCounters" ::: Ptr PerformanceCounterKHR)
   -> ("pCounterDescriptions"
       ::: Ptr PerformanceCounterDescriptionKHR)
   -> IO Result)
vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHRPtr 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 vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR' :: Ptr PhysicalDevice_T
-> Flags
-> ("pCounterCount" ::: Ptr Flags)
-> ("pCounters" ::: Ptr PerformanceCounterKHR)
-> ("pCounterDescriptions"
    ::: Ptr PerformanceCounterDescriptionKHR)
-> IO Result
vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> Flags
   -> ("pCounterCount" ::: Ptr Flags)
   -> ("pCounters" ::: Ptr PerformanceCounterKHR)
   -> ("pCounterDescriptions"
       ::: Ptr PerformanceCounterDescriptionKHR)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> Flags
-> ("pCounterCount" ::: Ptr Flags)
-> ("pCounters" ::: Ptr PerformanceCounterKHR)
-> ("pCounterDescriptions"
    ::: Ptr PerformanceCounterDescriptionKHR)
-> IO Result
mkVkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR FunPtr
  (Ptr PhysicalDevice_T
   -> Flags
   -> ("pCounterCount" ::: Ptr Flags)
   -> ("pCounters" ::: Ptr PerformanceCounterKHR)
   -> ("pCounterDescriptions"
       ::: Ptr PerformanceCounterDescriptionKHR)
   -> IO Result)
vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pCounterCount" ::: Ptr Flags
pPCounterCount <- 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
"vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR" (Ptr PhysicalDevice_T
-> Flags
-> ("pCounterCount" ::: Ptr Flags)
-> ("pCounters" ::: Ptr PerformanceCounterKHR)
-> ("pCounterDescriptions"
    ::: Ptr PerformanceCounterDescriptionKHR)
-> IO Result
vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR'
                                                                                                    Ptr PhysicalDevice_T
physicalDevice'
                                                                                                    (Flags
queueFamilyIndex)
                                                                                                    ("pCounterCount" ::: Ptr Flags
pPCounterCount)
                                                                                                    (forall a. Ptr a
nullPtr)
                                                                                                    (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))
  Flags
pCounterCount <- 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 "pCounterCount" ::: Ptr Flags
pPCounterCount
  "pCounters" ::: Ptr PerformanceCounterKHR
pPCounters <- 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 @PerformanceCounterKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Flags
pCounterCount)) forall a. Num a => a -> a -> a
* Int
48)) 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 ("pCounters" ::: Ptr PerformanceCounterKHR
pPCounters forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
48) :: Ptr PerformanceCounterKHR) 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 (Flags
pCounterCount)) forall a. Num a => a -> a -> a
- Int
1]
  "pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
pPCounterDescriptions <- 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 @PerformanceCounterDescriptionKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Flags
pCounterCount)) forall a. Num a => a -> a -> a
* Int
792)) 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 ("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
pPCounterDescriptions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
792) :: Ptr PerformanceCounterDescriptionKHR) 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 (Flags
pCounterCount)) 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
"vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR" (Ptr PhysicalDevice_T
-> Flags
-> ("pCounterCount" ::: Ptr Flags)
-> ("pCounters" ::: Ptr PerformanceCounterKHR)
-> ("pCounterDescriptions"
    ::: Ptr PerformanceCounterDescriptionKHR)
-> IO Result
vkEnumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR'
                                                                                                     Ptr PhysicalDevice_T
physicalDevice'
                                                                                                     (Flags
queueFamilyIndex)
                                                                                                     ("pCounterCount" ::: Ptr Flags
pPCounterCount)
                                                                                                     (("pCounters" ::: Ptr PerformanceCounterKHR
pPCounters))
                                                                                                     (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
pPCounterDescriptions)))
  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'))
  Flags
pCounterCount' <- 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 "pCounterCount" ::: Ptr Flags
pPCounterCount
  let x33 :: Flags
x33 = Flags
pCounterCount'
  "counters" ::: Vector PerformanceCounterKHR
pCounters' <- 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 Flags
x33) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PerformanceCounterKHR ((("pCounters" ::: Ptr PerformanceCounterKHR
pPCounters) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PerformanceCounterKHR)))
  "counterDescriptions" ::: Vector PerformanceCounterDescriptionKHR
pCounterDescriptions' <- 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 Flags
x33) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PerformanceCounterDescriptionKHR ((("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
pPCounterDescriptions) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
792 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PerformanceCounterDescriptionKHR)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "counters" ::: Vector PerformanceCounterKHR
pCounters', "counterDescriptions" ::: Vector PerformanceCounterDescriptionKHR
pCounterDescriptions')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr QueryPoolPerformanceCreateInfoKHR -> Ptr Word32 -> IO ()) -> Ptr PhysicalDevice_T -> Ptr QueryPoolPerformanceCreateInfoKHR -> Ptr Word32 -> IO ()

-- | vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR - Reports the
-- number of passes require for a performance query pool type
--
-- = Description
--
-- The @pPerformanceQueryCreateInfo@ member
-- 'QueryPoolPerformanceCreateInfoKHR'::@queueFamilyIndex@ /must/ be a
-- queue family of @physicalDevice@. The number of passes required to
-- capture the counters specified in the @pPerformanceQueryCreateInfo@
-- member 'QueryPoolPerformanceCreateInfoKHR'::@pCounters@ is returned in
-- @pNumPasses@.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'Vulkan.Core10.Handles.PhysicalDevice',
-- 'QueryPoolPerformanceCreateInfoKHR'
getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR :: forall io
                                                       . (MonadIO io)
                                                      => -- | @physicalDevice@ is the handle to the physical device whose queue family
                                                         -- performance query counter properties will be queried.
                                                         --
                                                         -- #VUID-vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR-physicalDevice-parameter#
                                                         -- @physicalDevice@ /must/ be a valid
                                                         -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                                                         PhysicalDevice
                                                      -> -- | @pPerformanceQueryCreateInfo@ is a pointer to a
                                                         -- 'QueryPoolPerformanceCreateInfoKHR' of the performance query that is to
                                                         -- be created.
                                                         --
                                                         -- #VUID-vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR-pPerformanceQueryCreateInfo-parameter#
                                                         -- @pPerformanceQueryCreateInfo@ /must/ be a valid pointer to a valid
                                                         -- 'QueryPoolPerformanceCreateInfoKHR' structure
                                                         ("performanceQueryCreateInfo" ::: QueryPoolPerformanceCreateInfoKHR)
                                                      -> io (("numPasses" ::: Word32))
getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> QueryPoolPerformanceCreateInfoKHR -> io Flags
getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR PhysicalDevice
physicalDevice
                                                        QueryPoolPerformanceCreateInfoKHR
performanceQueryCreateInfo = 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 vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPerformanceQueryCreateInfo"
       ::: Ptr QueryPoolPerformanceCreateInfoKHR)
   -> ("pCounterCount" ::: Ptr Flags)
   -> IO ())
vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPerformanceQueryCreateInfo"
          ::: Ptr QueryPoolPerformanceCreateInfoKHR)
      -> ("pCounterCount" ::: Ptr Flags)
      -> IO ())
pVkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  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 PhysicalDevice_T
   -> ("pPerformanceQueryCreateInfo"
       ::: Ptr QueryPoolPerformanceCreateInfoKHR)
   -> ("pCounterCount" ::: Ptr Flags)
   -> IO ())
vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHRPtr 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 vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR' :: Ptr PhysicalDevice_T
-> ("pPerformanceQueryCreateInfo"
    ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> ("pCounterCount" ::: Ptr Flags)
-> IO ()
vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPerformanceQueryCreateInfo"
       ::: Ptr QueryPoolPerformanceCreateInfoKHR)
   -> ("pCounterCount" ::: Ptr Flags)
   -> IO ())
-> Ptr PhysicalDevice_T
-> ("pPerformanceQueryCreateInfo"
    ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> ("pCounterCount" ::: Ptr Flags)
-> IO ()
mkVkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPerformanceQueryCreateInfo"
       ::: Ptr QueryPoolPerformanceCreateInfoKHR)
   -> ("pCounterCount" ::: Ptr Flags)
   -> IO ())
vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHRPtr
  "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
pPerformanceQueryCreateInfo <- 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 (QueryPoolPerformanceCreateInfoKHR
performanceQueryCreateInfo)
  "pCounterCount" ::: Ptr Flags
pPNumPasses <- 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
  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
"vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR" (Ptr PhysicalDevice_T
-> ("pPerformanceQueryCreateInfo"
    ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> ("pCounterCount" ::: Ptr Flags)
-> IO ()
vkGetPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR'
                                                                                       (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
                                                                                       "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
pPerformanceQueryCreateInfo
                                                                                       ("pCounterCount" ::: Ptr Flags
pPNumPasses))
  Flags
pNumPasses <- 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 "pCounterCount" ::: Ptr Flags
pPNumPasses
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Flags
pNumPasses)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkAcquireProfilingLockKHR
  :: FunPtr (Ptr Device_T -> Ptr AcquireProfilingLockInfoKHR -> IO Result) -> Ptr Device_T -> Ptr AcquireProfilingLockInfoKHR -> IO Result

-- | vkAcquireProfilingLockKHR - Acquires the profiling lock
--
-- = Description
--
-- Implementations /may/ allow multiple actors to hold the profiling lock
-- concurrently.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.TIMEOUT'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'AcquireProfilingLockInfoKHR', 'Vulkan.Core10.Handles.Device'
acquireProfilingLockKHR :: forall io
                         . (MonadIO io)
                        => -- | @device@ is the logical device to profile.
                           --
                           -- #VUID-vkAcquireProfilingLockKHR-device-parameter# @device@ /must/ be a
                           -- valid 'Vulkan.Core10.Handles.Device' handle
                           Device
                        -> -- | @pInfo@ is a pointer to a 'AcquireProfilingLockInfoKHR' structure
                           -- containing information about how the profiling is to be acquired.
                           --
                           -- #VUID-vkAcquireProfilingLockKHR-pInfo-parameter# @pInfo@ /must/ be a
                           -- valid pointer to a valid 'AcquireProfilingLockInfoKHR' structure
                           AcquireProfilingLockInfoKHR
                        -> io ()
acquireProfilingLockKHR :: forall (io :: * -> *).
MonadIO io =>
Device -> AcquireProfilingLockInfoKHR -> io ()
acquireProfilingLockKHR Device
device AcquireProfilingLockInfoKHR
info = 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 vkAcquireProfilingLockKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result)
vkAcquireProfilingLockKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result)
pVkAcquireProfilingLockKHR (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
   -> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result)
vkAcquireProfilingLockKHRPtr 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 vkAcquireProfilingLockKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkAcquireProfilingLockKHR' :: Ptr Device_T
-> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result
vkAcquireProfilingLockKHR' = FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result)
-> Ptr Device_T
-> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR)
-> IO Result
mkVkAcquireProfilingLockKHR FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result)
vkAcquireProfilingLockKHRPtr
  "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
pInfo <- 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 (AcquireProfilingLockInfoKHR
info)
  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
"vkAcquireProfilingLockKHR" (Ptr Device_T
-> ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO Result
vkAcquireProfilingLockKHR'
                                                              (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                              "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
pInfo)
  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))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkReleaseProfilingLockKHR
  :: FunPtr (Ptr Device_T -> IO ()) -> Ptr Device_T -> IO ()

-- | vkReleaseProfilingLockKHR - Releases the profiling lock
--
-- == Valid Usage
--
-- -   #VUID-vkReleaseProfilingLockKHR-device-03235# The profiling lock of
--     @device@ /must/ have been held via a previous successful call to
--     'acquireProfilingLockKHR'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkReleaseProfilingLockKHR-device-parameter# @device@ /must/ be
--     a valid 'Vulkan.Core10.Handles.Device' handle
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'Vulkan.Core10.Handles.Device'
releaseProfilingLockKHR :: forall io
                         . (MonadIO io)
                        => -- | @device@ is the logical device to cease profiling on.
                           Device
                        -> io ()
releaseProfilingLockKHR :: forall (io :: * -> *). MonadIO io => Device -> io ()
releaseProfilingLockKHR Device
device = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkReleaseProfilingLockKHRPtr :: FunPtr (Ptr Device_T -> IO ())
vkReleaseProfilingLockKHRPtr = DeviceCmds -> FunPtr (Ptr Device_T -> IO ())
pVkReleaseProfilingLockKHR (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> IO ())
vkReleaseProfilingLockKHRPtr 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 vkReleaseProfilingLockKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkReleaseProfilingLockKHR' :: Ptr Device_T -> IO ()
vkReleaseProfilingLockKHR' = FunPtr (Ptr Device_T -> IO ()) -> Ptr Device_T -> IO ()
mkVkReleaseProfilingLockKHR FunPtr (Ptr Device_T -> IO ())
vkReleaseProfilingLockKHRPtr
  forall a. String -> IO a -> IO a
traceAroundEvent String
"vkReleaseProfilingLockKHR" (Ptr Device_T -> IO ()
vkReleaseProfilingLockKHR'
                                                  (Device -> Ptr Device_T
deviceHandle (Device
device)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


-- No documentation found for TopLevel "VK_QUERY_SCOPE_COMMAND_BUFFER_KHR"
pattern $bQUERY_SCOPE_COMMAND_BUFFER_KHR :: PerformanceCounterScopeKHR
$mQUERY_SCOPE_COMMAND_BUFFER_KHR :: forall {r}.
PerformanceCounterScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
QUERY_SCOPE_COMMAND_BUFFER_KHR = PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR


-- No documentation found for TopLevel "VK_QUERY_SCOPE_RENDER_PASS_KHR"
pattern $bQUERY_SCOPE_RENDER_PASS_KHR :: PerformanceCounterScopeKHR
$mQUERY_SCOPE_RENDER_PASS_KHR :: forall {r}.
PerformanceCounterScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
QUERY_SCOPE_RENDER_PASS_KHR = PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR


-- No documentation found for TopLevel "VK_QUERY_SCOPE_COMMAND_KHR"
pattern $bQUERY_SCOPE_COMMAND_KHR :: PerformanceCounterScopeKHR
$mQUERY_SCOPE_COMMAND_KHR :: forall {r}.
PerformanceCounterScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
QUERY_SCOPE_COMMAND_KHR = PERFORMANCE_COUNTER_SCOPE_COMMAND_KHR


-- No documentation found for TopLevel "VK_PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_KHR"
pattern $bPERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_KHR :: PerformanceCounterDescriptionFlagBitsKHR
$mPERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_KHR :: forall {r}.
PerformanceCounterDescriptionFlagBitsKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_KHR = PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR


-- No documentation found for TopLevel "VK_PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_KHR"
pattern $bPERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_KHR :: PerformanceCounterDescriptionFlagBitsKHR
$mPERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_KHR :: forall {r}.
PerformanceCounterDescriptionFlagBitsKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_KHR = PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR


-- | VkPhysicalDevicePerformanceQueryFeaturesKHR - Structure describing
-- performance query support for an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDevicePerformanceQueryFeaturesKHR' 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. 'PhysicalDevicePerformanceQueryFeaturesKHR' /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_performance_query VK_KHR_performance_query>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePerformanceQueryFeaturesKHR = PhysicalDevicePerformanceQueryFeaturesKHR
  { -- | #features-performanceCounterQueryPools# @performanceCounterQueryPools@
    -- indicates whether the implementation supports performance counter query
    -- pools.
    PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
performanceCounterQueryPools :: Bool
  , -- | #features-performanceCounterMultipleQueryPools#
    -- @performanceCounterMultipleQueryPools@ indicates whether the
    -- implementation supports using multiple performance query pools in a
    -- primary command buffer and secondary command buffers executed within it.
    PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
performanceCounterMultipleQueryPools :: Bool
  }
  deriving (Typeable, PhysicalDevicePerformanceQueryFeaturesKHR
-> PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePerformanceQueryFeaturesKHR
-> PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
$c/= :: PhysicalDevicePerformanceQueryFeaturesKHR
-> PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
== :: PhysicalDevicePerformanceQueryFeaturesKHR
-> PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
$c== :: PhysicalDevicePerformanceQueryFeaturesKHR
-> PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePerformanceQueryFeaturesKHR)
#endif
deriving instance Show PhysicalDevicePerformanceQueryFeaturesKHR

instance ToCStruct PhysicalDevicePerformanceQueryFeaturesKHR where
  withCStruct :: forall b.
PhysicalDevicePerformanceQueryFeaturesKHR
-> (Ptr PhysicalDevicePerformanceQueryFeaturesKHR -> IO b) -> IO b
withCStruct PhysicalDevicePerformanceQueryFeaturesKHR
x Ptr PhysicalDevicePerformanceQueryFeaturesKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p PhysicalDevicePerformanceQueryFeaturesKHR
x (Ptr PhysicalDevicePerformanceQueryFeaturesKHR -> IO b
f Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p)
  pokeCStruct :: forall b.
Ptr PhysicalDevicePerformanceQueryFeaturesKHR
-> PhysicalDevicePerformanceQueryFeaturesKHR -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p PhysicalDevicePerformanceQueryFeaturesKHR{Bool
performanceCounterMultipleQueryPools :: Bool
performanceCounterQueryPools :: Bool
$sel:performanceCounterMultipleQueryPools:PhysicalDevicePerformanceQueryFeaturesKHR :: PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
$sel:performanceCounterQueryPools:PhysicalDevicePerformanceQueryFeaturesKHR :: PhysicalDevicePerformanceQueryFeaturesKHR -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_FEATURES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryFeaturesKHR
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 PhysicalDevicePerformanceQueryFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
performanceCounterQueryPools))
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
performanceCounterMultipleQueryPools))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDevicePerformanceQueryFeaturesKHR -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_FEATURES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryFeaturesKHR
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 PhysicalDevicePerformanceQueryFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    IO b
f

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

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

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


-- | VkPhysicalDevicePerformanceQueryPropertiesKHR - Structure describing
-- performance query properties for an implementation
--
-- = Description
--
-- If the 'PhysicalDevicePerformanceQueryPropertiesKHR' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePerformanceQueryPropertiesKHR = PhysicalDevicePerformanceQueryPropertiesKHR
  { -- | @allowCommandBufferQueryCopies@ is 'Vulkan.Core10.FundamentalTypes.TRUE'
    -- if the performance query pools are allowed to be used with
    -- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyQueryPoolResults'.
    PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
allowCommandBufferQueryCopies :: Bool }
  deriving (Typeable, PhysicalDevicePerformanceQueryPropertiesKHR
-> PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePerformanceQueryPropertiesKHR
-> PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
$c/= :: PhysicalDevicePerformanceQueryPropertiesKHR
-> PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
== :: PhysicalDevicePerformanceQueryPropertiesKHR
-> PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
$c== :: PhysicalDevicePerformanceQueryPropertiesKHR
-> PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePerformanceQueryPropertiesKHR)
#endif
deriving instance Show PhysicalDevicePerformanceQueryPropertiesKHR

instance ToCStruct PhysicalDevicePerformanceQueryPropertiesKHR where
  withCStruct :: forall b.
PhysicalDevicePerformanceQueryPropertiesKHR
-> (Ptr PhysicalDevicePerformanceQueryPropertiesKHR -> IO b)
-> IO b
withCStruct PhysicalDevicePerformanceQueryPropertiesKHR
x Ptr PhysicalDevicePerformanceQueryPropertiesKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p PhysicalDevicePerformanceQueryPropertiesKHR
x (Ptr PhysicalDevicePerformanceQueryPropertiesKHR -> IO b
f Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p)
  pokeCStruct :: forall b.
Ptr PhysicalDevicePerformanceQueryPropertiesKHR
-> PhysicalDevicePerformanceQueryPropertiesKHR -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p PhysicalDevicePerformanceQueryPropertiesKHR{Bool
allowCommandBufferQueryCopies :: Bool
$sel:allowCommandBufferQueryCopies:PhysicalDevicePerformanceQueryPropertiesKHR :: PhysicalDevicePerformanceQueryPropertiesKHR -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_PROPERTIES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryPropertiesKHR
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 PhysicalDevicePerformanceQueryPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
allowCommandBufferQueryCopies))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDevicePerformanceQueryPropertiesKHR -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PERFORMANCE_QUERY_PROPERTIES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePerformanceQueryPropertiesKHR
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 PhysicalDevicePerformanceQueryPropertiesKHR
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 PhysicalDevicePerformanceQueryPropertiesKHR where
  peekCStruct :: Ptr PhysicalDevicePerformanceQueryPropertiesKHR
-> IO PhysicalDevicePerformanceQueryPropertiesKHR
peekCStruct Ptr PhysicalDevicePerformanceQueryPropertiesKHR
p = do
    Bool32
allowCommandBufferQueryCopies <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePerformanceQueryPropertiesKHR
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 -> PhysicalDevicePerformanceQueryPropertiesKHR
PhysicalDevicePerformanceQueryPropertiesKHR
             (Bool32 -> Bool
bool32ToBool Bool32
allowCommandBufferQueryCopies)

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

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


-- | VkPerformanceCounterKHR - Structure providing information about a
-- counter
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterScopeKHR', 'PerformanceCounterStorageKHR',
-- 'PerformanceCounterUnitKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR'
data PerformanceCounterKHR = PerformanceCounterKHR
  { -- | @unit@ is a 'PerformanceCounterUnitKHR' specifying the unit that the
    -- counter data will record.
    PerformanceCounterKHR -> PerformanceCounterUnitKHR
unit :: PerformanceCounterUnitKHR
  , -- | @scope@ is a 'PerformanceCounterScopeKHR' specifying the scope that the
    -- counter belongs to.
    PerformanceCounterKHR -> PerformanceCounterScopeKHR
scope :: PerformanceCounterScopeKHR
  , -- | @storage@ is a 'PerformanceCounterStorageKHR' specifying the storage
    -- type that the counter’s data uses.
    PerformanceCounterKHR -> PerformanceCounterStorageKHR
storage :: PerformanceCounterStorageKHR
  , -- | @uuid@ is an array of size 'Vulkan.Core10.APIConstants.UUID_SIZE',
    -- containing 8-bit values that represent a universally unique identifier
    -- for the counter of the physical device.
    PerformanceCounterKHR -> ByteString
uuid :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PerformanceCounterKHR)
#endif
deriving instance Show PerformanceCounterKHR

instance ToCStruct PerformanceCounterKHR where
  withCStruct :: forall b.
PerformanceCounterKHR
-> (("pCounters" ::: Ptr PerformanceCounterKHR) -> IO b) -> IO b
withCStruct PerformanceCounterKHR
x ("pCounters" ::: Ptr PerformanceCounterKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \"pCounters" ::: Ptr PerformanceCounterKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCounters" ::: Ptr PerformanceCounterKHR
p PerformanceCounterKHR
x (("pCounters" ::: Ptr PerformanceCounterKHR) -> IO b
f "pCounters" ::: Ptr PerformanceCounterKHR
p)
  pokeCStruct :: forall b.
("pCounters" ::: Ptr PerformanceCounterKHR)
-> PerformanceCounterKHR -> IO b -> IO b
pokeCStruct "pCounters" ::: Ptr PerformanceCounterKHR
p PerformanceCounterKHR{ByteString
PerformanceCounterStorageKHR
PerformanceCounterUnitKHR
PerformanceCounterScopeKHR
uuid :: ByteString
storage :: PerformanceCounterStorageKHR
scope :: PerformanceCounterScopeKHR
unit :: PerformanceCounterUnitKHR
$sel:uuid:PerformanceCounterKHR :: PerformanceCounterKHR -> ByteString
$sel:storage:PerformanceCounterKHR :: PerformanceCounterKHR -> PerformanceCounterStorageKHR
$sel:scope:PerformanceCounterKHR :: PerformanceCounterKHR -> PerformanceCounterScopeKHR
$sel:unit:PerformanceCounterKHR :: PerformanceCounterKHR -> PerformanceCounterUnitKHR
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PERFORMANCE_COUNTER_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
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 (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PerformanceCounterUnitKHR)) (PerformanceCounterUnitKHR
unit)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PerformanceCounterScopeKHR)) (PerformanceCounterScopeKHR
scope)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PerformanceCounterStorageKHR)) (PerformanceCounterStorageKHR
storage)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr (FixedArray UUID_SIZE Word8))) (ByteString
uuid)
    IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCounters" ::: Ptr PerformanceCounterKHR) -> IO b -> IO b
pokeZeroCStruct "pCounters" ::: Ptr PerformanceCounterKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PERFORMANCE_COUNTER_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
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 (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PerformanceCounterUnitKHR)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PerformanceCounterScopeKHR)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PerformanceCounterStorageKHR)) (forall a. Zero a => a
zero)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr (FixedArray UUID_SIZE Word8))) (forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct PerformanceCounterKHR where
  peekCStruct :: ("pCounters" ::: Ptr PerformanceCounterKHR)
-> IO PerformanceCounterKHR
peekCStruct "pCounters" ::: Ptr PerformanceCounterKHR
p = do
    PerformanceCounterUnitKHR
unit <- forall a. Storable a => Ptr a -> IO a
peek @PerformanceCounterUnitKHR (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PerformanceCounterUnitKHR))
    PerformanceCounterScopeKHR
scope <- forall a. Storable a => Ptr a -> IO a
peek @PerformanceCounterScopeKHR (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PerformanceCounterScopeKHR))
    PerformanceCounterStorageKHR
storage <- forall a. Storable a => Ptr a -> IO a
peek @PerformanceCounterStorageKHR (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PerformanceCounterStorageKHR))
    ByteString
uuid <- forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr (("pCounters" ::: Ptr PerformanceCounterKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr (FixedArray UUID_SIZE Word8)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PerformanceCounterUnitKHR
-> PerformanceCounterScopeKHR
-> PerformanceCounterStorageKHR
-> ByteString
-> PerformanceCounterKHR
PerformanceCounterKHR
             PerformanceCounterUnitKHR
unit PerformanceCounterScopeKHR
scope PerformanceCounterStorageKHR
storage ByteString
uuid

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

instance Zero PerformanceCounterKHR where
  zero :: PerformanceCounterKHR
zero = PerformanceCounterUnitKHR
-> PerformanceCounterScopeKHR
-> PerformanceCounterStorageKHR
-> ByteString
-> PerformanceCounterKHR
PerformanceCounterKHR
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkPerformanceCounterDescriptionKHR - Structure providing more detailed
-- information about a counter
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterDescriptionFlagsKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR'
data PerformanceCounterDescriptionKHR = PerformanceCounterDescriptionKHR
  { -- | @flags@ is a bitmask of 'PerformanceCounterDescriptionFlagBitsKHR'
    -- indicating the usage behavior for the counter.
    PerformanceCounterDescriptionKHR
-> PerformanceCounterDescriptionFlagBitsKHR
flags :: PerformanceCounterDescriptionFlagsKHR
  , -- | @name@ is an array of size
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE', containing a
    -- null-terminated UTF-8 string specifying the name of the counter.
    PerformanceCounterDescriptionKHR -> ByteString
name :: ByteString
  , -- | @category@ is an array of size
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE', containing a
    -- null-terminated UTF-8 string specifying the category of the counter.
    PerformanceCounterDescriptionKHR -> ByteString
category :: ByteString
  , -- | @description@ is an array of size
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE', containing a
    -- null-terminated UTF-8 string specifying the description of the counter.
    PerformanceCounterDescriptionKHR -> ByteString
description :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PerformanceCounterDescriptionKHR)
#endif
deriving instance Show PerformanceCounterDescriptionKHR

instance ToCStruct PerformanceCounterDescriptionKHR where
  withCStruct :: forall b.
PerformanceCounterDescriptionKHR
-> (("pCounterDescriptions"
     ::: Ptr PerformanceCounterDescriptionKHR)
    -> IO b)
-> IO b
withCStruct PerformanceCounterDescriptionKHR
x ("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
792 forall a b. (a -> b) -> a -> b
$ \"pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p PerformanceCounterDescriptionKHR
x (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR)
-> IO b
f "pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p)
  pokeCStruct :: forall b.
("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR)
-> PerformanceCounterDescriptionKHR -> IO b -> IO b
pokeCStruct "pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p PerformanceCounterDescriptionKHR{ByteString
PerformanceCounterDescriptionFlagBitsKHR
description :: ByteString
category :: ByteString
name :: ByteString
flags :: PerformanceCounterDescriptionFlagBitsKHR
$sel:description:PerformanceCounterDescriptionKHR :: PerformanceCounterDescriptionKHR -> ByteString
$sel:category:PerformanceCounterDescriptionKHR :: PerformanceCounterDescriptionKHR -> ByteString
$sel:name:PerformanceCounterDescriptionKHR :: PerformanceCounterDescriptionKHR -> ByteString
$sel:flags:PerformanceCounterDescriptionKHR :: PerformanceCounterDescriptionKHR
-> PerformanceCounterDescriptionFlagBitsKHR
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PERFORMANCE_COUNTER_DESCRIPTION_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
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 (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PerformanceCounterDescriptionFlagsKHR)) (PerformanceCounterDescriptionFlagBitsKHR
flags)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
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 (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
category)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    IO b
f
  cStructSize :: Int
cStructSize = Int
792
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR)
-> IO b -> IO b
pokeZeroCStruct "pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PERFORMANCE_COUNTER_DESCRIPTION_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
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 (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
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 (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
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 (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct PerformanceCounterDescriptionKHR where
  peekCStruct :: ("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR)
-> IO PerformanceCounterDescriptionKHR
peekCStruct "pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p = do
    PerformanceCounterDescriptionFlagBitsKHR
flags <- forall a. Storable a => Ptr a -> IO a
peek @PerformanceCounterDescriptionFlagsKHR (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PerformanceCounterDescriptionFlagsKHR))
    ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    ByteString
category <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pCounterDescriptions" ::: Ptr PerformanceCounterDescriptionKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PerformanceCounterDescriptionFlagBitsKHR
-> ByteString
-> ByteString
-> ByteString
-> PerformanceCounterDescriptionKHR
PerformanceCounterDescriptionKHR
             PerformanceCounterDescriptionFlagBitsKHR
flags ByteString
name ByteString
category ByteString
description

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

instance Zero PerformanceCounterDescriptionKHR where
  zero :: PerformanceCounterDescriptionKHR
zero = PerformanceCounterDescriptionFlagBitsKHR
-> ByteString
-> ByteString
-> ByteString
-> PerformanceCounterDescriptionKHR
PerformanceCounterDescriptionKHR
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty


-- | VkQueryPoolPerformanceCreateInfoKHR - Structure specifying parameters of
-- a newly created performance query pool
--
-- == Valid Usage
--
-- -   #VUID-VkQueryPoolPerformanceCreateInfoKHR-queueFamilyIndex-03236#
--     @queueFamilyIndex@ /must/ be a valid queue family index of the
--     device
--
-- -   #VUID-VkQueryPoolPerformanceCreateInfoKHR-performanceCounterQueryPools-03237#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-performanceCounterQueryPools performanceCounterQueryPools>
--     feature /must/ be enabled
--
-- -   #VUID-VkQueryPoolPerformanceCreateInfoKHR-pCounterIndices-03321#
--     Each element of @pCounterIndices@ /must/ be in the range of counters
--     reported by
--     'enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR' for
--     the queue family specified in @queueFamilyIndex@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkQueryPoolPerformanceCreateInfoKHR-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_QUERY_POOL_PERFORMANCE_CREATE_INFO_KHR'
--
-- -   #VUID-VkQueryPoolPerformanceCreateInfoKHR-pCounterIndices-parameter#
--     @pCounterIndices@ /must/ be a valid pointer to an array of
--     @counterIndexCount@ @uint32_t@ values
--
-- -   #VUID-VkQueryPoolPerformanceCreateInfoKHR-counterIndexCount-arraylength#
--     @counterIndexCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR'
data QueryPoolPerformanceCreateInfoKHR = QueryPoolPerformanceCreateInfoKHR
  { -- | @queueFamilyIndex@ is the queue family index to create this performance
    -- query pool for.
    QueryPoolPerformanceCreateInfoKHR -> Flags
queueFamilyIndex :: Word32
  , -- | @pCounterIndices@ is a pointer to an array of indices into the
    -- 'enumeratePhysicalDeviceQueueFamilyPerformanceQueryCountersKHR'::@pCounters@
    -- to enable in this performance query pool.
    QueryPoolPerformanceCreateInfoKHR -> Vector Flags
counterIndices :: Vector Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (QueryPoolPerformanceCreateInfoKHR)
#endif
deriving instance Show QueryPoolPerformanceCreateInfoKHR

instance ToCStruct QueryPoolPerformanceCreateInfoKHR where
  withCStruct :: forall b.
QueryPoolPerformanceCreateInfoKHR
-> (("pPerformanceQueryCreateInfo"
     ::: Ptr QueryPoolPerformanceCreateInfoKHR)
    -> IO b)
-> IO b
withCStruct QueryPoolPerformanceCreateInfoKHR
x ("pPerformanceQueryCreateInfo"
 ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p QueryPoolPerformanceCreateInfoKHR
x (("pPerformanceQueryCreateInfo"
 ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> IO b
f "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p)
  pokeCStruct :: forall b.
("pPerformanceQueryCreateInfo"
 ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> QueryPoolPerformanceCreateInfoKHR -> IO b -> IO b
pokeCStruct "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p QueryPoolPerformanceCreateInfoKHR{Flags
Vector Flags
counterIndices :: Vector Flags
queueFamilyIndex :: Flags
$sel:counterIndices:QueryPoolPerformanceCreateInfoKHR :: QueryPoolPerformanceCreateInfoKHR -> Vector Flags
$sel:queueFamilyIndex:QueryPoolPerformanceCreateInfoKHR :: QueryPoolPerformanceCreateInfoKHR -> Flags
..} 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 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_QUERY_POOL_PERFORMANCE_CREATE_INFO_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 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
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 a. Storable a => Ptr a -> a -> IO ()
poke (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Flags
queueFamilyIndex)
    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 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Flags
counterIndices)) :: Word32))
    "pCounterCount" ::: Ptr Flags
pPCounterIndices' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 ((forall a. Vector a -> Int
Data.Vector.length (Vector Flags
counterIndices)) forall a. Num a => a -> a -> a
* Int
4)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Flags
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pCounterCount" ::: Ptr Flags
pPCounterIndices' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Flags
e)) (Vector Flags
counterIndices)
    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 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word32))) ("pCounterCount" ::: Ptr Flags
pPCounterIndices')
    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
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pPerformanceQueryCreateInfo"
 ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> IO b -> IO b
pokeZeroCStruct "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_QUERY_POOL_PERFORMANCE_CREATE_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
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 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct QueryPoolPerformanceCreateInfoKHR where
  peekCStruct :: ("pPerformanceQueryCreateInfo"
 ::: Ptr QueryPoolPerformanceCreateInfoKHR)
-> IO QueryPoolPerformanceCreateInfoKHR
peekCStruct "pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p = do
    Flags
queueFamilyIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Flags
counterIndexCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    "pCounterCount" ::: Ptr Flags
pCounterIndices <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) (("pPerformanceQueryCreateInfo"
::: Ptr QueryPoolPerformanceCreateInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word32)))
    Vector Flags
pCounterIndices' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
counterIndexCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCounterCount" ::: Ptr Flags
pCounterIndices forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Flags -> Vector Flags -> QueryPoolPerformanceCreateInfoKHR
QueryPoolPerformanceCreateInfoKHR
             Flags
queueFamilyIndex Vector Flags
pCounterIndices'

instance Zero QueryPoolPerformanceCreateInfoKHR where
  zero :: QueryPoolPerformanceCreateInfoKHR
zero = Flags -> Vector Flags -> QueryPoolPerformanceCreateInfoKHR
QueryPoolPerformanceCreateInfoKHR
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkAcquireProfilingLockInfoKHR - Structure specifying parameters to
-- acquire the profiling lock
--
-- == Valid Usage (Implicit)
--
-- If @timeout@ is 0, 'acquireProfilingLockKHR' will not block while
-- attempting to acquire the profiling lock. If @timeout@ is @UINT64_MAX@,
-- the function will not return until the profiling lock was acquired.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'AcquireProfilingLockFlagsKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'acquireProfilingLockKHR'
data AcquireProfilingLockInfoKHR = AcquireProfilingLockInfoKHR
  { -- | @flags@ is reserved for future use.
    --
    -- #VUID-VkAcquireProfilingLockInfoKHR-flags-zerobitmask# @flags@ /must/ be
    -- @0@
    AcquireProfilingLockInfoKHR -> AcquireProfilingLockFlagBitsKHR
flags :: AcquireProfilingLockFlagsKHR
  , -- | @timeout@ indicates how long the function waits, in nanoseconds, if the
    -- profiling lock is not available.
    AcquireProfilingLockInfoKHR -> Word64
timeout :: Word64
  }
  deriving (Typeable, AcquireProfilingLockInfoKHR -> AcquireProfilingLockInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcquireProfilingLockInfoKHR -> AcquireProfilingLockInfoKHR -> Bool
$c/= :: AcquireProfilingLockInfoKHR -> AcquireProfilingLockInfoKHR -> Bool
== :: AcquireProfilingLockInfoKHR -> AcquireProfilingLockInfoKHR -> Bool
$c== :: AcquireProfilingLockInfoKHR -> AcquireProfilingLockInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AcquireProfilingLockInfoKHR)
#endif
deriving instance Show AcquireProfilingLockInfoKHR

instance ToCStruct AcquireProfilingLockInfoKHR where
  withCStruct :: forall b.
AcquireProfilingLockInfoKHR
-> (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO b) -> IO b
withCStruct AcquireProfilingLockInfoKHR
x ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p AcquireProfilingLockInfoKHR
x (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO b
f "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p)
  pokeCStruct :: forall b.
("pInfo" ::: Ptr AcquireProfilingLockInfoKHR)
-> AcquireProfilingLockInfoKHR -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p AcquireProfilingLockInfoKHR{Word64
AcquireProfilingLockFlagBitsKHR
timeout :: Word64
flags :: AcquireProfilingLockFlagBitsKHR
$sel:timeout:AcquireProfilingLockInfoKHR :: AcquireProfilingLockInfoKHR -> Word64
$sel:flags:AcquireProfilingLockInfoKHR :: AcquireProfilingLockInfoKHR -> AcquireProfilingLockFlagBitsKHR
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ACQUIRE_PROFILING_LOCK_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
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 (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AcquireProfilingLockFlagsKHR)) (AcquireProfilingLockFlagBitsKHR
flags)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
timeout)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pInfo" ::: Ptr AcquireProfilingLockInfoKHR) -> IO b -> IO b
pokeZeroCStruct "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ACQUIRE_PROFILING_LOCK_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
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 (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct AcquireProfilingLockInfoKHR where
  peekCStruct :: ("pInfo" ::: Ptr AcquireProfilingLockInfoKHR)
-> IO AcquireProfilingLockInfoKHR
peekCStruct "pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p = do
    AcquireProfilingLockFlagBitsKHR
flags <- forall a. Storable a => Ptr a -> IO a
peek @AcquireProfilingLockFlagsKHR (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AcquireProfilingLockFlagsKHR))
    Word64
timeout <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pInfo" ::: Ptr AcquireProfilingLockInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AcquireProfilingLockFlagBitsKHR
-> Word64 -> AcquireProfilingLockInfoKHR
AcquireProfilingLockInfoKHR
             AcquireProfilingLockFlagBitsKHR
flags Word64
timeout

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

instance Zero AcquireProfilingLockInfoKHR where
  zero :: AcquireProfilingLockInfoKHR
zero = AcquireProfilingLockFlagBitsKHR
-> Word64 -> AcquireProfilingLockInfoKHR
AcquireProfilingLockInfoKHR
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPerformanceQuerySubmitInfoKHR - Structure indicating which counter
-- pass index is active for performance queries
--
-- = Description
--
-- If the 'Vulkan.Core10.Queue.SubmitInfo'::@pNext@ chain does not include
-- this structure, the batch defaults to use counter pass index 0.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PerformanceQuerySubmitInfoKHR = PerformanceQuerySubmitInfoKHR
  { -- | @counterPassIndex@ specifies which counter pass index is active.
    --
    -- #VUID-VkPerformanceQuerySubmitInfoKHR-counterPassIndex-03221#
    -- @counterPassIndex@ /must/ be less than the number of counter passes
    -- required by any queries within the batch. The required number of counter
    -- passes for a performance query is obtained by calling
    -- 'getPhysicalDeviceQueueFamilyPerformanceQueryPassesKHR'
    PerformanceQuerySubmitInfoKHR -> Flags
counterPassIndex :: Word32 }
  deriving (Typeable, PerformanceQuerySubmitInfoKHR
-> PerformanceQuerySubmitInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceQuerySubmitInfoKHR
-> PerformanceQuerySubmitInfoKHR -> Bool
$c/= :: PerformanceQuerySubmitInfoKHR
-> PerformanceQuerySubmitInfoKHR -> Bool
== :: PerformanceQuerySubmitInfoKHR
-> PerformanceQuerySubmitInfoKHR -> Bool
$c== :: PerformanceQuerySubmitInfoKHR
-> PerformanceQuerySubmitInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PerformanceQuerySubmitInfoKHR)
#endif
deriving instance Show PerformanceQuerySubmitInfoKHR

instance ToCStruct PerformanceQuerySubmitInfoKHR where
  withCStruct :: forall b.
PerformanceQuerySubmitInfoKHR
-> (Ptr PerformanceQuerySubmitInfoKHR -> IO b) -> IO b
withCStruct PerformanceQuerySubmitInfoKHR
x Ptr PerformanceQuerySubmitInfoKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PerformanceQuerySubmitInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PerformanceQuerySubmitInfoKHR
p PerformanceQuerySubmitInfoKHR
x (Ptr PerformanceQuerySubmitInfoKHR -> IO b
f Ptr PerformanceQuerySubmitInfoKHR
p)
  pokeCStruct :: forall b.
Ptr PerformanceQuerySubmitInfoKHR
-> PerformanceQuerySubmitInfoKHR -> IO b -> IO b
pokeCStruct Ptr PerformanceQuerySubmitInfoKHR
p PerformanceQuerySubmitInfoKHR{Flags
counterPassIndex :: Flags
$sel:counterPassIndex:PerformanceQuerySubmitInfoKHR :: PerformanceQuerySubmitInfoKHR -> Flags
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PerformanceQuerySubmitInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PERFORMANCE_QUERY_SUBMIT_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PerformanceQuerySubmitInfoKHR
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 PerformanceQuerySubmitInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Flags
counterPassIndex)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr PerformanceQuerySubmitInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr PerformanceQuerySubmitInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PerformanceQuerySubmitInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PERFORMANCE_QUERY_SUBMIT_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PerformanceQuerySubmitInfoKHR
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 PerformanceQuerySubmitInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PerformanceQuerySubmitInfoKHR where
  peekCStruct :: Ptr PerformanceQuerySubmitInfoKHR
-> IO PerformanceQuerySubmitInfoKHR
peekCStruct Ptr PerformanceQuerySubmitInfoKHR
p = do
    Flags
counterPassIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PerformanceQuerySubmitInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Flags -> PerformanceQuerySubmitInfoKHR
PerformanceQuerySubmitInfoKHR
             Flags
counterPassIndex

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

instance Zero PerformanceQuerySubmitInfoKHR where
  zero :: PerformanceQuerySubmitInfoKHR
zero = Flags -> PerformanceQuerySubmitInfoKHR
PerformanceQuerySubmitInfoKHR
           forall a. Zero a => a
zero


data PerformanceCounterResultKHR
  = Int32Counter Int32
  | Int64Counter Int64
  | Uint32Counter Word32
  | Uint64Counter Word64
  | Float32Counter Float
  | Float64Counter Double
  deriving (Int -> PerformanceCounterResultKHR -> ShowS
[PerformanceCounterResultKHR] -> ShowS
PerformanceCounterResultKHR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceCounterResultKHR] -> ShowS
$cshowList :: [PerformanceCounterResultKHR] -> ShowS
show :: PerformanceCounterResultKHR -> String
$cshow :: PerformanceCounterResultKHR -> String
showsPrec :: Int -> PerformanceCounterResultKHR -> ShowS
$cshowsPrec :: Int -> PerformanceCounterResultKHR -> ShowS
Show)

instance ToCStruct PerformanceCounterResultKHR where
  withCStruct :: forall b.
PerformanceCounterResultKHR
-> (Ptr PerformanceCounterResultKHR -> IO b) -> IO b
withCStruct PerformanceCounterResultKHR
x Ptr PerformanceCounterResultKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr PerformanceCounterResultKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PerformanceCounterResultKHR
p PerformanceCounterResultKHR
x (Ptr PerformanceCounterResultKHR -> IO b
f Ptr PerformanceCounterResultKHR
p)
  pokeCStruct :: Ptr PerformanceCounterResultKHR -> PerformanceCounterResultKHR -> IO a -> IO a
  pokeCStruct :: forall b.
Ptr PerformanceCounterResultKHR
-> PerformanceCounterResultKHR -> IO b -> IO b
pokeCStruct Ptr PerformanceCounterResultKHR
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
    Int32Counter Int32
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 @_ @Int32 Ptr PerformanceCounterResultKHR
p) (Int32
v)
    Int64Counter 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 PerformanceCounterResultKHR
p) (Int64
v)
    Uint32Counter Flags
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 @_ @Word32 Ptr PerformanceCounterResultKHR
p) (Flags
v)
    Uint64Counter 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 PerformanceCounterResultKHR
p) (Word64
v)
    Float32Counter Float
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 @_ @CFloat Ptr PerformanceCounterResultKHR
p) (Float -> CFloat
CFloat (Float
v))
    Float64Counter 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 PerformanceCounterResultKHR
p) (Double -> CDouble
CDouble (Double
v))
  pokeZeroCStruct :: Ptr PerformanceCounterResultKHR -> IO b -> IO b
  pokeZeroCStruct :: forall b. Ptr PerformanceCounterResultKHR -> IO b -> IO b
pokeZeroCStruct Ptr PerformanceCounterResultKHR
_ IO b
f = IO b
f
  cStructSize :: Int
cStructSize = Int
8
  cStructAlignment :: Int
cStructAlignment = Int
8

instance Zero PerformanceCounterResultKHR where
  zero :: PerformanceCounterResultKHR
zero = Int64 -> PerformanceCounterResultKHR
Int64Counter forall a. Zero a => a
zero


-- | VkPerformanceCounterScopeKHR - Supported counter scope types
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterKHR'
newtype PerformanceCounterScopeKHR = PerformanceCounterScopeKHR Int32
  deriving newtype (PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
$c/= :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
== :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
$c== :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
Eq, Eq PerformanceCounterScopeKHR
PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> Ordering
PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR
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 :: PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR
$cmin :: PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR
max :: PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR
$cmax :: PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR
>= :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
$c>= :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
> :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
$c> :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
<= :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
$c<= :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
< :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
$c< :: PerformanceCounterScopeKHR -> PerformanceCounterScopeKHR -> Bool
compare :: PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> Ordering
$ccompare :: PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> Ordering
Ord, Ptr PerformanceCounterScopeKHR -> IO PerformanceCounterScopeKHR
Ptr PerformanceCounterScopeKHR
-> Int -> IO PerformanceCounterScopeKHR
Ptr PerformanceCounterScopeKHR
-> Int -> PerformanceCounterScopeKHR -> IO ()
Ptr PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> IO ()
PerformanceCounterScopeKHR -> Int
forall b. Ptr b -> Int -> IO PerformanceCounterScopeKHR
forall b. Ptr b -> Int -> PerformanceCounterScopeKHR -> 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 PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> IO ()
$cpoke :: Ptr PerformanceCounterScopeKHR
-> PerformanceCounterScopeKHR -> IO ()
peek :: Ptr PerformanceCounterScopeKHR -> IO PerformanceCounterScopeKHR
$cpeek :: Ptr PerformanceCounterScopeKHR -> IO PerformanceCounterScopeKHR
pokeByteOff :: forall b. Ptr b -> Int -> PerformanceCounterScopeKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> PerformanceCounterScopeKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO PerformanceCounterScopeKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PerformanceCounterScopeKHR
pokeElemOff :: Ptr PerformanceCounterScopeKHR
-> Int -> PerformanceCounterScopeKHR -> IO ()
$cpokeElemOff :: Ptr PerformanceCounterScopeKHR
-> Int -> PerformanceCounterScopeKHR -> IO ()
peekElemOff :: Ptr PerformanceCounterScopeKHR
-> Int -> IO PerformanceCounterScopeKHR
$cpeekElemOff :: Ptr PerformanceCounterScopeKHR
-> Int -> IO PerformanceCounterScopeKHR
alignment :: PerformanceCounterScopeKHR -> Int
$calignment :: PerformanceCounterScopeKHR -> Int
sizeOf :: PerformanceCounterScopeKHR -> Int
$csizeOf :: PerformanceCounterScopeKHR -> Int
Storable, PerformanceCounterScopeKHR
forall a. a -> Zero a
zero :: PerformanceCounterScopeKHR
$czero :: PerformanceCounterScopeKHR
Zero)

-- | 'PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR' - the performance counter
-- scope is a single complete command buffer.
pattern $bPERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR :: PerformanceCounterScopeKHR
$mPERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR :: forall {r}.
PerformanceCounterScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR = PerformanceCounterScopeKHR 0

-- | 'PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR' - the performance counter
-- scope is zero or more complete render passes. The performance query
-- containing the performance counter /must/ begin and end outside a render
-- pass instance.
pattern $bPERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR :: PerformanceCounterScopeKHR
$mPERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR :: forall {r}.
PerformanceCounterScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR = PerformanceCounterScopeKHR 1

-- | 'PERFORMANCE_COUNTER_SCOPE_COMMAND_KHR' - the performance counter scope
-- is zero or more commands.
pattern $bPERFORMANCE_COUNTER_SCOPE_COMMAND_KHR :: PerformanceCounterScopeKHR
$mPERFORMANCE_COUNTER_SCOPE_COMMAND_KHR :: forall {r}.
PerformanceCounterScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_SCOPE_COMMAND_KHR = PerformanceCounterScopeKHR 2

{-# COMPLETE
  PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR
  , PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR
  , PERFORMANCE_COUNTER_SCOPE_COMMAND_KHR ::
    PerformanceCounterScopeKHR
  #-}

conNamePerformanceCounterScopeKHR :: String
conNamePerformanceCounterScopeKHR :: String
conNamePerformanceCounterScopeKHR = String
"PerformanceCounterScopeKHR"

enumPrefixPerformanceCounterScopeKHR :: String
enumPrefixPerformanceCounterScopeKHR :: String
enumPrefixPerformanceCounterScopeKHR = String
"PERFORMANCE_COUNTER_SCOPE_"

showTablePerformanceCounterScopeKHR :: [(PerformanceCounterScopeKHR, String)]
showTablePerformanceCounterScopeKHR :: [(PerformanceCounterScopeKHR, String)]
showTablePerformanceCounterScopeKHR =
  [
    ( PerformanceCounterScopeKHR
PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR
    , String
"COMMAND_BUFFER_KHR"
    )
  ,
    ( PerformanceCounterScopeKHR
PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR
    , String
"RENDER_PASS_KHR"
    )
  ,
    ( PerformanceCounterScopeKHR
PERFORMANCE_COUNTER_SCOPE_COMMAND_KHR
    , String
"COMMAND_KHR"
    )
  ]

instance Show PerformanceCounterScopeKHR where
  showsPrec :: Int -> PerformanceCounterScopeKHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixPerformanceCounterScopeKHR
      [(PerformanceCounterScopeKHR, String)]
showTablePerformanceCounterScopeKHR
      String
conNamePerformanceCounterScopeKHR
      (\(PerformanceCounterScopeKHR Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read PerformanceCounterScopeKHR where
  readPrec :: ReadPrec PerformanceCounterScopeKHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixPerformanceCounterScopeKHR
      [(PerformanceCounterScopeKHR, String)]
showTablePerformanceCounterScopeKHR
      String
conNamePerformanceCounterScopeKHR
      Int32 -> PerformanceCounterScopeKHR
PerformanceCounterScopeKHR

-- | VkPerformanceCounterUnitKHR - Supported counter unit types
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterKHR'
newtype PerformanceCounterUnitKHR = PerformanceCounterUnitKHR Int32
  deriving newtype (PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
$c/= :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
== :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
$c== :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
Eq, Eq PerformanceCounterUnitKHR
PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Ordering
PerformanceCounterUnitKHR
-> PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR
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 :: PerformanceCounterUnitKHR
-> PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR
$cmin :: PerformanceCounterUnitKHR
-> PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR
max :: PerformanceCounterUnitKHR
-> PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR
$cmax :: PerformanceCounterUnitKHR
-> PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR
>= :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
$c>= :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
> :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
$c> :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
<= :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
$c<= :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
< :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
$c< :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Bool
compare :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Ordering
$ccompare :: PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> Ordering
Ord, Ptr PerformanceCounterUnitKHR -> IO PerformanceCounterUnitKHR
Ptr PerformanceCounterUnitKHR
-> Int -> IO PerformanceCounterUnitKHR
Ptr PerformanceCounterUnitKHR
-> Int -> PerformanceCounterUnitKHR -> IO ()
Ptr PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> IO ()
PerformanceCounterUnitKHR -> Int
forall b. Ptr b -> Int -> IO PerformanceCounterUnitKHR
forall b. Ptr b -> Int -> PerformanceCounterUnitKHR -> 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 PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> IO ()
$cpoke :: Ptr PerformanceCounterUnitKHR -> PerformanceCounterUnitKHR -> IO ()
peek :: Ptr PerformanceCounterUnitKHR -> IO PerformanceCounterUnitKHR
$cpeek :: Ptr PerformanceCounterUnitKHR -> IO PerformanceCounterUnitKHR
pokeByteOff :: forall b. Ptr b -> Int -> PerformanceCounterUnitKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> PerformanceCounterUnitKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO PerformanceCounterUnitKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PerformanceCounterUnitKHR
pokeElemOff :: Ptr PerformanceCounterUnitKHR
-> Int -> PerformanceCounterUnitKHR -> IO ()
$cpokeElemOff :: Ptr PerformanceCounterUnitKHR
-> Int -> PerformanceCounterUnitKHR -> IO ()
peekElemOff :: Ptr PerformanceCounterUnitKHR
-> Int -> IO PerformanceCounterUnitKHR
$cpeekElemOff :: Ptr PerformanceCounterUnitKHR
-> Int -> IO PerformanceCounterUnitKHR
alignment :: PerformanceCounterUnitKHR -> Int
$calignment :: PerformanceCounterUnitKHR -> Int
sizeOf :: PerformanceCounterUnitKHR -> Int
$csizeOf :: PerformanceCounterUnitKHR -> Int
Storable, PerformanceCounterUnitKHR
forall a. a -> Zero a
zero :: PerformanceCounterUnitKHR
$czero :: PerformanceCounterUnitKHR
Zero)

-- | 'PERFORMANCE_COUNTER_UNIT_GENERIC_KHR' - the performance counter unit is
-- a generic data point.
pattern $bPERFORMANCE_COUNTER_UNIT_GENERIC_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_GENERIC_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_GENERIC_KHR = PerformanceCounterUnitKHR 0

-- | 'PERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR' - the performance counter unit
-- is a percentage (%).
pattern $bPERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR = PerformanceCounterUnitKHR 1

-- | 'PERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR' - the performance counter
-- unit is a value of nanoseconds (ns).
pattern $bPERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR = PerformanceCounterUnitKHR 2

-- | 'PERFORMANCE_COUNTER_UNIT_BYTES_KHR' - the performance counter unit is a
-- value of bytes.
pattern $bPERFORMANCE_COUNTER_UNIT_BYTES_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_BYTES_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_BYTES_KHR = PerformanceCounterUnitKHR 3

-- | 'PERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR' - the performance
-- counter unit is a value of bytes\/s.
pattern $bPERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR = PerformanceCounterUnitKHR 4

-- | 'PERFORMANCE_COUNTER_UNIT_KELVIN_KHR' - the performance counter unit is
-- a temperature reported in Kelvin.
pattern $bPERFORMANCE_COUNTER_UNIT_KELVIN_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_KELVIN_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_KELVIN_KHR = PerformanceCounterUnitKHR 5

-- | 'PERFORMANCE_COUNTER_UNIT_WATTS_KHR' - the performance counter unit is a
-- value of watts (W).
pattern $bPERFORMANCE_COUNTER_UNIT_WATTS_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_WATTS_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_WATTS_KHR = PerformanceCounterUnitKHR 6

-- | 'PERFORMANCE_COUNTER_UNIT_VOLTS_KHR' - the performance counter unit is a
-- value of volts (V).
pattern $bPERFORMANCE_COUNTER_UNIT_VOLTS_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_VOLTS_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_VOLTS_KHR = PerformanceCounterUnitKHR 7

-- | 'PERFORMANCE_COUNTER_UNIT_AMPS_KHR' - the performance counter unit is a
-- value of amps (A).
pattern $bPERFORMANCE_COUNTER_UNIT_AMPS_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_AMPS_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_AMPS_KHR = PerformanceCounterUnitKHR 8

-- | 'PERFORMANCE_COUNTER_UNIT_HERTZ_KHR' - the performance counter unit is a
-- value of hertz (Hz).
pattern $bPERFORMANCE_COUNTER_UNIT_HERTZ_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_HERTZ_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_HERTZ_KHR = PerformanceCounterUnitKHR 9

-- | 'PERFORMANCE_COUNTER_UNIT_CYCLES_KHR' - the performance counter unit is
-- a value of cycles.
pattern $bPERFORMANCE_COUNTER_UNIT_CYCLES_KHR :: PerformanceCounterUnitKHR
$mPERFORMANCE_COUNTER_UNIT_CYCLES_KHR :: forall {r}.
PerformanceCounterUnitKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_UNIT_CYCLES_KHR = PerformanceCounterUnitKHR 10

{-# COMPLETE
  PERFORMANCE_COUNTER_UNIT_GENERIC_KHR
  , PERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR
  , PERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR
  , PERFORMANCE_COUNTER_UNIT_BYTES_KHR
  , PERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR
  , PERFORMANCE_COUNTER_UNIT_KELVIN_KHR
  , PERFORMANCE_COUNTER_UNIT_WATTS_KHR
  , PERFORMANCE_COUNTER_UNIT_VOLTS_KHR
  , PERFORMANCE_COUNTER_UNIT_AMPS_KHR
  , PERFORMANCE_COUNTER_UNIT_HERTZ_KHR
  , PERFORMANCE_COUNTER_UNIT_CYCLES_KHR ::
    PerformanceCounterUnitKHR
  #-}

conNamePerformanceCounterUnitKHR :: String
conNamePerformanceCounterUnitKHR :: String
conNamePerformanceCounterUnitKHR = String
"PerformanceCounterUnitKHR"

enumPrefixPerformanceCounterUnitKHR :: String
enumPrefixPerformanceCounterUnitKHR :: String
enumPrefixPerformanceCounterUnitKHR = String
"PERFORMANCE_COUNTER_UNIT_"

showTablePerformanceCounterUnitKHR :: [(PerformanceCounterUnitKHR, String)]
showTablePerformanceCounterUnitKHR :: [(PerformanceCounterUnitKHR, String)]
showTablePerformanceCounterUnitKHR =
  [
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_GENERIC_KHR
    , String
"GENERIC_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_PERCENTAGE_KHR
    , String
"PERCENTAGE_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_NANOSECONDS_KHR
    , String
"NANOSECONDS_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_BYTES_KHR
    , String
"BYTES_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_BYTES_PER_SECOND_KHR
    , String
"BYTES_PER_SECOND_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_KELVIN_KHR
    , String
"KELVIN_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_WATTS_KHR
    , String
"WATTS_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_VOLTS_KHR
    , String
"VOLTS_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_AMPS_KHR
    , String
"AMPS_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_HERTZ_KHR
    , String
"HERTZ_KHR"
    )
  ,
    ( PerformanceCounterUnitKHR
PERFORMANCE_COUNTER_UNIT_CYCLES_KHR
    , String
"CYCLES_KHR"
    )
  ]

instance Show PerformanceCounterUnitKHR where
  showsPrec :: Int -> PerformanceCounterUnitKHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixPerformanceCounterUnitKHR
      [(PerformanceCounterUnitKHR, String)]
showTablePerformanceCounterUnitKHR
      String
conNamePerformanceCounterUnitKHR
      (\(PerformanceCounterUnitKHR Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read PerformanceCounterUnitKHR where
  readPrec :: ReadPrec PerformanceCounterUnitKHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixPerformanceCounterUnitKHR
      [(PerformanceCounterUnitKHR, String)]
showTablePerformanceCounterUnitKHR
      String
conNamePerformanceCounterUnitKHR
      Int32 -> PerformanceCounterUnitKHR
PerformanceCounterUnitKHR

-- | VkPerformanceCounterStorageKHR - Supported counter storage types
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterKHR'
newtype PerformanceCounterStorageKHR = PerformanceCounterStorageKHR Int32
  deriving newtype (PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
$c/= :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
== :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
$c== :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
Eq, Eq PerformanceCounterStorageKHR
PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Ordering
PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> PerformanceCounterStorageKHR
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 :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> PerformanceCounterStorageKHR
$cmin :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> PerformanceCounterStorageKHR
max :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> PerformanceCounterStorageKHR
$cmax :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> PerformanceCounterStorageKHR
>= :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
$c>= :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
> :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
$c> :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
<= :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
$c<= :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
< :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
$c< :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Bool
compare :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Ordering
$ccompare :: PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> Ordering
Ord, Ptr PerformanceCounterStorageKHR -> IO PerformanceCounterStorageKHR
Ptr PerformanceCounterStorageKHR
-> Int -> IO PerformanceCounterStorageKHR
Ptr PerformanceCounterStorageKHR
-> Int -> PerformanceCounterStorageKHR -> IO ()
Ptr PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> IO ()
PerformanceCounterStorageKHR -> Int
forall b. Ptr b -> Int -> IO PerformanceCounterStorageKHR
forall b. Ptr b -> Int -> PerformanceCounterStorageKHR -> 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 PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> IO ()
$cpoke :: Ptr PerformanceCounterStorageKHR
-> PerformanceCounterStorageKHR -> IO ()
peek :: Ptr PerformanceCounterStorageKHR -> IO PerformanceCounterStorageKHR
$cpeek :: Ptr PerformanceCounterStorageKHR -> IO PerformanceCounterStorageKHR
pokeByteOff :: forall b. Ptr b -> Int -> PerformanceCounterStorageKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> PerformanceCounterStorageKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO PerformanceCounterStorageKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PerformanceCounterStorageKHR
pokeElemOff :: Ptr PerformanceCounterStorageKHR
-> Int -> PerformanceCounterStorageKHR -> IO ()
$cpokeElemOff :: Ptr PerformanceCounterStorageKHR
-> Int -> PerformanceCounterStorageKHR -> IO ()
peekElemOff :: Ptr PerformanceCounterStorageKHR
-> Int -> IO PerformanceCounterStorageKHR
$cpeekElemOff :: Ptr PerformanceCounterStorageKHR
-> Int -> IO PerformanceCounterStorageKHR
alignment :: PerformanceCounterStorageKHR -> Int
$calignment :: PerformanceCounterStorageKHR -> Int
sizeOf :: PerformanceCounterStorageKHR -> Int
$csizeOf :: PerformanceCounterStorageKHR -> Int
Storable, PerformanceCounterStorageKHR
forall a. a -> Zero a
zero :: PerformanceCounterStorageKHR
$czero :: PerformanceCounterStorageKHR
Zero)

-- | 'PERFORMANCE_COUNTER_STORAGE_INT32_KHR' - the performance counter
-- storage is a 32-bit signed integer.
pattern $bPERFORMANCE_COUNTER_STORAGE_INT32_KHR :: PerformanceCounterStorageKHR
$mPERFORMANCE_COUNTER_STORAGE_INT32_KHR :: forall {r}.
PerformanceCounterStorageKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_STORAGE_INT32_KHR = PerformanceCounterStorageKHR 0

-- | 'PERFORMANCE_COUNTER_STORAGE_INT64_KHR' - the performance counter
-- storage is a 64-bit signed integer.
pattern $bPERFORMANCE_COUNTER_STORAGE_INT64_KHR :: PerformanceCounterStorageKHR
$mPERFORMANCE_COUNTER_STORAGE_INT64_KHR :: forall {r}.
PerformanceCounterStorageKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_STORAGE_INT64_KHR = PerformanceCounterStorageKHR 1

-- | 'PERFORMANCE_COUNTER_STORAGE_UINT32_KHR' - the performance counter
-- storage is a 32-bit unsigned integer.
pattern $bPERFORMANCE_COUNTER_STORAGE_UINT32_KHR :: PerformanceCounterStorageKHR
$mPERFORMANCE_COUNTER_STORAGE_UINT32_KHR :: forall {r}.
PerformanceCounterStorageKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_STORAGE_UINT32_KHR = PerformanceCounterStorageKHR 2

-- | 'PERFORMANCE_COUNTER_STORAGE_UINT64_KHR' - the performance counter
-- storage is a 64-bit unsigned integer.
pattern $bPERFORMANCE_COUNTER_STORAGE_UINT64_KHR :: PerformanceCounterStorageKHR
$mPERFORMANCE_COUNTER_STORAGE_UINT64_KHR :: forall {r}.
PerformanceCounterStorageKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_STORAGE_UINT64_KHR = PerformanceCounterStorageKHR 3

-- | 'PERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR' - the performance counter
-- storage is a 32-bit floating-point.
pattern $bPERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR :: PerformanceCounterStorageKHR
$mPERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR :: forall {r}.
PerformanceCounterStorageKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR = PerformanceCounterStorageKHR 4

-- | 'PERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR' - the performance counter
-- storage is a 64-bit floating-point.
pattern $bPERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR :: PerformanceCounterStorageKHR
$mPERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR :: forall {r}.
PerformanceCounterStorageKHR -> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR = PerformanceCounterStorageKHR 5

{-# COMPLETE
  PERFORMANCE_COUNTER_STORAGE_INT32_KHR
  , PERFORMANCE_COUNTER_STORAGE_INT64_KHR
  , PERFORMANCE_COUNTER_STORAGE_UINT32_KHR
  , PERFORMANCE_COUNTER_STORAGE_UINT64_KHR
  , PERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR
  , PERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR ::
    PerformanceCounterStorageKHR
  #-}

conNamePerformanceCounterStorageKHR :: String
conNamePerformanceCounterStorageKHR :: String
conNamePerformanceCounterStorageKHR = String
"PerformanceCounterStorageKHR"

enumPrefixPerformanceCounterStorageKHR :: String
enumPrefixPerformanceCounterStorageKHR :: String
enumPrefixPerformanceCounterStorageKHR = String
"PERFORMANCE_COUNTER_STORAGE_"

showTablePerformanceCounterStorageKHR :: [(PerformanceCounterStorageKHR, String)]
showTablePerformanceCounterStorageKHR :: [(PerformanceCounterStorageKHR, String)]
showTablePerformanceCounterStorageKHR =
  [
    ( PerformanceCounterStorageKHR
PERFORMANCE_COUNTER_STORAGE_INT32_KHR
    , String
"INT32_KHR"
    )
  ,
    ( PerformanceCounterStorageKHR
PERFORMANCE_COUNTER_STORAGE_INT64_KHR
    , String
"INT64_KHR"
    )
  ,
    ( PerformanceCounterStorageKHR
PERFORMANCE_COUNTER_STORAGE_UINT32_KHR
    , String
"UINT32_KHR"
    )
  ,
    ( PerformanceCounterStorageKHR
PERFORMANCE_COUNTER_STORAGE_UINT64_KHR
    , String
"UINT64_KHR"
    )
  ,
    ( PerformanceCounterStorageKHR
PERFORMANCE_COUNTER_STORAGE_FLOAT32_KHR
    , String
"FLOAT32_KHR"
    )
  ,
    ( PerformanceCounterStorageKHR
PERFORMANCE_COUNTER_STORAGE_FLOAT64_KHR
    , String
"FLOAT64_KHR"
    )
  ]

instance Show PerformanceCounterStorageKHR where
  showsPrec :: Int -> PerformanceCounterStorageKHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixPerformanceCounterStorageKHR
      [(PerformanceCounterStorageKHR, String)]
showTablePerformanceCounterStorageKHR
      String
conNamePerformanceCounterStorageKHR
      (\(PerformanceCounterStorageKHR Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read PerformanceCounterStorageKHR where
  readPrec :: ReadPrec PerformanceCounterStorageKHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixPerformanceCounterStorageKHR
      [(PerformanceCounterStorageKHR, String)]
showTablePerformanceCounterStorageKHR
      String
conNamePerformanceCounterStorageKHR
      Int32 -> PerformanceCounterStorageKHR
PerformanceCounterStorageKHR

type PerformanceCounterDescriptionFlagsKHR = PerformanceCounterDescriptionFlagBitsKHR

-- | VkPerformanceCounterDescriptionFlagBitsKHR - Bitmask specifying usage
-- behavior for a counter
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'PerformanceCounterDescriptionFlagsKHR'
newtype PerformanceCounterDescriptionFlagBitsKHR = PerformanceCounterDescriptionFlagBitsKHR Flags
  deriving newtype (PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
$c/= :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
== :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
$c== :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
Eq, Eq PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Ordering
PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
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 :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
$cmin :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
max :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
$cmax :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
>= :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
$c>= :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
> :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
$c> :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
<= :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
$c<= :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
< :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
$c< :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Bool
compare :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Ordering
$ccompare :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> Ordering
Ord, Ptr PerformanceCounterDescriptionFlagBitsKHR
-> IO PerformanceCounterDescriptionFlagBitsKHR
Ptr PerformanceCounterDescriptionFlagBitsKHR
-> Int -> IO PerformanceCounterDescriptionFlagBitsKHR
Ptr PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
Ptr PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
PerformanceCounterDescriptionFlagBitsKHR -> Int
forall b.
Ptr b -> Int -> IO PerformanceCounterDescriptionFlagBitsKHR
forall b.
Ptr b -> Int -> PerformanceCounterDescriptionFlagBitsKHR -> 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 PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
$cpoke :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
peek :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> IO PerformanceCounterDescriptionFlagBitsKHR
$cpeek :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> IO PerformanceCounterDescriptionFlagBitsKHR
pokeByteOff :: forall b.
Ptr b -> Int -> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
$cpokeByteOff :: forall b.
Ptr b -> Int -> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
peekByteOff :: forall b.
Ptr b -> Int -> IO PerformanceCounterDescriptionFlagBitsKHR
$cpeekByteOff :: forall b.
Ptr b -> Int -> IO PerformanceCounterDescriptionFlagBitsKHR
pokeElemOff :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
$cpokeElemOff :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR -> IO ()
peekElemOff :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> Int -> IO PerformanceCounterDescriptionFlagBitsKHR
$cpeekElemOff :: Ptr PerformanceCounterDescriptionFlagBitsKHR
-> Int -> IO PerformanceCounterDescriptionFlagBitsKHR
alignment :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$calignment :: PerformanceCounterDescriptionFlagBitsKHR -> Int
sizeOf :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$csizeOf :: PerformanceCounterDescriptionFlagBitsKHR -> Int
Storable, PerformanceCounterDescriptionFlagBitsKHR
forall a. a -> Zero a
zero :: PerformanceCounterDescriptionFlagBitsKHR
$czero :: PerformanceCounterDescriptionFlagBitsKHR
Zero, Eq PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR
Int -> PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR -> Bool
PerformanceCounterDescriptionFlagBitsKHR -> Int
PerformanceCounterDescriptionFlagBitsKHR -> Maybe Int
PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR -> Int -> Bool
PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$cpopCount :: PerformanceCounterDescriptionFlagBitsKHR -> Int
rotateR :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$crotateR :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
rotateL :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$crotateL :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
unsafeShiftR :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$cunsafeShiftR :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
shiftR :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$cshiftR :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
unsafeShiftL :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$cunsafeShiftL :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
shiftL :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$cshiftL :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
isSigned :: PerformanceCounterDescriptionFlagBitsKHR -> Bool
$cisSigned :: PerformanceCounterDescriptionFlagBitsKHR -> Bool
bitSize :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$cbitSize :: PerformanceCounterDescriptionFlagBitsKHR -> Int
bitSizeMaybe :: PerformanceCounterDescriptionFlagBitsKHR -> Maybe Int
$cbitSizeMaybe :: PerformanceCounterDescriptionFlagBitsKHR -> Maybe Int
testBit :: PerformanceCounterDescriptionFlagBitsKHR -> Int -> Bool
$ctestBit :: PerformanceCounterDescriptionFlagBitsKHR -> Int -> Bool
complementBit :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$ccomplementBit :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
clearBit :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$cclearBit :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
setBit :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$csetBit :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
bit :: Int -> PerformanceCounterDescriptionFlagBitsKHR
$cbit :: Int -> PerformanceCounterDescriptionFlagBitsKHR
zeroBits :: PerformanceCounterDescriptionFlagBitsKHR
$czeroBits :: PerformanceCounterDescriptionFlagBitsKHR
rotate :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$crotate :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
shift :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
$cshift :: PerformanceCounterDescriptionFlagBitsKHR
-> Int -> PerformanceCounterDescriptionFlagBitsKHR
complement :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
$ccomplement :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
xor :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
$cxor :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
.|. :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
$c.|. :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
.&. :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
$c.&. :: PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
-> PerformanceCounterDescriptionFlagBitsKHR
Bits, Bits PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$ccountTrailingZeros :: PerformanceCounterDescriptionFlagBitsKHR -> Int
countLeadingZeros :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$ccountLeadingZeros :: PerformanceCounterDescriptionFlagBitsKHR -> Int
finiteBitSize :: PerformanceCounterDescriptionFlagBitsKHR -> Int
$cfiniteBitSize :: PerformanceCounterDescriptionFlagBitsKHR -> Int
FiniteBits)

-- | 'PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR'
-- specifies that recording the counter /may/ have a noticeable performance
-- impact.
pattern $bPERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR :: PerformanceCounterDescriptionFlagBitsKHR
$mPERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR :: forall {r}.
PerformanceCounterDescriptionFlagBitsKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR = PerformanceCounterDescriptionFlagBitsKHR 0x00000001

-- | 'PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR'
-- specifies that concurrently recording the counter while other submitted
-- command buffers are running /may/ impact the accuracy of the recording.
pattern $bPERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR :: PerformanceCounterDescriptionFlagBitsKHR
$mPERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR :: forall {r}.
PerformanceCounterDescriptionFlagBitsKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR = PerformanceCounterDescriptionFlagBitsKHR 0x00000002

conNamePerformanceCounterDescriptionFlagBitsKHR :: String
conNamePerformanceCounterDescriptionFlagBitsKHR :: String
conNamePerformanceCounterDescriptionFlagBitsKHR = String
"PerformanceCounterDescriptionFlagBitsKHR"

enumPrefixPerformanceCounterDescriptionFlagBitsKHR :: String
enumPrefixPerformanceCounterDescriptionFlagBitsKHR :: String
enumPrefixPerformanceCounterDescriptionFlagBitsKHR = String
"PERFORMANCE_COUNTER_DESCRIPTION_"

showTablePerformanceCounterDescriptionFlagBitsKHR :: [(PerformanceCounterDescriptionFlagBitsKHR, String)]
showTablePerformanceCounterDescriptionFlagBitsKHR :: [(PerformanceCounterDescriptionFlagBitsKHR, String)]
showTablePerformanceCounterDescriptionFlagBitsKHR =
  [
    ( PerformanceCounterDescriptionFlagBitsKHR
PERFORMANCE_COUNTER_DESCRIPTION_PERFORMANCE_IMPACTING_BIT_KHR
    , String
"PERFORMANCE_IMPACTING_BIT_KHR"
    )
  ,
    ( PerformanceCounterDescriptionFlagBitsKHR
PERFORMANCE_COUNTER_DESCRIPTION_CONCURRENTLY_IMPACTED_BIT_KHR
    , String
"CONCURRENTLY_IMPACTED_BIT_KHR"
    )
  ]

instance Show PerformanceCounterDescriptionFlagBitsKHR where
  showsPrec :: Int -> PerformanceCounterDescriptionFlagBitsKHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixPerformanceCounterDescriptionFlagBitsKHR
      [(PerformanceCounterDescriptionFlagBitsKHR, String)]
showTablePerformanceCounterDescriptionFlagBitsKHR
      String
conNamePerformanceCounterDescriptionFlagBitsKHR
      (\(PerformanceCounterDescriptionFlagBitsKHR Flags
x) -> Flags
x)
      (\Flags
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read PerformanceCounterDescriptionFlagBitsKHR where
  readPrec :: ReadPrec PerformanceCounterDescriptionFlagBitsKHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixPerformanceCounterDescriptionFlagBitsKHR
      [(PerformanceCounterDescriptionFlagBitsKHR, String)]
showTablePerformanceCounterDescriptionFlagBitsKHR
      String
conNamePerformanceCounterDescriptionFlagBitsKHR
      Flags -> PerformanceCounterDescriptionFlagBitsKHR
PerformanceCounterDescriptionFlagBitsKHR

type AcquireProfilingLockFlagsKHR = AcquireProfilingLockFlagBitsKHR

-- | VkAcquireProfilingLockFlagBitsKHR - Reserved for future use
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_performance_query VK_KHR_performance_query>,
-- 'AcquireProfilingLockFlagsKHR'
newtype AcquireProfilingLockFlagBitsKHR = AcquireProfilingLockFlagBitsKHR Flags
  deriving newtype (AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
$c/= :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
== :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
$c== :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
Eq, Eq AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Ordering
AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
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 :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
$cmin :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
max :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
$cmax :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
>= :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
$c>= :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
> :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
$c> :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
<= :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
$c<= :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
< :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
$c< :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Bool
compare :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Ordering
$ccompare :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> Ordering
Ord, Ptr AcquireProfilingLockFlagBitsKHR
-> IO AcquireProfilingLockFlagBitsKHR
Ptr AcquireProfilingLockFlagBitsKHR
-> Int -> IO AcquireProfilingLockFlagBitsKHR
Ptr AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR -> IO ()
Ptr AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> IO ()
AcquireProfilingLockFlagBitsKHR -> Int
forall b. Ptr b -> Int -> IO AcquireProfilingLockFlagBitsKHR
forall b. Ptr b -> Int -> AcquireProfilingLockFlagBitsKHR -> 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 AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> IO ()
$cpoke :: Ptr AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR -> IO ()
peek :: Ptr AcquireProfilingLockFlagBitsKHR
-> IO AcquireProfilingLockFlagBitsKHR
$cpeek :: Ptr AcquireProfilingLockFlagBitsKHR
-> IO AcquireProfilingLockFlagBitsKHR
pokeByteOff :: forall b. Ptr b -> Int -> AcquireProfilingLockFlagBitsKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> AcquireProfilingLockFlagBitsKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO AcquireProfilingLockFlagBitsKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO AcquireProfilingLockFlagBitsKHR
pokeElemOff :: Ptr AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR -> IO ()
$cpokeElemOff :: Ptr AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR -> IO ()
peekElemOff :: Ptr AcquireProfilingLockFlagBitsKHR
-> Int -> IO AcquireProfilingLockFlagBitsKHR
$cpeekElemOff :: Ptr AcquireProfilingLockFlagBitsKHR
-> Int -> IO AcquireProfilingLockFlagBitsKHR
alignment :: AcquireProfilingLockFlagBitsKHR -> Int
$calignment :: AcquireProfilingLockFlagBitsKHR -> Int
sizeOf :: AcquireProfilingLockFlagBitsKHR -> Int
$csizeOf :: AcquireProfilingLockFlagBitsKHR -> Int
Storable, AcquireProfilingLockFlagBitsKHR
forall a. a -> Zero a
zero :: AcquireProfilingLockFlagBitsKHR
$czero :: AcquireProfilingLockFlagBitsKHR
Zero, Eq AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR
Int -> AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR -> Bool
AcquireProfilingLockFlagBitsKHR -> Int
AcquireProfilingLockFlagBitsKHR -> Maybe Int
AcquireProfilingLockFlagBitsKHR -> AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR -> Int -> Bool
AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: AcquireProfilingLockFlagBitsKHR -> Int
$cpopCount :: AcquireProfilingLockFlagBitsKHR -> Int
rotateR :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$crotateR :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
rotateL :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$crotateL :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
unsafeShiftR :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$cunsafeShiftR :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
shiftR :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$cshiftR :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
unsafeShiftL :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$cunsafeShiftL :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
shiftL :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$cshiftL :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
isSigned :: AcquireProfilingLockFlagBitsKHR -> Bool
$cisSigned :: AcquireProfilingLockFlagBitsKHR -> Bool
bitSize :: AcquireProfilingLockFlagBitsKHR -> Int
$cbitSize :: AcquireProfilingLockFlagBitsKHR -> Int
bitSizeMaybe :: AcquireProfilingLockFlagBitsKHR -> Maybe Int
$cbitSizeMaybe :: AcquireProfilingLockFlagBitsKHR -> Maybe Int
testBit :: AcquireProfilingLockFlagBitsKHR -> Int -> Bool
$ctestBit :: AcquireProfilingLockFlagBitsKHR -> Int -> Bool
complementBit :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$ccomplementBit :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
clearBit :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$cclearBit :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
setBit :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$csetBit :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
bit :: Int -> AcquireProfilingLockFlagBitsKHR
$cbit :: Int -> AcquireProfilingLockFlagBitsKHR
zeroBits :: AcquireProfilingLockFlagBitsKHR
$czeroBits :: AcquireProfilingLockFlagBitsKHR
rotate :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$crotate :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
shift :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
$cshift :: AcquireProfilingLockFlagBitsKHR
-> Int -> AcquireProfilingLockFlagBitsKHR
complement :: AcquireProfilingLockFlagBitsKHR -> AcquireProfilingLockFlagBitsKHR
$ccomplement :: AcquireProfilingLockFlagBitsKHR -> AcquireProfilingLockFlagBitsKHR
xor :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
$cxor :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
.|. :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
$c.|. :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
.&. :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
$c.&. :: AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
-> AcquireProfilingLockFlagBitsKHR
Bits, Bits AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: AcquireProfilingLockFlagBitsKHR -> Int
$ccountTrailingZeros :: AcquireProfilingLockFlagBitsKHR -> Int
countLeadingZeros :: AcquireProfilingLockFlagBitsKHR -> Int
$ccountLeadingZeros :: AcquireProfilingLockFlagBitsKHR -> Int
finiteBitSize :: AcquireProfilingLockFlagBitsKHR -> Int
$cfiniteBitSize :: AcquireProfilingLockFlagBitsKHR -> Int
FiniteBits)

conNameAcquireProfilingLockFlagBitsKHR :: String
conNameAcquireProfilingLockFlagBitsKHR :: String
conNameAcquireProfilingLockFlagBitsKHR = String
"AcquireProfilingLockFlagBitsKHR"

enumPrefixAcquireProfilingLockFlagBitsKHR :: String
enumPrefixAcquireProfilingLockFlagBitsKHR :: String
enumPrefixAcquireProfilingLockFlagBitsKHR = String
""

showTableAcquireProfilingLockFlagBitsKHR :: [(AcquireProfilingLockFlagBitsKHR, String)]
showTableAcquireProfilingLockFlagBitsKHR :: [(AcquireProfilingLockFlagBitsKHR, String)]
showTableAcquireProfilingLockFlagBitsKHR = []

instance Show AcquireProfilingLockFlagBitsKHR where
  showsPrec :: Int -> AcquireProfilingLockFlagBitsKHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixAcquireProfilingLockFlagBitsKHR
      [(AcquireProfilingLockFlagBitsKHR, String)]
showTableAcquireProfilingLockFlagBitsKHR
      String
conNameAcquireProfilingLockFlagBitsKHR
      (\(AcquireProfilingLockFlagBitsKHR Flags
x) -> Flags
x)
      (\Flags
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read AcquireProfilingLockFlagBitsKHR where
  readPrec :: ReadPrec AcquireProfilingLockFlagBitsKHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixAcquireProfilingLockFlagBitsKHR
      [(AcquireProfilingLockFlagBitsKHR, String)]
showTableAcquireProfilingLockFlagBitsKHR
      String
conNameAcquireProfilingLockFlagBitsKHR
      Flags -> AcquireProfilingLockFlagBitsKHR
AcquireProfilingLockFlagBitsKHR

type KHR_PERFORMANCE_QUERY_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_PERFORMANCE_QUERY_SPEC_VERSION"
pattern KHR_PERFORMANCE_QUERY_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_PERFORMANCE_QUERY_SPEC_VERSION :: forall a. Integral a => a
$mKHR_PERFORMANCE_QUERY_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PERFORMANCE_QUERY_SPEC_VERSION = 1


type KHR_PERFORMANCE_QUERY_EXTENSION_NAME = "VK_KHR_performance_query"

-- No documentation found for TopLevel "VK_KHR_PERFORMANCE_QUERY_EXTENSION_NAME"
pattern KHR_PERFORMANCE_QUERY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_PERFORMANCE_QUERY_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_PERFORMANCE_QUERY_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PERFORMANCE_QUERY_EXTENSION_NAME = "VK_KHR_performance_query"