{-# language CPP #-}
-- | = Name
--
-- VK_EXT_validation_cache - device extension
--
-- == VK_EXT_validation_cache
--
-- [__Name String__]
--     @VK_EXT_validation_cache@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     161
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
-- [__Contact__]
--
--     -   Cort Stratton
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_validation_cache] @cdwfs%0A*Here describe the issue or question you have about the VK_EXT_validation_cache extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2017-08-29
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Cort Stratton, Google
--
--     -   Chris Forbes, Google
--
-- == Description
--
-- This extension provides a mechanism for caching the results of
-- potentially expensive internal validation operations across multiple
-- runs of a Vulkan application. At the core is the
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT' object type, which is
-- managed similarly to the existing 'Vulkan.Core10.Handles.PipelineCache'.
--
-- The new struct 'ShaderModuleValidationCacheCreateInfoEXT' can be
-- included in the @pNext@ chain at
-- 'Vulkan.Core10.Shader.createShaderModule' time. It contains a
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT' to use when validating
-- the 'Vulkan.Core10.Handles.ShaderModule'.
--
-- == New Object Types
--
-- -   'Vulkan.Extensions.Handles.ValidationCacheEXT'
--
-- == New Commands
--
-- -   'createValidationCacheEXT'
--
-- -   'destroyValidationCacheEXT'
--
-- -   'getValidationCacheDataEXT'
--
-- -   'mergeValidationCachesEXT'
--
-- == New Structures
--
-- -   'ValidationCacheCreateInfoEXT'
--
-- -   Extending 'Vulkan.Core10.Shader.ShaderModuleCreateInfo',
--     'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo':
--
--     -   'ShaderModuleValidationCacheCreateInfoEXT'
--
-- == New Enums
--
-- -   'ValidationCacheHeaderVersionEXT'
--
-- == New Bitmasks
--
-- -   'ValidationCacheCreateFlagsEXT'
--
-- == New Enum Constants
--
-- -   'EXT_VALIDATION_CACHE_EXTENSION_NAME'
--
-- -   'EXT_VALIDATION_CACHE_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.ObjectType.ObjectType':
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_VALIDATION_CACHE_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SHADER_MODULE_VALIDATION_CACHE_CREATE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_VALIDATION_CACHE_CREATE_INFO_EXT'
--
-- == Version History
--
-- -   Revision 1, 2017-08-29 (Cort Stratton)
--
--     -   Initial draft
--
-- == See Also
--
-- 'ShaderModuleValidationCacheCreateInfoEXT',
-- 'ValidationCacheCreateFlagsEXT', 'ValidationCacheCreateInfoEXT',
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT',
-- 'ValidationCacheHeaderVersionEXT', 'createValidationCacheEXT',
-- 'destroyValidationCacheEXT', 'getValidationCacheDataEXT',
-- 'mergeValidationCachesEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_validation_cache Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_validation_cache  ( createValidationCacheEXT
                                                  , withValidationCacheEXT
                                                  , destroyValidationCacheEXT
                                                  , getValidationCacheDataEXT
                                                  , mergeValidationCachesEXT
                                                  , ValidationCacheCreateInfoEXT(..)
                                                  , ShaderModuleValidationCacheCreateInfoEXT(..)
                                                  , ValidationCacheCreateFlagsEXT(..)
                                                  , ValidationCacheHeaderVersionEXT( VALIDATION_CACHE_HEADER_VERSION_ONE_EXT
                                                                                   , ..
                                                                                   )
                                                  , EXT_VALIDATION_CACHE_SPEC_VERSION
                                                  , pattern EXT_VALIDATION_CACHE_SPEC_VERSION
                                                  , EXT_VALIDATION_CACHE_EXTENSION_NAME
                                                  , pattern EXT_VALIDATION_CACHE_EXTENSION_NAME
                                                  , ValidationCacheEXT(..)
                                                  ) where

import Data.Bits (Bits)
import Data.Bits (FiniteBits)
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 (packCStringLen)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Foreign.C.Types (CSize(..))
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 (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateValidationCacheEXT))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyValidationCacheEXT))
import Vulkan.Dynamic (DeviceCmds(pVkGetValidationCacheDataEXT))
import Vulkan.Dynamic (DeviceCmds(pVkMergeValidationCachesEXT))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.Handles (ValidationCacheEXT)
import Vulkan.Extensions.Handles (ValidationCacheEXT(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SHADER_MODULE_VALIDATION_CACHE_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_VALIDATION_CACHE_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (ValidationCacheEXT(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateValidationCacheEXT
  :: FunPtr (Ptr Device_T -> Ptr ValidationCacheCreateInfoEXT -> Ptr AllocationCallbacks -> Ptr ValidationCacheEXT -> IO Result) -> Ptr Device_T -> Ptr ValidationCacheCreateInfoEXT -> Ptr AllocationCallbacks -> Ptr ValidationCacheEXT -> IO Result

-- | vkCreateValidationCacheEXT - Creates a new validation cache
--
-- = Description
--
-- Note
--
-- Applications /can/ track and manage the total host memory size of a
-- validation cache object using the @pAllocator@. Applications /can/ limit
-- the amount of data retrieved from a validation cache object in
-- 'getValidationCacheDataEXT'. Implementations /should/ not internally
-- limit the total number of entries added to a validation cache object or
-- the total host memory consumed.
--
-- Once created, a validation cache /can/ be passed to the
-- 'Vulkan.Core10.Shader.createShaderModule' command by adding this object
-- to the 'Vulkan.Core10.Shader.ShaderModuleCreateInfo' structure’s @pNext@
-- chain. If a 'ShaderModuleValidationCacheCreateInfoEXT' object is
-- included in the 'Vulkan.Core10.Shader.ShaderModuleCreateInfo'::@pNext@
-- chain, and its @validationCache@ field is not
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE', the implementation will query
-- it for possible reuse opportunities and update it with new content. The
-- use of the validation cache object in these commands is internally
-- synchronized, and the same validation cache object /can/ be used in
-- multiple threads simultaneously.
--
-- Note
--
-- Implementations /should/ make every effort to limit any critical
-- sections to the actual accesses to the cache, which is expected to be
-- significantly shorter than the duration of the
-- 'Vulkan.Core10.Shader.createShaderModule' command.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateValidationCacheEXT-device-parameter# @device@ /must/
--     be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateValidationCacheEXT-pCreateInfo-parameter#
--     @pCreateInfo@ /must/ be a valid pointer to a valid
--     'ValidationCacheCreateInfoEXT' structure
--
-- -   #VUID-vkCreateValidationCacheEXT-pAllocator-parameter# If
--     @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid pointer
--     to a valid 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks'
--     structure
--
-- -   #VUID-vkCreateValidationCacheEXT-pValidationCache-parameter#
--     @pValidationCache@ /must/ be a valid pointer to a
--     'Vulkan.Extensions.Handles.ValidationCacheEXT' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_validation_cache VK_EXT_validation_cache>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'ValidationCacheCreateInfoEXT',
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT'
createValidationCacheEXT :: forall io
                          . (MonadIO io)
                         => -- | @device@ is the logical device that creates the validation cache object.
                            Device
                         -> -- | @pCreateInfo@ is a pointer to a 'ValidationCacheCreateInfoEXT' structure
                            -- containing the initial parameters for the validation cache object.
                            ValidationCacheCreateInfoEXT
                         -> -- | @pAllocator@ controls host memory allocation as described in the
                            -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                            -- chapter.
                            ("allocator" ::: Maybe AllocationCallbacks)
                         -> io (ValidationCacheEXT)
createValidationCacheEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ValidationCacheCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ValidationCacheEXT
createValidationCacheEXT Device
device ValidationCacheCreateInfoEXT
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkCreateValidationCacheEXTPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
vkCreateValidationCacheEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
      -> IO Result)
pVkCreateValidationCacheEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
vkCreateValidationCacheEXTPtr 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 vkCreateValidationCacheEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateValidationCacheEXT' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pValidationCache" ::: Ptr ValidationCacheEXT)
-> IO Result
vkCreateValidationCacheEXT' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pValidationCache" ::: Ptr ValidationCacheEXT)
-> IO Result
mkVkCreateValidationCacheEXT FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
vkCreateValidationCacheEXTPtr
  "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ValidationCacheCreateInfoEXT
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pValidationCache" ::: Ptr ValidationCacheEXT
pPValidationCache <- 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 @ValidationCacheEXT Int
8) forall a. Ptr a -> IO ()
free
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateValidationCacheEXT" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pValidationCache" ::: Ptr ValidationCacheEXT)
-> IO Result
vkCreateValidationCacheEXT'
                                                               (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                               "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
pCreateInfo
                                                               "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                               ("pValidationCache" ::: Ptr ValidationCacheEXT
pPValidationCache))
  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))
  ValidationCacheEXT
pValidationCache <- 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 @ValidationCacheEXT "pValidationCache" ::: Ptr ValidationCacheEXT
pPValidationCache
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ValidationCacheEXT
pValidationCache)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createValidationCacheEXT' and 'destroyValidationCacheEXT'
--
-- To ensure that 'destroyValidationCacheEXT' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withValidationCacheEXT :: forall io r . MonadIO io => Device -> ValidationCacheCreateInfoEXT -> Maybe AllocationCallbacks -> (io ValidationCacheEXT -> (ValidationCacheEXT -> io ()) -> r) -> r
withValidationCacheEXT :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> ValidationCacheCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io ValidationCacheEXT -> (ValidationCacheEXT -> io ()) -> r)
-> r
withValidationCacheEXT Device
device ValidationCacheCreateInfoEXT
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io ValidationCacheEXT -> (ValidationCacheEXT -> io ()) -> r
b =
  io ValidationCacheEXT -> (ValidationCacheEXT -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> ValidationCacheCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ValidationCacheEXT
createValidationCacheEXT Device
device ValidationCacheCreateInfoEXT
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(ValidationCacheEXT
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> ValidationCacheEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyValidationCacheEXT Device
device ValidationCacheEXT
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkDestroyValidationCacheEXT - Destroy a validation cache object
--
-- == Valid Usage
--
-- -   #VUID-vkDestroyValidationCacheEXT-validationCache-01537# If
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @validationCache@ was created, a compatible set of
--     callbacks /must/ be provided here
--
-- -   #VUID-vkDestroyValidationCacheEXT-validationCache-01538# If no
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @validationCache@ was created, @pAllocator@ /must/ be
--     @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyValidationCacheEXT-device-parameter# @device@ /must/
--     be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyValidationCacheEXT-validationCache-parameter# If
--     @validationCache@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @validationCache@ /must/ be a valid
--     'Vulkan.Extensions.Handles.ValidationCacheEXT' handle
--
-- -   #VUID-vkDestroyValidationCacheEXT-pAllocator-parameter# If
--     @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid pointer
--     to a valid 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks'
--     structure
--
-- -   #VUID-vkDestroyValidationCacheEXT-validationCache-parent# If
--     @validationCache@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @validationCache@ /must/ be externally synchronized
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_validation_cache VK_EXT_validation_cache>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT'
destroyValidationCacheEXT :: forall io
                           . (MonadIO io)
                          => -- | @device@ is the logical device that destroys the validation cache
                             -- object.
                             Device
                          -> -- | @validationCache@ is the handle of the validation cache to destroy.
                             ValidationCacheEXT
                          -> -- | @pAllocator@ controls host memory allocation as described in the
                             -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                             -- chapter.
                             ("allocator" ::: Maybe AllocationCallbacks)
                          -> io ()
destroyValidationCacheEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ValidationCacheEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyValidationCacheEXT Device
device
                            ValidationCacheEXT
validationCache
                            "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyValidationCacheEXTPtr :: FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyValidationCacheEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ValidationCacheEXT
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyValidationCacheEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyValidationCacheEXTPtr 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 vkDestroyValidationCacheEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroyValidationCacheEXT' :: Ptr Device_T
-> ValidationCacheEXT
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyValidationCacheEXT' = FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> ValidationCacheEXT
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyValidationCacheEXT FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyValidationCacheEXTPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyValidationCacheEXT" (Ptr Device_T
-> ValidationCacheEXT
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyValidationCacheEXT'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           (ValidationCacheEXT
validationCache)
                                                           "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


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

-- | vkGetValidationCacheDataEXT - Get the data store from a validation cache
--
-- = Description
--
-- If @pData@ is @NULL@, then the maximum size of the data that /can/ be
-- retrieved from the validation cache, in bytes, is returned in
-- @pDataSize@. Otherwise, @pDataSize@ /must/ point to a variable set by
-- the user to the size of the buffer, in bytes, pointed to by @pData@, and
-- on return the variable is overwritten with the amount of data actually
-- written to @pData@. If @pDataSize@ is less than the maximum size that
-- /can/ be retrieved by the validation cache, at most @pDataSize@ bytes
-- will be written to @pData@, and 'getValidationCacheDataEXT' will return
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all of the
-- validation cache was returned.
--
-- Any data written to @pData@ is valid and /can/ be provided as the
-- @pInitialData@ member of the 'ValidationCacheCreateInfoEXT' structure
-- passed to 'createValidationCacheEXT'.
--
-- Two calls to 'getValidationCacheDataEXT' with the same parameters /must/
-- retrieve the same data unless a command that modifies the contents of
-- the cache is called between them.
--
-- Applications /can/ store the data retrieved from the validation cache,
-- and use these data, possibly in a future run of the application, to
-- populate new validation cache objects. The results of validation,
-- however, /may/ depend on the vendor ID, device ID, driver version, and
-- other details of the device. To enable applications to detect when
-- previously retrieved data is incompatible with the device, the initial
-- bytes written to @pData@ /must/ be a header consisting of the following
-- members:
--
-- +--------+----------------------------------------+------------------------------------------+
-- | Offset | Size                                   | Meaning                                  |
-- +========+========================================+==========================================+
-- | 0      | 4                                      | length in bytes of the entire validation |
-- |        |                                        | cache header written as a stream of      |
-- |        |                                        | bytes, with the least significant byte   |
-- |        |                                        | first                                    |
-- +--------+----------------------------------------+------------------------------------------+
-- | 4      | 4                                      | a 'ValidationCacheHeaderVersionEXT'      |
-- |        |                                        | value written as a stream of bytes, with |
-- |        |                                        | the least significant byte first         |
-- +--------+----------------------------------------+------------------------------------------+
-- | 8      | 'Vulkan.Core10.APIConstants.UUID_SIZE' | a layer commit ID expressed as a UUID,   |
-- |        |                                        | which uniquely identifies the version of |
-- |        |                                        | the validation layers used to generate   |
-- |        |                                        | these validation results                 |
-- +--------+----------------------------------------+------------------------------------------+
--
-- Layout for validation cache header version
-- 'VALIDATION_CACHE_HEADER_VERSION_ONE_EXT'
--
-- The first four bytes encode the length of the entire validation cache
-- header, in bytes. This value includes all fields in the header including
-- the validation cache version field and the size of the length field.
--
-- The next four bytes encode the validation cache version, as described
-- for 'ValidationCacheHeaderVersionEXT'. A consumer of the validation
-- cache /should/ use the cache version to interpret the remainder of the
-- cache header.
--
-- If @pDataSize@ is less than what is necessary to store this header,
-- nothing will be written to @pData@ and zero will be written to
-- @pDataSize@.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetValidationCacheDataEXT-device-parameter# @device@ /must/
--     be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetValidationCacheDataEXT-validationCache-parameter#
--     @validationCache@ /must/ be a valid
--     'Vulkan.Extensions.Handles.ValidationCacheEXT' handle
--
-- -   #VUID-vkGetValidationCacheDataEXT-pDataSize-parameter# @pDataSize@
--     /must/ be a valid pointer to a @size_t@ value
--
-- -   #VUID-vkGetValidationCacheDataEXT-pData-parameter# If the value
--     referenced by @pDataSize@ is not @0@, and @pData@ is not @NULL@,
--     @pData@ /must/ be a valid pointer to an array of @pDataSize@ bytes
--
-- -   #VUID-vkGetValidationCacheDataEXT-validationCache-parent#
--     @validationCache@ /must/ have been created, allocated, or retrieved
--     from @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_validation_cache VK_EXT_validation_cache>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT'
getValidationCacheDataEXT :: forall io
                           . (MonadIO io)
                          => -- | @device@ is the logical device that owns the validation cache.
                             Device
                          -> -- | @validationCache@ is the validation cache to retrieve data from.
                             ValidationCacheEXT
                          -> io (Result, ("data" ::: ByteString))
getValidationCacheDataEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> ValidationCacheEXT -> io (Result, "data" ::: ByteString)
getValidationCacheDataEXT Device
device ValidationCacheEXT
validationCache = 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 vkGetValidationCacheDataEXTPtr :: FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pDataSize" ::: Ptr CSize)
   -> ("pData" ::: Ptr ())
   -> IO Result)
vkGetValidationCacheDataEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ValidationCacheEXT
      -> ("pDataSize" ::: Ptr CSize)
      -> ("pData" ::: Ptr ())
      -> IO Result)
pVkGetValidationCacheDataEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pDataSize" ::: Ptr CSize)
   -> ("pData" ::: Ptr ())
   -> IO Result)
vkGetValidationCacheDataEXTPtr 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 vkGetValidationCacheDataEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetValidationCacheDataEXT' :: Ptr Device_T
-> ValidationCacheEXT
-> ("pDataSize" ::: Ptr CSize)
-> ("pData" ::: Ptr ())
-> IO Result
vkGetValidationCacheDataEXT' = FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pDataSize" ::: Ptr CSize)
   -> ("pData" ::: Ptr ())
   -> IO Result)
-> Ptr Device_T
-> ValidationCacheEXT
-> ("pDataSize" ::: Ptr CSize)
-> ("pData" ::: Ptr ())
-> IO Result
mkVkGetValidationCacheDataEXT FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("pDataSize" ::: Ptr CSize)
   -> ("pData" ::: Ptr ())
   -> IO Result)
vkGetValidationCacheDataEXTPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pDataSize" ::: Ptr CSize
pPDataSize <- 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 @CSize Int
8) forall a. Ptr a -> IO ()
free
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetValidationCacheDataEXT" (Ptr Device_T
-> ValidationCacheEXT
-> ("pDataSize" ::: Ptr CSize)
-> ("pData" ::: Ptr ())
-> IO Result
vkGetValidationCacheDataEXT'
                                                                Ptr Device_T
device'
                                                                (ValidationCacheEXT
validationCache)
                                                                ("pDataSize" ::: Ptr CSize
pPDataSize)
                                                                (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))
  CSize
pDataSize <- 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 @CSize "pDataSize" ::: Ptr CSize
pPDataSize
  "pData" ::: Ptr ()
pPData <- 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 @(()) (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pDataSize)))) 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
"vkGetValidationCacheDataEXT" (Ptr Device_T
-> ValidationCacheEXT
-> ("pDataSize" ::: Ptr CSize)
-> ("pData" ::: Ptr ())
-> IO Result
vkGetValidationCacheDataEXT'
                                                                 Ptr Device_T
device'
                                                                 (ValidationCacheEXT
validationCache)
                                                                 ("pDataSize" ::: Ptr CSize
pPDataSize)
                                                                 ("pData" ::: Ptr ()
pPData))
  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'))
  CSize
pDataSize'' <- 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 @CSize "pDataSize" ::: Ptr CSize
pPDataSize
  "data" ::: ByteString
pData' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ("data" ::: ByteString)
packCStringLen  ( forall a b. Ptr a -> Ptr b
castPtr @() @CChar "pData" ::: Ptr ()
pPData
                                   , (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pDataSize''))) )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "data" ::: ByteString
pData')


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

-- | vkMergeValidationCachesEXT - Combine the data stores of validation
-- caches
--
-- = Description
--
-- Note
--
-- The details of the merge operation are implementation-dependent, but
-- implementations /should/ merge the contents of the specified validation
-- caches and prune duplicate entries.
--
-- == Valid Usage
--
-- -   #VUID-vkMergeValidationCachesEXT-dstCache-01536# @dstCache@ /must/
--     not appear in the list of source caches
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkMergeValidationCachesEXT-device-parameter# @device@ /must/
--     be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkMergeValidationCachesEXT-dstCache-parameter# @dstCache@
--     /must/ be a valid 'Vulkan.Extensions.Handles.ValidationCacheEXT'
--     handle
--
-- -   #VUID-vkMergeValidationCachesEXT-pSrcCaches-parameter# @pSrcCaches@
--     /must/ be a valid pointer to an array of @srcCacheCount@ valid
--     'Vulkan.Extensions.Handles.ValidationCacheEXT' handles
--
-- -   #VUID-vkMergeValidationCachesEXT-srcCacheCount-arraylength#
--     @srcCacheCount@ /must/ be greater than @0@
--
-- -   #VUID-vkMergeValidationCachesEXT-dstCache-parent# @dstCache@ /must/
--     have been created, allocated, or retrieved from @device@
--
-- -   #VUID-vkMergeValidationCachesEXT-pSrcCaches-parent# Each element of
--     @pSrcCaches@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Host Synchronization
--
-- -   Host access to @dstCache@ /must/ be externally synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_validation_cache VK_EXT_validation_cache>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT'
mergeValidationCachesEXT :: forall io
                          . (MonadIO io)
                         => -- | @device@ is the logical device that owns the validation cache objects.
                            Device
                         -> -- | @dstCache@ is the handle of the validation cache to merge results into.
                            ("dstCache" ::: ValidationCacheEXT)
                         -> -- | @pSrcCaches@ is a pointer to an array of validation cache handles, which
                            -- will be merged into @dstCache@. The previous contents of @dstCache@ are
                            -- included after the merge.
                            ("srcCaches" ::: Vector ValidationCacheEXT)
                         -> io ()
mergeValidationCachesEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ValidationCacheEXT
-> ("srcCaches" ::: Vector ValidationCacheEXT)
-> io ()
mergeValidationCachesEXT Device
device ValidationCacheEXT
dstCache "srcCaches" ::: Vector ValidationCacheEXT
srcCaches = 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 vkMergeValidationCachesEXTPtr :: FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("srcCacheCount" ::: Word32)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
vkMergeValidationCachesEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ValidationCacheEXT
      -> ("srcCacheCount" ::: Word32)
      -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
      -> IO Result)
pVkMergeValidationCachesEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("srcCacheCount" ::: Word32)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
vkMergeValidationCachesEXTPtr 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 vkMergeValidationCachesEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkMergeValidationCachesEXT' :: Ptr Device_T
-> ValidationCacheEXT
-> ("srcCacheCount" ::: Word32)
-> ("pValidationCache" ::: Ptr ValidationCacheEXT)
-> IO Result
vkMergeValidationCachesEXT' = FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("srcCacheCount" ::: Word32)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
-> Ptr Device_T
-> ValidationCacheEXT
-> ("srcCacheCount" ::: Word32)
-> ("pValidationCache" ::: Ptr ValidationCacheEXT)
-> IO Result
mkVkMergeValidationCachesEXT FunPtr
  (Ptr Device_T
   -> ValidationCacheEXT
   -> ("srcCacheCount" ::: Word32)
   -> ("pValidationCache" ::: Ptr ValidationCacheEXT)
   -> IO Result)
vkMergeValidationCachesEXTPtr
  "pValidationCache" ::: Ptr ValidationCacheEXT
pPSrcCaches <- 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 @ValidationCacheEXT ((forall a. Vector a -> Int
Data.Vector.length ("srcCaches" ::: Vector ValidationCacheEXT
srcCaches)) forall a. Num a => a -> a -> a
* Int
8)
  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 ValidationCacheEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pValidationCache" ::: Ptr ValidationCacheEXT
pPSrcCaches forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ValidationCacheEXT) (ValidationCacheEXT
e)) ("srcCaches" ::: Vector ValidationCacheEXT
srcCaches)
  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
"vkMergeValidationCachesEXT" (Ptr Device_T
-> ValidationCacheEXT
-> ("srcCacheCount" ::: Word32)
-> ("pValidationCache" ::: Ptr ValidationCacheEXT)
-> IO Result
vkMergeValidationCachesEXT'
                                                               (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                               (ValidationCacheEXT
dstCache)
                                                               ((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
$ ("srcCaches" ::: Vector ValidationCacheEXT
srcCaches)) :: Word32))
                                                               ("pValidationCache" ::: Ptr ValidationCacheEXT
pPSrcCaches))
  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))


-- | VkValidationCacheCreateInfoEXT - Structure specifying parameters of a
-- newly created validation cache
--
-- == Valid Usage
--
-- -   #VUID-VkValidationCacheCreateInfoEXT-initialDataSize-01534# If
--     @initialDataSize@ is not @0@, it /must/ be equal to the size of
--     @pInitialData@, as returned by 'getValidationCacheDataEXT' when
--     @pInitialData@ was originally retrieved
--
-- -   #VUID-VkValidationCacheCreateInfoEXT-initialDataSize-01535# If
--     @initialDataSize@ is not @0@, @pInitialData@ /must/ have been
--     retrieved from a previous call to 'getValidationCacheDataEXT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkValidationCacheCreateInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_VALIDATION_CACHE_CREATE_INFO_EXT'
--
-- -   #VUID-VkValidationCacheCreateInfoEXT-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkValidationCacheCreateInfoEXT-flags-zerobitmask# @flags@
--     /must/ be @0@
--
-- -   #VUID-VkValidationCacheCreateInfoEXT-pInitialData-parameter# If
--     @initialDataSize@ is not @0@, @pInitialData@ /must/ be a valid
--     pointer to an array of @initialDataSize@ bytes
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_validation_cache VK_EXT_validation_cache>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'ValidationCacheCreateFlagsEXT', 'createValidationCacheEXT'
data ValidationCacheCreateInfoEXT = ValidationCacheCreateInfoEXT
  { -- | @flags@ is reserved for future use.
    ValidationCacheCreateInfoEXT -> ValidationCacheCreateFlagsEXT
flags :: ValidationCacheCreateFlagsEXT
  , -- | @initialDataSize@ is the number of bytes in @pInitialData@. If
    -- @initialDataSize@ is zero, the validation cache will initially be empty.
    ValidationCacheCreateInfoEXT -> Word64
initialDataSize :: Word64
  , -- | @pInitialData@ is a pointer to previously retrieved validation cache
    -- data. If the validation cache data is incompatible (as defined below)
    -- with the device, the validation cache will be initially empty. If
    -- @initialDataSize@ is zero, @pInitialData@ is ignored.
    ValidationCacheCreateInfoEXT -> "pData" ::: Ptr ()
initialData :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ValidationCacheCreateInfoEXT)
#endif
deriving instance Show ValidationCacheCreateInfoEXT

instance ToCStruct ValidationCacheCreateInfoEXT where
  withCStruct :: forall b.
ValidationCacheCreateInfoEXT
-> (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT) -> IO b)
-> IO b
withCStruct ValidationCacheCreateInfoEXT
x ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p ValidationCacheCreateInfoEXT
x (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT) -> IO b
f "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p)
  pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
-> ValidationCacheCreateInfoEXT -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p ValidationCacheCreateInfoEXT{Word64
"pData" ::: Ptr ()
ValidationCacheCreateFlagsEXT
initialData :: "pData" ::: Ptr ()
initialDataSize :: Word64
flags :: ValidationCacheCreateFlagsEXT
$sel:initialData:ValidationCacheCreateInfoEXT :: ValidationCacheCreateInfoEXT -> "pData" ::: Ptr ()
$sel:initialDataSize:ValidationCacheCreateInfoEXT :: ValidationCacheCreateInfoEXT -> Word64
$sel:flags:ValidationCacheCreateInfoEXT :: ValidationCacheCreateInfoEXT -> ValidationCacheCreateFlagsEXT
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_VALIDATION_CACHE_CREATE_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
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 (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ValidationCacheCreateFlagsEXT)) (ValidationCacheCreateFlagsEXT
flags)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
initialDataSize))
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr ()))) ("pData" ::: Ptr ()
initialData)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_VALIDATION_CACHE_CREATE_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
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 (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ValidationCacheCreateInfoEXT where
  peekCStruct :: ("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT)
-> IO ValidationCacheCreateInfoEXT
peekCStruct "pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p = do
    ValidationCacheCreateFlagsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @ValidationCacheCreateFlagsEXT (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ValidationCacheCreateFlagsEXT))
    CSize
initialDataSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CSize))
    "pData" ::: Ptr ()
pInitialData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pCreateInfo" ::: Ptr ValidationCacheCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr ())))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ValidationCacheCreateFlagsEXT
-> Word64 -> ("pData" ::: Ptr ()) -> ValidationCacheCreateInfoEXT
ValidationCacheCreateInfoEXT
             ValidationCacheCreateFlagsEXT
flags (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
initialDataSize) "pData" ::: Ptr ()
pInitialData

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

instance Zero ValidationCacheCreateInfoEXT where
  zero :: ValidationCacheCreateInfoEXT
zero = ValidationCacheCreateFlagsEXT
-> Word64 -> ("pData" ::: Ptr ()) -> ValidationCacheCreateInfoEXT
ValidationCacheCreateInfoEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkShaderModuleValidationCacheCreateInfoEXT - Specify validation cache to
-- use during shader module creation
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_validation_cache VK_EXT_validation_cache>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Extensions.Handles.ValidationCacheEXT'
data ShaderModuleValidationCacheCreateInfoEXT = ShaderModuleValidationCacheCreateInfoEXT
  { -- | @validationCache@ is the validation cache object from which the results
    -- of prior validation attempts will be written, and to which new
    -- validation results for this 'Vulkan.Core10.Handles.ShaderModule' will be
    -- written (if not already present).
    --
    -- #VUID-VkShaderModuleValidationCacheCreateInfoEXT-validationCache-parameter#
    -- @validationCache@ /must/ be a valid
    -- 'Vulkan.Extensions.Handles.ValidationCacheEXT' handle
    ShaderModuleValidationCacheCreateInfoEXT -> ValidationCacheEXT
validationCache :: ValidationCacheEXT }
  deriving (Typeable, ShaderModuleValidationCacheCreateInfoEXT
-> ShaderModuleValidationCacheCreateInfoEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderModuleValidationCacheCreateInfoEXT
-> ShaderModuleValidationCacheCreateInfoEXT -> Bool
$c/= :: ShaderModuleValidationCacheCreateInfoEXT
-> ShaderModuleValidationCacheCreateInfoEXT -> Bool
== :: ShaderModuleValidationCacheCreateInfoEXT
-> ShaderModuleValidationCacheCreateInfoEXT -> Bool
$c== :: ShaderModuleValidationCacheCreateInfoEXT
-> ShaderModuleValidationCacheCreateInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ShaderModuleValidationCacheCreateInfoEXT)
#endif
deriving instance Show ShaderModuleValidationCacheCreateInfoEXT

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

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

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

instance Zero ShaderModuleValidationCacheCreateInfoEXT where
  zero :: ShaderModuleValidationCacheCreateInfoEXT
zero = ValidationCacheEXT -> ShaderModuleValidationCacheCreateInfoEXT
ShaderModuleValidationCacheCreateInfoEXT
           forall a. Zero a => a
zero


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

conNameValidationCacheCreateFlagsEXT :: String
conNameValidationCacheCreateFlagsEXT :: String
conNameValidationCacheCreateFlagsEXT = String
"ValidationCacheCreateFlagsEXT"

enumPrefixValidationCacheCreateFlagsEXT :: String
enumPrefixValidationCacheCreateFlagsEXT :: String
enumPrefixValidationCacheCreateFlagsEXT = String
""

showTableValidationCacheCreateFlagsEXT :: [(ValidationCacheCreateFlagsEXT, String)]
showTableValidationCacheCreateFlagsEXT :: [(ValidationCacheCreateFlagsEXT, String)]
showTableValidationCacheCreateFlagsEXT = []

instance Show ValidationCacheCreateFlagsEXT where
  showsPrec :: Int -> ValidationCacheCreateFlagsEXT -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixValidationCacheCreateFlagsEXT
      [(ValidationCacheCreateFlagsEXT, String)]
showTableValidationCacheCreateFlagsEXT
      String
conNameValidationCacheCreateFlagsEXT
      (\(ValidationCacheCreateFlagsEXT "srcCacheCount" ::: Word32
x) -> "srcCacheCount" ::: Word32
x)
      (\"srcCacheCount" ::: Word32
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 "srcCacheCount" ::: Word32
x)

instance Read ValidationCacheCreateFlagsEXT where
  readPrec :: ReadPrec ValidationCacheCreateFlagsEXT
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixValidationCacheCreateFlagsEXT
      [(ValidationCacheCreateFlagsEXT, String)]
showTableValidationCacheCreateFlagsEXT
      String
conNameValidationCacheCreateFlagsEXT
      ("srcCacheCount" ::: Word32) -> ValidationCacheCreateFlagsEXT
ValidationCacheCreateFlagsEXT

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

-- Note that the zero instance does not produce a valid value, passing 'zero' to Vulkan will result in an error

-- | 'VALIDATION_CACHE_HEADER_VERSION_ONE_EXT' specifies version one of the
-- validation cache.
pattern $bVALIDATION_CACHE_HEADER_VERSION_ONE_EXT :: ValidationCacheHeaderVersionEXT
$mVALIDATION_CACHE_HEADER_VERSION_ONE_EXT :: forall {r}.
ValidationCacheHeaderVersionEXT
-> ((# #) -> r) -> ((# #) -> r) -> r
VALIDATION_CACHE_HEADER_VERSION_ONE_EXT = ValidationCacheHeaderVersionEXT 1

{-# COMPLETE VALIDATION_CACHE_HEADER_VERSION_ONE_EXT :: ValidationCacheHeaderVersionEXT #-}

conNameValidationCacheHeaderVersionEXT :: String
conNameValidationCacheHeaderVersionEXT :: String
conNameValidationCacheHeaderVersionEXT = String
"ValidationCacheHeaderVersionEXT"

enumPrefixValidationCacheHeaderVersionEXT :: String
enumPrefixValidationCacheHeaderVersionEXT :: String
enumPrefixValidationCacheHeaderVersionEXT = String
"VALIDATION_CACHE_HEADER_VERSION_ONE_EXT"

showTableValidationCacheHeaderVersionEXT :: [(ValidationCacheHeaderVersionEXT, String)]
showTableValidationCacheHeaderVersionEXT :: [(ValidationCacheHeaderVersionEXT, String)]
showTableValidationCacheHeaderVersionEXT =
  [
    ( ValidationCacheHeaderVersionEXT
VALIDATION_CACHE_HEADER_VERSION_ONE_EXT
    , String
""
    )
  ]

instance Show ValidationCacheHeaderVersionEXT where
  showsPrec :: Int -> ValidationCacheHeaderVersionEXT -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixValidationCacheHeaderVersionEXT
      [(ValidationCacheHeaderVersionEXT, String)]
showTableValidationCacheHeaderVersionEXT
      String
conNameValidationCacheHeaderVersionEXT
      (\(ValidationCacheHeaderVersionEXT Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read ValidationCacheHeaderVersionEXT where
  readPrec :: ReadPrec ValidationCacheHeaderVersionEXT
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixValidationCacheHeaderVersionEXT
      [(ValidationCacheHeaderVersionEXT, String)]
showTableValidationCacheHeaderVersionEXT
      String
conNameValidationCacheHeaderVersionEXT
      Int32 -> ValidationCacheHeaderVersionEXT
ValidationCacheHeaderVersionEXT

type EXT_VALIDATION_CACHE_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_VALIDATION_CACHE_SPEC_VERSION"
pattern EXT_VALIDATION_CACHE_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_VALIDATION_CACHE_SPEC_VERSION :: forall a. Integral a => a
$mEXT_VALIDATION_CACHE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_VALIDATION_CACHE_SPEC_VERSION = 1


type EXT_VALIDATION_CACHE_EXTENSION_NAME = "VK_EXT_validation_cache"

-- No documentation found for TopLevel "VK_EXT_VALIDATION_CACHE_EXTENSION_NAME"
pattern EXT_VALIDATION_CACHE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_VALIDATION_CACHE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_VALIDATION_CACHE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_VALIDATION_CACHE_EXTENSION_NAME = "VK_EXT_validation_cache"