{-# OPTIONS_GHC -fno-warn-orphans#-}
{-# OPTIONS_GHC -fno-warn-unused-imports#-}
{-# OPTIONS_HADDOCK not-home#-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE PatternSynonyms          #-}
{-# LANGUAGE Strict                   #-}
{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE ViewPatterns             #-}
module Graphics.Vulkan.Ext.VK_EXT_debug_utils
       (-- * Vulkan extension: @VK_EXT_debug_utils@
        -- |
        --
        -- supported: @vulkan@
        --
        -- contact: @Mark Young @MarkY_LunarG@
        --
        -- author: @EXT@
        --
        -- type: @instance@
        --
        -- Extension number: @129@
        module Graphics.Vulkan.Marshal,
        module Graphics.Vulkan.Types.Struct.ApplicationInfo,
        module Graphics.Vulkan.Types.BaseTypes,
        module Graphics.Vulkan.Types.Struct.DebugUtilsLabelEXT,
        module Graphics.Vulkan.Types.Enum.Debug,
        module Graphics.Vulkan.Types.Struct.DebugUtilsMessengerCallbackDataEXT,
        module Graphics.Vulkan.Types.Bitmasks,
        module Graphics.Vulkan.Types.Struct.DebugUtilsMessengerCreateInfoEXT,
        module Graphics.Vulkan.Types.Struct.DebugUtilsObjectNameInfoEXT,
        module Graphics.Vulkan.Types.Struct.Debug,
        module Graphics.Vulkan.Types.Struct.InstanceCreateInfo,
        module Graphics.Vulkan.Types.Enum.Object,
        module Graphics.Vulkan.Types.Enum.StructureType,
        -- > #include "vk_platform.h"
        VkSetDebugUtilsObjectNameEXT, pattern VkSetDebugUtilsObjectNameEXT,
        HS_vkSetDebugUtilsObjectNameEXT, PFN_vkSetDebugUtilsObjectNameEXT,
        VkSetDebugUtilsObjectTagEXT, pattern VkSetDebugUtilsObjectTagEXT,
        HS_vkSetDebugUtilsObjectTagEXT, PFN_vkSetDebugUtilsObjectTagEXT,
        VkQueueBeginDebugUtilsLabelEXT,
        pattern VkQueueBeginDebugUtilsLabelEXT,
        HS_vkQueueBeginDebugUtilsLabelEXT,
        PFN_vkQueueBeginDebugUtilsLabelEXT, VkQueueEndDebugUtilsLabelEXT,
        pattern VkQueueEndDebugUtilsLabelEXT,
        HS_vkQueueEndDebugUtilsLabelEXT, PFN_vkQueueEndDebugUtilsLabelEXT,
        VkQueueInsertDebugUtilsLabelEXT,
        pattern VkQueueInsertDebugUtilsLabelEXT,
        HS_vkQueueInsertDebugUtilsLabelEXT,
        PFN_vkQueueInsertDebugUtilsLabelEXT, VkCmdBeginDebugUtilsLabelEXT,
        pattern VkCmdBeginDebugUtilsLabelEXT,
        HS_vkCmdBeginDebugUtilsLabelEXT, PFN_vkCmdBeginDebugUtilsLabelEXT,
        VkCmdEndDebugUtilsLabelEXT, pattern VkCmdEndDebugUtilsLabelEXT,
        HS_vkCmdEndDebugUtilsLabelEXT, PFN_vkCmdEndDebugUtilsLabelEXT,
        VkCmdInsertDebugUtilsLabelEXT,
        pattern VkCmdInsertDebugUtilsLabelEXT,
        HS_vkCmdInsertDebugUtilsLabelEXT,
        PFN_vkCmdInsertDebugUtilsLabelEXT, VkCreateDebugUtilsMessengerEXT,
        pattern VkCreateDebugUtilsMessengerEXT,
        HS_vkCreateDebugUtilsMessengerEXT,
        PFN_vkCreateDebugUtilsMessengerEXT,
        VkDestroyDebugUtilsMessengerEXT,
        pattern VkDestroyDebugUtilsMessengerEXT,
        HS_vkDestroyDebugUtilsMessengerEXT,
        PFN_vkDestroyDebugUtilsMessengerEXT, VkSubmitDebugUtilsMessageEXT,
        pattern VkSubmitDebugUtilsMessageEXT,
        HS_vkSubmitDebugUtilsMessageEXT, PFN_vkSubmitDebugUtilsMessageEXT,
        module Graphics.Vulkan.Types.Enum.InternalAllocationType,
        module Graphics.Vulkan.Types.Enum.Result,
        module Graphics.Vulkan.Types.Enum.SystemAllocationScope,
        module Graphics.Vulkan.Types.Funcpointers,
        module Graphics.Vulkan.Types.Handles,
        module Graphics.Vulkan.Types.Struct.AllocationCallbacks,
        VK_EXT_DEBUG_UTILS_SPEC_VERSION,
        pattern VK_EXT_DEBUG_UTILS_SPEC_VERSION,
        VK_EXT_DEBUG_UTILS_EXTENSION_NAME,
        pattern VK_EXT_DEBUG_UTILS_EXTENSION_NAME,
        pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_NAME_INFO_EXT,
        pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_TAG_INFO_EXT,
        pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_LABEL_EXT,
        pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CALLBACK_DATA_EXT,
        pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CREATE_INFO_EXT,
        pattern VK_OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT)
       where
import           GHC.Ptr                                                         (Ptr (..))
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Proc                                    (VulkanProc (..))
import           Graphics.Vulkan.Types.BaseTypes
import           Graphics.Vulkan.Types.Bitmasks
import           Graphics.Vulkan.Types.Enum.Debug
import           Graphics.Vulkan.Types.Enum.InternalAllocationType
import           Graphics.Vulkan.Types.Enum.Object
import           Graphics.Vulkan.Types.Enum.Result
import           Graphics.Vulkan.Types.Enum.StructureType
import           Graphics.Vulkan.Types.Enum.SystemAllocationScope
import           Graphics.Vulkan.Types.Funcpointers
import           Graphics.Vulkan.Types.Handles
import           Graphics.Vulkan.Types.Struct.AllocationCallbacks
import           Graphics.Vulkan.Types.Struct.ApplicationInfo
import           Graphics.Vulkan.Types.Struct.Debug
import           Graphics.Vulkan.Types.Struct.DebugUtilsLabelEXT
import           Graphics.Vulkan.Types.Struct.DebugUtilsMessengerCallbackDataEXT
import           Graphics.Vulkan.Types.Struct.DebugUtilsMessengerCreateInfoEXT
import           Graphics.Vulkan.Types.Struct.DebugUtilsObjectNameInfoEXT
import           Graphics.Vulkan.Types.Struct.InstanceCreateInfo

pattern VkSetDebugUtilsObjectNameEXT :: CString

pattern $bVkSetDebugUtilsObjectNameEXT :: CString
$mVkSetDebugUtilsObjectNameEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkSetDebugUtilsObjectNameEXT <-
        (is_VkSetDebugUtilsObjectNameEXT -> True)
  where VkSetDebugUtilsObjectNameEXT = CString
_VkSetDebugUtilsObjectNameEXT

{-# INLINE _VkSetDebugUtilsObjectNameEXT #-}

_VkSetDebugUtilsObjectNameEXT :: CString
_VkSetDebugUtilsObjectNameEXT :: CString
_VkSetDebugUtilsObjectNameEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkSetDebugUtilsObjectNameEXT\NUL"#

{-# INLINE is_VkSetDebugUtilsObjectNameEXT #-}

is_VkSetDebugUtilsObjectNameEXT :: CString -> Bool
is_VkSetDebugUtilsObjectNameEXT :: CString -> Bool
is_VkSetDebugUtilsObjectNameEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkSetDebugUtilsObjectNameEXT

type VkSetDebugUtilsObjectNameEXT = "vkSetDebugUtilsObjectNameEXT"

-- | Success codes: 'VK_SUCCESS'.
--
--   Error codes: 'VK_ERROR_OUT_OF_HOST_MEMORY', 'VK_ERROR_OUT_OF_DEVICE_MEMORY'.
--
--   > VkResult vkSetDebugUtilsObjectNameEXT
--   >     ( VkDevice device
--   >     , const VkDebugUtilsObjectNameInfoEXT* pNameInfo
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkSetDebugUtilsObjectNameEXT vkSetDebugUtilsObjectNameEXT registry at www.khronos.org>
type HS_vkSetDebugUtilsObjectNameEXT =
     VkDevice -- ^ device
              -> Ptr VkDebugUtilsObjectNameInfoEXT -- ^ pNameInfo
                                                   -> IO VkResult

type PFN_vkSetDebugUtilsObjectNameEXT =
     FunPtr HS_vkSetDebugUtilsObjectNameEXT

foreign import ccall "dynamic" unwrapVkSetDebugUtilsObjectNameEXT
               ::
               PFN_vkSetDebugUtilsObjectNameEXT -> HS_vkSetDebugUtilsObjectNameEXT

instance VulkanProc "vkSetDebugUtilsObjectNameEXT" where
        type VkProcType "vkSetDebugUtilsObjectNameEXT" =
             HS_vkSetDebugUtilsObjectNameEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkSetDebugUtilsObjectNameEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkSetDebugUtilsObjectNameEXT")
-> VkProcType "vkSetDebugUtilsObjectNameEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkSetDebugUtilsObjectNameEXT")
-> VkProcType "vkSetDebugUtilsObjectNameEXT"
PFN_vkSetDebugUtilsObjectNameEXT -> HS_vkSetDebugUtilsObjectNameEXT
unwrapVkSetDebugUtilsObjectNameEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkSetDebugUtilsObjectTagEXT :: CString

pattern $bVkSetDebugUtilsObjectTagEXT :: CString
$mVkSetDebugUtilsObjectTagEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkSetDebugUtilsObjectTagEXT <-
        (is_VkSetDebugUtilsObjectTagEXT -> True)
  where VkSetDebugUtilsObjectTagEXT = CString
_VkSetDebugUtilsObjectTagEXT

{-# INLINE _VkSetDebugUtilsObjectTagEXT #-}

_VkSetDebugUtilsObjectTagEXT :: CString
_VkSetDebugUtilsObjectTagEXT :: CString
_VkSetDebugUtilsObjectTagEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkSetDebugUtilsObjectTagEXT\NUL"#

{-# INLINE is_VkSetDebugUtilsObjectTagEXT #-}

is_VkSetDebugUtilsObjectTagEXT :: CString -> Bool
is_VkSetDebugUtilsObjectTagEXT :: CString -> Bool
is_VkSetDebugUtilsObjectTagEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkSetDebugUtilsObjectTagEXT

type VkSetDebugUtilsObjectTagEXT = "vkSetDebugUtilsObjectTagEXT"

-- | Success codes: 'VK_SUCCESS'.
--
--   Error codes: 'VK_ERROR_OUT_OF_HOST_MEMORY', 'VK_ERROR_OUT_OF_DEVICE_MEMORY'.
--
--   > VkResult vkSetDebugUtilsObjectTagEXT
--   >     ( VkDevice device
--   >     , const VkDebugUtilsObjectTagInfoEXT* pTagInfo
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkSetDebugUtilsObjectTagEXT vkSetDebugUtilsObjectTagEXT registry at www.khronos.org>
type HS_vkSetDebugUtilsObjectTagEXT =
     VkDevice -- ^ device
              -> Ptr VkDebugUtilsObjectTagInfoEXT -- ^ pTagInfo
                                                  -> IO VkResult

type PFN_vkSetDebugUtilsObjectTagEXT =
     FunPtr HS_vkSetDebugUtilsObjectTagEXT

foreign import ccall "dynamic" unwrapVkSetDebugUtilsObjectTagEXT ::
               PFN_vkSetDebugUtilsObjectTagEXT -> HS_vkSetDebugUtilsObjectTagEXT

instance VulkanProc "vkSetDebugUtilsObjectTagEXT" where
        type VkProcType "vkSetDebugUtilsObjectTagEXT" =
             HS_vkSetDebugUtilsObjectTagEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkSetDebugUtilsObjectTagEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkSetDebugUtilsObjectTagEXT")
-> VkProcType "vkSetDebugUtilsObjectTagEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkSetDebugUtilsObjectTagEXT")
-> VkProcType "vkSetDebugUtilsObjectTagEXT"
PFN_vkSetDebugUtilsObjectTagEXT -> HS_vkSetDebugUtilsObjectTagEXT
unwrapVkSetDebugUtilsObjectTagEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkQueueBeginDebugUtilsLabelEXT :: CString

pattern $bVkQueueBeginDebugUtilsLabelEXT :: CString
$mVkQueueBeginDebugUtilsLabelEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkQueueBeginDebugUtilsLabelEXT <-
        (is_VkQueueBeginDebugUtilsLabelEXT -> True)
  where VkQueueBeginDebugUtilsLabelEXT
          = CString
_VkQueueBeginDebugUtilsLabelEXT

{-# INLINE _VkQueueBeginDebugUtilsLabelEXT #-}

_VkQueueBeginDebugUtilsLabelEXT :: CString
_VkQueueBeginDebugUtilsLabelEXT :: CString
_VkQueueBeginDebugUtilsLabelEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkQueueBeginDebugUtilsLabelEXT\NUL"#

{-# INLINE is_VkQueueBeginDebugUtilsLabelEXT #-}

is_VkQueueBeginDebugUtilsLabelEXT :: CString -> Bool
is_VkQueueBeginDebugUtilsLabelEXT :: CString -> Bool
is_VkQueueBeginDebugUtilsLabelEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkQueueBeginDebugUtilsLabelEXT

type VkQueueBeginDebugUtilsLabelEXT =
     "vkQueueBeginDebugUtilsLabelEXT"

-- | > void vkQueueBeginDebugUtilsLabelEXT
--   >     ( VkQueue queue
--   >     , const VkDebugUtilsLabelEXT* pLabelInfo
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkQueueBeginDebugUtilsLabelEXT vkQueueBeginDebugUtilsLabelEXT registry at www.khronos.org>
type HS_vkQueueBeginDebugUtilsLabelEXT =
     VkQueue -- ^ queue
             -> Ptr VkDebugUtilsLabelEXT -- ^ pLabelInfo
                                         -> IO ()

type PFN_vkQueueBeginDebugUtilsLabelEXT =
     FunPtr HS_vkQueueBeginDebugUtilsLabelEXT

foreign import ccall "dynamic" unwrapVkQueueBeginDebugUtilsLabelEXT
               ::
               PFN_vkQueueBeginDebugUtilsLabelEXT ->
                 HS_vkQueueBeginDebugUtilsLabelEXT

instance VulkanProc "vkQueueBeginDebugUtilsLabelEXT" where
        type VkProcType "vkQueueBeginDebugUtilsLabelEXT" =
             HS_vkQueueBeginDebugUtilsLabelEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkQueueBeginDebugUtilsLabelEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkQueueBeginDebugUtilsLabelEXT")
-> VkProcType "vkQueueBeginDebugUtilsLabelEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkQueueBeginDebugUtilsLabelEXT")
-> VkProcType "vkQueueBeginDebugUtilsLabelEXT"
PFN_vkQueueBeginDebugUtilsLabelEXT
-> HS_vkQueueBeginDebugUtilsLabelEXT
unwrapVkQueueBeginDebugUtilsLabelEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkQueueEndDebugUtilsLabelEXT :: CString

pattern $bVkQueueEndDebugUtilsLabelEXT :: CString
$mVkQueueEndDebugUtilsLabelEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkQueueEndDebugUtilsLabelEXT <-
        (is_VkQueueEndDebugUtilsLabelEXT -> True)
  where VkQueueEndDebugUtilsLabelEXT = CString
_VkQueueEndDebugUtilsLabelEXT

{-# INLINE _VkQueueEndDebugUtilsLabelEXT #-}

_VkQueueEndDebugUtilsLabelEXT :: CString
_VkQueueEndDebugUtilsLabelEXT :: CString
_VkQueueEndDebugUtilsLabelEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkQueueEndDebugUtilsLabelEXT\NUL"#

{-# INLINE is_VkQueueEndDebugUtilsLabelEXT #-}

is_VkQueueEndDebugUtilsLabelEXT :: CString -> Bool
is_VkQueueEndDebugUtilsLabelEXT :: CString -> Bool
is_VkQueueEndDebugUtilsLabelEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkQueueEndDebugUtilsLabelEXT

type VkQueueEndDebugUtilsLabelEXT = "vkQueueEndDebugUtilsLabelEXT"

-- | > void vkQueueEndDebugUtilsLabelEXT
--   >     ( VkQueue queue
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkQueueEndDebugUtilsLabelEXT vkQueueEndDebugUtilsLabelEXT registry at www.khronos.org>
type HS_vkQueueEndDebugUtilsLabelEXT = VkQueue -- ^ queue
                                               -> IO ()

type PFN_vkQueueEndDebugUtilsLabelEXT =
     FunPtr HS_vkQueueEndDebugUtilsLabelEXT

foreign import ccall "dynamic" unwrapVkQueueEndDebugUtilsLabelEXT
               ::
               PFN_vkQueueEndDebugUtilsLabelEXT -> HS_vkQueueEndDebugUtilsLabelEXT

instance VulkanProc "vkQueueEndDebugUtilsLabelEXT" where
        type VkProcType "vkQueueEndDebugUtilsLabelEXT" =
             HS_vkQueueEndDebugUtilsLabelEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkQueueEndDebugUtilsLabelEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkQueueEndDebugUtilsLabelEXT")
-> VkProcType "vkQueueEndDebugUtilsLabelEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkQueueEndDebugUtilsLabelEXT")
-> VkProcType "vkQueueEndDebugUtilsLabelEXT"
PFN_vkQueueEndDebugUtilsLabelEXT -> HS_vkQueueEndDebugUtilsLabelEXT
unwrapVkQueueEndDebugUtilsLabelEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkQueueInsertDebugUtilsLabelEXT :: CString

pattern $bVkQueueInsertDebugUtilsLabelEXT :: CString
$mVkQueueInsertDebugUtilsLabelEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkQueueInsertDebugUtilsLabelEXT <-
        (is_VkQueueInsertDebugUtilsLabelEXT -> True)
  where VkQueueInsertDebugUtilsLabelEXT
          = CString
_VkQueueInsertDebugUtilsLabelEXT

{-# INLINE _VkQueueInsertDebugUtilsLabelEXT #-}

_VkQueueInsertDebugUtilsLabelEXT :: CString
_VkQueueInsertDebugUtilsLabelEXT :: CString
_VkQueueInsertDebugUtilsLabelEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkQueueInsertDebugUtilsLabelEXT\NUL"#

{-# INLINE is_VkQueueInsertDebugUtilsLabelEXT #-}

is_VkQueueInsertDebugUtilsLabelEXT :: CString -> Bool
is_VkQueueInsertDebugUtilsLabelEXT :: CString -> Bool
is_VkQueueInsertDebugUtilsLabelEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkQueueInsertDebugUtilsLabelEXT

type VkQueueInsertDebugUtilsLabelEXT =
     "vkQueueInsertDebugUtilsLabelEXT"

-- | > void vkQueueInsertDebugUtilsLabelEXT
--   >     ( VkQueue queue
--   >     , const VkDebugUtilsLabelEXT* pLabelInfo
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkQueueInsertDebugUtilsLabelEXT vkQueueInsertDebugUtilsLabelEXT registry at www.khronos.org>
type HS_vkQueueInsertDebugUtilsLabelEXT =
     VkQueue -- ^ queue
             -> Ptr VkDebugUtilsLabelEXT -- ^ pLabelInfo
                                         -> IO ()

type PFN_vkQueueInsertDebugUtilsLabelEXT =
     FunPtr HS_vkQueueInsertDebugUtilsLabelEXT

foreign import ccall "dynamic"
               unwrapVkQueueInsertDebugUtilsLabelEXT ::
               PFN_vkQueueInsertDebugUtilsLabelEXT ->
                 HS_vkQueueInsertDebugUtilsLabelEXT

instance VulkanProc "vkQueueInsertDebugUtilsLabelEXT" where
        type VkProcType "vkQueueInsertDebugUtilsLabelEXT" =
             HS_vkQueueInsertDebugUtilsLabelEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkQueueInsertDebugUtilsLabelEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkQueueInsertDebugUtilsLabelEXT")
-> VkProcType "vkQueueInsertDebugUtilsLabelEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkQueueInsertDebugUtilsLabelEXT")
-> VkProcType "vkQueueInsertDebugUtilsLabelEXT"
PFN_vkQueueBeginDebugUtilsLabelEXT
-> HS_vkQueueBeginDebugUtilsLabelEXT
unwrapVkQueueInsertDebugUtilsLabelEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkCmdBeginDebugUtilsLabelEXT :: CString

pattern $bVkCmdBeginDebugUtilsLabelEXT :: CString
$mVkCmdBeginDebugUtilsLabelEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkCmdBeginDebugUtilsLabelEXT <-
        (is_VkCmdBeginDebugUtilsLabelEXT -> True)
  where VkCmdBeginDebugUtilsLabelEXT = CString
_VkCmdBeginDebugUtilsLabelEXT

{-# INLINE _VkCmdBeginDebugUtilsLabelEXT #-}

_VkCmdBeginDebugUtilsLabelEXT :: CString
_VkCmdBeginDebugUtilsLabelEXT :: CString
_VkCmdBeginDebugUtilsLabelEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkCmdBeginDebugUtilsLabelEXT\NUL"#

{-# INLINE is_VkCmdBeginDebugUtilsLabelEXT #-}

is_VkCmdBeginDebugUtilsLabelEXT :: CString -> Bool
is_VkCmdBeginDebugUtilsLabelEXT :: CString -> Bool
is_VkCmdBeginDebugUtilsLabelEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkCmdBeginDebugUtilsLabelEXT

type VkCmdBeginDebugUtilsLabelEXT = "vkCmdBeginDebugUtilsLabelEXT"

-- | Queues: 'graphics', 'compute'.
--
--   Renderpass: @both@
--
--   > void vkCmdBeginDebugUtilsLabelEXT
--   >     ( VkCommandBuffer commandBuffer
--   >     , const VkDebugUtilsLabelEXT* pLabelInfo
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkCmdBeginDebugUtilsLabelEXT vkCmdBeginDebugUtilsLabelEXT registry at www.khronos.org>
type HS_vkCmdBeginDebugUtilsLabelEXT =
     VkCommandBuffer -- ^ commandBuffer
                     -> Ptr VkDebugUtilsLabelEXT -- ^ pLabelInfo
                                                 -> IO ()

type PFN_vkCmdBeginDebugUtilsLabelEXT =
     FunPtr HS_vkCmdBeginDebugUtilsLabelEXT

foreign import ccall "dynamic" unwrapVkCmdBeginDebugUtilsLabelEXT
               ::
               PFN_vkCmdBeginDebugUtilsLabelEXT -> HS_vkCmdBeginDebugUtilsLabelEXT

instance VulkanProc "vkCmdBeginDebugUtilsLabelEXT" where
        type VkProcType "vkCmdBeginDebugUtilsLabelEXT" =
             HS_vkCmdBeginDebugUtilsLabelEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkCmdBeginDebugUtilsLabelEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkCmdBeginDebugUtilsLabelEXT")
-> VkProcType "vkCmdBeginDebugUtilsLabelEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkCmdBeginDebugUtilsLabelEXT")
-> VkProcType "vkCmdBeginDebugUtilsLabelEXT"
PFN_vkCmdBeginDebugUtilsLabelEXT -> HS_vkCmdBeginDebugUtilsLabelEXT
unwrapVkCmdBeginDebugUtilsLabelEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkCmdEndDebugUtilsLabelEXT :: CString

pattern $bVkCmdEndDebugUtilsLabelEXT :: CString
$mVkCmdEndDebugUtilsLabelEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkCmdEndDebugUtilsLabelEXT <-
        (is_VkCmdEndDebugUtilsLabelEXT -> True)
  where VkCmdEndDebugUtilsLabelEXT = CString
_VkCmdEndDebugUtilsLabelEXT

{-# INLINE _VkCmdEndDebugUtilsLabelEXT #-}

_VkCmdEndDebugUtilsLabelEXT :: CString
_VkCmdEndDebugUtilsLabelEXT :: CString
_VkCmdEndDebugUtilsLabelEXT = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkCmdEndDebugUtilsLabelEXT\NUL"#

{-# INLINE is_VkCmdEndDebugUtilsLabelEXT #-}

is_VkCmdEndDebugUtilsLabelEXT :: CString -> Bool
is_VkCmdEndDebugUtilsLabelEXT :: CString -> Bool
is_VkCmdEndDebugUtilsLabelEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkCmdEndDebugUtilsLabelEXT

type VkCmdEndDebugUtilsLabelEXT = "vkCmdEndDebugUtilsLabelEXT"

-- | Queues: 'graphics', 'compute'.
--
--   Renderpass: @both@
--
--   > void vkCmdEndDebugUtilsLabelEXT
--   >     ( VkCommandBuffer commandBuffer
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkCmdEndDebugUtilsLabelEXT vkCmdEndDebugUtilsLabelEXT registry at www.khronos.org>
type HS_vkCmdEndDebugUtilsLabelEXT = VkCommandBuffer -- ^ commandBuffer
                                                     -> IO ()

type PFN_vkCmdEndDebugUtilsLabelEXT =
     FunPtr HS_vkCmdEndDebugUtilsLabelEXT

foreign import ccall "dynamic" unwrapVkCmdEndDebugUtilsLabelEXT ::
               PFN_vkCmdEndDebugUtilsLabelEXT -> HS_vkCmdEndDebugUtilsLabelEXT

instance VulkanProc "vkCmdEndDebugUtilsLabelEXT" where
        type VkProcType "vkCmdEndDebugUtilsLabelEXT" =
             HS_vkCmdEndDebugUtilsLabelEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkCmdEndDebugUtilsLabelEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkCmdEndDebugUtilsLabelEXT")
-> VkProcType "vkCmdEndDebugUtilsLabelEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkCmdEndDebugUtilsLabelEXT")
-> VkProcType "vkCmdEndDebugUtilsLabelEXT"
PFN_vkCmdEndDebugUtilsLabelEXT -> HS_vkCmdEndDebugUtilsLabelEXT
unwrapVkCmdEndDebugUtilsLabelEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkCmdInsertDebugUtilsLabelEXT :: CString

pattern $bVkCmdInsertDebugUtilsLabelEXT :: CString
$mVkCmdInsertDebugUtilsLabelEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkCmdInsertDebugUtilsLabelEXT <-
        (is_VkCmdInsertDebugUtilsLabelEXT -> True)
  where VkCmdInsertDebugUtilsLabelEXT
          = CString
_VkCmdInsertDebugUtilsLabelEXT

{-# INLINE _VkCmdInsertDebugUtilsLabelEXT #-}

_VkCmdInsertDebugUtilsLabelEXT :: CString
_VkCmdInsertDebugUtilsLabelEXT :: CString
_VkCmdInsertDebugUtilsLabelEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkCmdInsertDebugUtilsLabelEXT\NUL"#

{-# INLINE is_VkCmdInsertDebugUtilsLabelEXT #-}

is_VkCmdInsertDebugUtilsLabelEXT :: CString -> Bool
is_VkCmdInsertDebugUtilsLabelEXT :: CString -> Bool
is_VkCmdInsertDebugUtilsLabelEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkCmdInsertDebugUtilsLabelEXT

type VkCmdInsertDebugUtilsLabelEXT =
     "vkCmdInsertDebugUtilsLabelEXT"

-- | Queues: 'graphics', 'compute'.
--
--   Renderpass: @both@
--
--   > void vkCmdInsertDebugUtilsLabelEXT
--   >     ( VkCommandBuffer commandBuffer
--   >     , const VkDebugUtilsLabelEXT* pLabelInfo
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkCmdInsertDebugUtilsLabelEXT vkCmdInsertDebugUtilsLabelEXT registry at www.khronos.org>
type HS_vkCmdInsertDebugUtilsLabelEXT =
     VkCommandBuffer -- ^ commandBuffer
                     -> Ptr VkDebugUtilsLabelEXT -- ^ pLabelInfo
                                                 -> IO ()

type PFN_vkCmdInsertDebugUtilsLabelEXT =
     FunPtr HS_vkCmdInsertDebugUtilsLabelEXT

foreign import ccall "dynamic" unwrapVkCmdInsertDebugUtilsLabelEXT
               ::
               PFN_vkCmdInsertDebugUtilsLabelEXT ->
                 HS_vkCmdInsertDebugUtilsLabelEXT

instance VulkanProc "vkCmdInsertDebugUtilsLabelEXT" where
        type VkProcType "vkCmdInsertDebugUtilsLabelEXT" =
             HS_vkCmdInsertDebugUtilsLabelEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkCmdInsertDebugUtilsLabelEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkCmdInsertDebugUtilsLabelEXT")
-> VkProcType "vkCmdInsertDebugUtilsLabelEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkCmdInsertDebugUtilsLabelEXT")
-> VkProcType "vkCmdInsertDebugUtilsLabelEXT"
PFN_vkCmdBeginDebugUtilsLabelEXT -> HS_vkCmdBeginDebugUtilsLabelEXT
unwrapVkCmdInsertDebugUtilsLabelEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkCreateDebugUtilsMessengerEXT :: CString

pattern $bVkCreateDebugUtilsMessengerEXT :: CString
$mVkCreateDebugUtilsMessengerEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkCreateDebugUtilsMessengerEXT <-
        (is_VkCreateDebugUtilsMessengerEXT -> True)
  where VkCreateDebugUtilsMessengerEXT
          = CString
_VkCreateDebugUtilsMessengerEXT

{-# INLINE _VkCreateDebugUtilsMessengerEXT #-}

_VkCreateDebugUtilsMessengerEXT :: CString
_VkCreateDebugUtilsMessengerEXT :: CString
_VkCreateDebugUtilsMessengerEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkCreateDebugUtilsMessengerEXT\NUL"#

{-# INLINE is_VkCreateDebugUtilsMessengerEXT #-}

is_VkCreateDebugUtilsMessengerEXT :: CString -> Bool
is_VkCreateDebugUtilsMessengerEXT :: CString -> Bool
is_VkCreateDebugUtilsMessengerEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkCreateDebugUtilsMessengerEXT

type VkCreateDebugUtilsMessengerEXT =
     "vkCreateDebugUtilsMessengerEXT"

-- | Success codes: 'VK_SUCCESS'.
--
--   Error codes: 'VK_ERROR_OUT_OF_HOST_MEMORY'.
--
--   > VkResult vkCreateDebugUtilsMessengerEXT
--   >     ( VkInstance instance
--   >     , const VkDebugUtilsMessengerCreateInfoEXT* pCreateInfo
--   >     , const VkAllocationCallbacks* pAllocator
--   >     , VkDebugUtilsMessengerEXT* pMessenger
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkCreateDebugUtilsMessengerEXT vkCreateDebugUtilsMessengerEXT registry at www.khronos.org>
type HS_vkCreateDebugUtilsMessengerEXT =
     VkInstance -- ^ instance
                ->
       Ptr VkDebugUtilsMessengerCreateInfoEXT -- ^ pCreateInfo
                                              ->
         Ptr VkAllocationCallbacks -- ^ pAllocator
                                   ->
           Ptr VkDebugUtilsMessengerEXT -- ^ pMessenger
                                        -> IO VkResult

type PFN_vkCreateDebugUtilsMessengerEXT =
     FunPtr HS_vkCreateDebugUtilsMessengerEXT

foreign import ccall "dynamic" unwrapVkCreateDebugUtilsMessengerEXT
               ::
               PFN_vkCreateDebugUtilsMessengerEXT ->
                 HS_vkCreateDebugUtilsMessengerEXT

instance VulkanProc "vkCreateDebugUtilsMessengerEXT" where
        type VkProcType "vkCreateDebugUtilsMessengerEXT" =
             HS_vkCreateDebugUtilsMessengerEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkCreateDebugUtilsMessengerEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkCreateDebugUtilsMessengerEXT")
-> VkProcType "vkCreateDebugUtilsMessengerEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkCreateDebugUtilsMessengerEXT")
-> VkProcType "vkCreateDebugUtilsMessengerEXT"
PFN_vkCreateDebugUtilsMessengerEXT
-> HS_vkCreateDebugUtilsMessengerEXT
unwrapVkCreateDebugUtilsMessengerEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkDestroyDebugUtilsMessengerEXT :: CString

pattern $bVkDestroyDebugUtilsMessengerEXT :: CString
$mVkDestroyDebugUtilsMessengerEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkDestroyDebugUtilsMessengerEXT <-
        (is_VkDestroyDebugUtilsMessengerEXT -> True)
  where VkDestroyDebugUtilsMessengerEXT
          = CString
_VkDestroyDebugUtilsMessengerEXT

{-# INLINE _VkDestroyDebugUtilsMessengerEXT #-}

_VkDestroyDebugUtilsMessengerEXT :: CString
_VkDestroyDebugUtilsMessengerEXT :: CString
_VkDestroyDebugUtilsMessengerEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkDestroyDebugUtilsMessengerEXT\NUL"#

{-# INLINE is_VkDestroyDebugUtilsMessengerEXT #-}

is_VkDestroyDebugUtilsMessengerEXT :: CString -> Bool
is_VkDestroyDebugUtilsMessengerEXT :: CString -> Bool
is_VkDestroyDebugUtilsMessengerEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkDestroyDebugUtilsMessengerEXT

type VkDestroyDebugUtilsMessengerEXT =
     "vkDestroyDebugUtilsMessengerEXT"

-- | > void vkDestroyDebugUtilsMessengerEXT
--   >     ( VkInstance instance
--   >     , VkDebugUtilsMessengerEXT messenger
--   >     , const VkAllocationCallbacks* pAllocator
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkDestroyDebugUtilsMessengerEXT vkDestroyDebugUtilsMessengerEXT registry at www.khronos.org>
type HS_vkDestroyDebugUtilsMessengerEXT =
     VkInstance -- ^ instance
                ->
       VkDebugUtilsMessengerEXT -- ^ messenger
                                -> Ptr VkAllocationCallbacks -- ^ pAllocator
                                                             -> IO ()

type PFN_vkDestroyDebugUtilsMessengerEXT =
     FunPtr HS_vkDestroyDebugUtilsMessengerEXT

foreign import ccall "dynamic"
               unwrapVkDestroyDebugUtilsMessengerEXT ::
               PFN_vkDestroyDebugUtilsMessengerEXT ->
                 HS_vkDestroyDebugUtilsMessengerEXT

instance VulkanProc "vkDestroyDebugUtilsMessengerEXT" where
        type VkProcType "vkDestroyDebugUtilsMessengerEXT" =
             HS_vkDestroyDebugUtilsMessengerEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkDestroyDebugUtilsMessengerEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkDestroyDebugUtilsMessengerEXT")
-> VkProcType "vkDestroyDebugUtilsMessengerEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkDestroyDebugUtilsMessengerEXT")
-> VkProcType "vkDestroyDebugUtilsMessengerEXT"
PFN_vkDestroyDebugUtilsMessengerEXT
-> HS_vkDestroyDebugUtilsMessengerEXT
unwrapVkDestroyDebugUtilsMessengerEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VkSubmitDebugUtilsMessageEXT :: CString

pattern $bVkSubmitDebugUtilsMessageEXT :: CString
$mVkSubmitDebugUtilsMessageEXT :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VkSubmitDebugUtilsMessageEXT <-
        (is_VkSubmitDebugUtilsMessageEXT -> True)
  where VkSubmitDebugUtilsMessageEXT = CString
_VkSubmitDebugUtilsMessageEXT

{-# INLINE _VkSubmitDebugUtilsMessageEXT #-}

_VkSubmitDebugUtilsMessageEXT :: CString
_VkSubmitDebugUtilsMessageEXT :: CString
_VkSubmitDebugUtilsMessageEXT
  = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"vkSubmitDebugUtilsMessageEXT\NUL"#

{-# INLINE is_VkSubmitDebugUtilsMessageEXT #-}

is_VkSubmitDebugUtilsMessageEXT :: CString -> Bool
is_VkSubmitDebugUtilsMessageEXT :: CString -> Bool
is_VkSubmitDebugUtilsMessageEXT
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VkSubmitDebugUtilsMessageEXT

type VkSubmitDebugUtilsMessageEXT = "vkSubmitDebugUtilsMessageEXT"

-- | > void vkSubmitDebugUtilsMessageEXT
--   >     ( VkInstance instance
--   >     , VkDebugUtilsMessageSeverityFlagBitsEXT messageSeverity
--   >     , VkDebugUtilsMessageTypeFlagsEXT messageTypes
--   >     , const VkDebugUtilsMessengerCallbackDataEXT* pCallbackData
--   >     )
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#vkSubmitDebugUtilsMessageEXT vkSubmitDebugUtilsMessageEXT registry at www.khronos.org>
type HS_vkSubmitDebugUtilsMessageEXT =
     VkInstance -- ^ instance
                ->
       VkDebugUtilsMessageSeverityFlagBitsEXT -- ^ messageSeverity
                                              ->
         VkDebugUtilsMessageTypeFlagsEXT -- ^ messageTypes
                                         ->
           Ptr VkDebugUtilsMessengerCallbackDataEXT -- ^ pCallbackData
                                                    -> IO ()

type PFN_vkSubmitDebugUtilsMessageEXT =
     FunPtr HS_vkSubmitDebugUtilsMessageEXT

foreign import ccall "dynamic" unwrapVkSubmitDebugUtilsMessageEXT
               ::
               PFN_vkSubmitDebugUtilsMessageEXT -> HS_vkSubmitDebugUtilsMessageEXT

instance VulkanProc "vkSubmitDebugUtilsMessageEXT" where
        type VkProcType "vkSubmitDebugUtilsMessageEXT" =
             HS_vkSubmitDebugUtilsMessageEXT
        vkProcSymbol :: CString
vkProcSymbol = CString
_VkSubmitDebugUtilsMessageEXT

        {-# INLINE vkProcSymbol #-}
        unwrapVkProcPtr :: FunPtr (VkProcType "vkSubmitDebugUtilsMessageEXT")
-> VkProcType "vkSubmitDebugUtilsMessageEXT"
unwrapVkProcPtr = FunPtr (VkProcType "vkSubmitDebugUtilsMessageEXT")
-> VkProcType "vkSubmitDebugUtilsMessageEXT"
PFN_vkSubmitDebugUtilsMessageEXT -> HS_vkSubmitDebugUtilsMessageEXT
unwrapVkSubmitDebugUtilsMessageEXT

        {-# INLINE unwrapVkProcPtr #-}

pattern VK_EXT_DEBUG_UTILS_SPEC_VERSION :: (Num a, Eq a) => a

pattern $bVK_EXT_DEBUG_UTILS_SPEC_VERSION :: a
$mVK_EXT_DEBUG_UTILS_SPEC_VERSION :: forall r a. (Num a, Eq a) => a -> (Void# -> r) -> (Void# -> r) -> r
VK_EXT_DEBUG_UTILS_SPEC_VERSION = 1

type VK_EXT_DEBUG_UTILS_SPEC_VERSION = 1

pattern VK_EXT_DEBUG_UTILS_EXTENSION_NAME :: CString

pattern $bVK_EXT_DEBUG_UTILS_EXTENSION_NAME :: CString
$mVK_EXT_DEBUG_UTILS_EXTENSION_NAME :: forall r. CString -> (Void# -> r) -> (Void# -> r) -> r
VK_EXT_DEBUG_UTILS_EXTENSION_NAME <-
        (is_VK_EXT_DEBUG_UTILS_EXTENSION_NAME -> True)
  where VK_EXT_DEBUG_UTILS_EXTENSION_NAME
          = CString
_VK_EXT_DEBUG_UTILS_EXTENSION_NAME

{-# INLINE _VK_EXT_DEBUG_UTILS_EXTENSION_NAME #-}

_VK_EXT_DEBUG_UTILS_EXTENSION_NAME :: CString
_VK_EXT_DEBUG_UTILS_EXTENSION_NAME :: CString
_VK_EXT_DEBUG_UTILS_EXTENSION_NAME = Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"VK_EXT_debug_utils\NUL"#

{-# INLINE is_VK_EXT_DEBUG_UTILS_EXTENSION_NAME #-}

is_VK_EXT_DEBUG_UTILS_EXTENSION_NAME :: CString -> Bool
is_VK_EXT_DEBUG_UTILS_EXTENSION_NAME :: CString -> Bool
is_VK_EXT_DEBUG_UTILS_EXTENSION_NAME
  = (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> (CString -> Ordering) -> CString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> Ordering
cmpCStrings CString
_VK_EXT_DEBUG_UTILS_EXTENSION_NAME

type VK_EXT_DEBUG_UTILS_EXTENSION_NAME = "VK_EXT_debug_utils"

pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_NAME_INFO_EXT ::
        VkStructureType

pattern $bVK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_NAME_INFO_EXT :: VkStructureType
$mVK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_NAME_INFO_EXT :: forall r. VkStructureType -> (Void# -> r) -> (Void# -> r) -> r
VK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_NAME_INFO_EXT =
        VkStructureType 1000128000

pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_TAG_INFO_EXT ::
        VkStructureType

pattern $bVK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_TAG_INFO_EXT :: VkStructureType
$mVK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_TAG_INFO_EXT :: forall r. VkStructureType -> (Void# -> r) -> (Void# -> r) -> r
VK_STRUCTURE_TYPE_DEBUG_UTILS_OBJECT_TAG_INFO_EXT =
        VkStructureType 1000128001

pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_LABEL_EXT :: VkStructureType

pattern $bVK_STRUCTURE_TYPE_DEBUG_UTILS_LABEL_EXT :: VkStructureType
$mVK_STRUCTURE_TYPE_DEBUG_UTILS_LABEL_EXT :: forall r. VkStructureType -> (Void# -> r) -> (Void# -> r) -> r
VK_STRUCTURE_TYPE_DEBUG_UTILS_LABEL_EXT =
        VkStructureType 1000128002

pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CALLBACK_DATA_EXT
        :: VkStructureType

pattern $bVK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CALLBACK_DATA_EXT :: VkStructureType
$mVK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CALLBACK_DATA_EXT :: forall r. VkStructureType -> (Void# -> r) -> (Void# -> r) -> r
VK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CALLBACK_DATA_EXT =
        VkStructureType 1000128003

pattern VK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CREATE_INFO_EXT ::
        VkStructureType

pattern $bVK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CREATE_INFO_EXT :: VkStructureType
$mVK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CREATE_INFO_EXT :: forall r. VkStructureType -> (Void# -> r) -> (Void# -> r) -> r
VK_STRUCTURE_TYPE_DEBUG_UTILS_MESSENGER_CREATE_INFO_EXT =
        VkStructureType 1000128004

-- | VkDebugUtilsMessengerEXT
pattern VK_OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT :: VkObjectType

pattern $bVK_OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT :: VkObjectType
$mVK_OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT :: forall r. VkObjectType -> (Void# -> r) -> (Void# -> r) -> r
VK_OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT =
        VkObjectType 1000128000