{-# LINE 1 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Graphics.Vulkan.Types.Struct.Debug
       (VkDebugMarkerMarkerInfoEXT(..),
        VkDebugMarkerObjectNameInfoEXT(..),
        VkDebugMarkerObjectTagInfoEXT(..),
        VkDebugReportCallbackCreateInfoEXT(..),
        VkDebugUtilsObjectTagInfoEXT(..))
       where
import           Foreign.Storable                                (Storable (..))
import           GHC.Base                                        (Addr#,
                                                                  ByteArray#,
                                                                  Proxy#,
                                                                  byteArrayContents#,
                                                                  plusAddr#,
                                                                  proxy#)
import           GHC.TypeLits                                    (KnownNat,
                                                                  natVal') -- ' closing tick for hsc2hs
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.Enum.Debug                (VkDebugReportFlagsEXT,
                                                                  VkDebugReportObjectTypeEXT)
import           Graphics.Vulkan.Types.Enum.Object               (VkObjectType)
import           Graphics.Vulkan.Types.Enum.StructureType        (VkStructureType)
import           Graphics.Vulkan.Types.Funcpointers              (PFN_vkDebugReportCallbackEXT)
import           Graphics.Vulkan.Types.Struct.InstanceCreateInfo (VkInstanceCreateInfo)
import           System.IO.Unsafe                                (unsafeDupablePerformIO)

-- | > typedef struct VkDebugMarkerMarkerInfoEXT {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     const char* pMarkerName;
--   >     float            color[4];
--   > } VkDebugMarkerMarkerInfoEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDebugMarkerMarkerInfoEXT VkDebugMarkerMarkerInfoEXT registry at www.khronos.org>
data VkDebugMarkerMarkerInfoEXT = VkDebugMarkerMarkerInfoEXT# Addr#
                                                              ByteArray#

instance Eq VkDebugMarkerMarkerInfoEXT where
        (VkDebugMarkerMarkerInfoEXT# Addr#
a ByteArray#
_) == :: VkDebugMarkerMarkerInfoEXT -> VkDebugMarkerMarkerInfoEXT -> Bool
==
          x :: VkDebugMarkerMarkerInfoEXT
x@(VkDebugMarkerMarkerInfoEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugMarkerMarkerInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugMarkerMarkerInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkDebugMarkerMarkerInfoEXT where
        (VkDebugMarkerMarkerInfoEXT# Addr#
a ByteArray#
_) compare :: VkDebugMarkerMarkerInfoEXT
-> VkDebugMarkerMarkerInfoEXT -> Ordering
`compare`
          x :: VkDebugMarkerMarkerInfoEXT
x@(VkDebugMarkerMarkerInfoEXT# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugMarkerMarkerInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugMarkerMarkerInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkDebugMarkerMarkerInfoEXT where
        sizeOf :: VkDebugMarkerMarkerInfoEXT -> Int
sizeOf ~VkDebugMarkerMarkerInfoEXT
_ = (Int
40)
{-# LINE 66 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkDebugMarkerMarkerInfoEXT -> Int
alignment ~VkDebugMarkerMarkerInfoEXT
_ = Int
8
{-# LINE 69 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkDebugMarkerMarkerInfoEXT -> IO VkDebugMarkerMarkerInfoEXT
peek = Ptr VkDebugMarkerMarkerInfoEXT -> IO VkDebugMarkerMarkerInfoEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkDebugMarkerMarkerInfoEXT
-> VkDebugMarkerMarkerInfoEXT -> IO ()
poke = Ptr VkDebugMarkerMarkerInfoEXT
-> VkDebugMarkerMarkerInfoEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkDebugMarkerMarkerInfoEXT where
        unsafeAddr :: VkDebugMarkerMarkerInfoEXT -> Addr#
unsafeAddr (VkDebugMarkerMarkerInfoEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkDebugMarkerMarkerInfoEXT -> ByteArray#
unsafeByteArray (VkDebugMarkerMarkerInfoEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkDebugMarkerMarkerInfoEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkDebugMarkerMarkerInfoEXT
VkDebugMarkerMarkerInfoEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDebugMarkerMarkerInfoEXT where
        type StructFields VkDebugMarkerMarkerInfoEXT =
             '["sType", "pNext", "pMarkerName", "color"] -- ' closing tick for hsc2hs
        type CUnionType VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDebugMarkerMarkerInfoEXT = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkDebugMarkerMarkerInfoEXT where
        type FieldType "sType" VkDebugMarkerMarkerInfoEXT = VkStructureType
        type FieldOptional "sType" VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkDebugMarkerMarkerInfoEXT =
             (0)
{-# LINE 105 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "sType" VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 113 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkDebugMarkerMarkerInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerMarkerInfoEXT
-> FieldType "sType" VkDebugMarkerMarkerInfoEXT
getField VkDebugMarkerMarkerInfoEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerMarkerInfoEXT -> Ptr VkDebugMarkerMarkerInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerMarkerInfoEXT
x) (Int
0))
{-# LINE 120 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerMarkerInfoEXT
-> IO (FieldType "sType" VkDebugMarkerMarkerInfoEXT)
readField Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerMarkerInfoEXT
p (Int
0)
{-# LINE 124 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDebugMarkerMarkerInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerMarkerInfoEXT
-> FieldType "sType" VkDebugMarkerMarkerInfoEXT -> IO ()
writeField Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerMarkerInfoEXT
p (Int
0)
{-# LINE 130 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkDebugMarkerMarkerInfoEXT where
        type FieldType "pNext" VkDebugMarkerMarkerInfoEXT = Ptr Void
        type FieldOptional "pNext" VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkDebugMarkerMarkerInfoEXT =
             (8)
{-# LINE 137 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pNext" VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 145 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkDebugMarkerMarkerInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerMarkerInfoEXT
-> FieldType "pNext" VkDebugMarkerMarkerInfoEXT
getField VkDebugMarkerMarkerInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerMarkerInfoEXT -> Ptr VkDebugMarkerMarkerInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerMarkerInfoEXT
x) (Int
8))
{-# LINE 152 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerMarkerInfoEXT
-> IO (FieldType "pNext" VkDebugMarkerMarkerInfoEXT)
readField Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerMarkerInfoEXT
p (Int
8)
{-# LINE 156 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDebugMarkerMarkerInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerMarkerInfoEXT
-> FieldType "pNext" VkDebugMarkerMarkerInfoEXT -> IO ()
writeField Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerMarkerInfoEXT
p (Int
8)
{-# LINE 162 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pMarkerName" VkDebugMarkerMarkerInfoEXT where
        type FieldType "pMarkerName" VkDebugMarkerMarkerInfoEXT = CString
        type FieldOptional "pMarkerName" VkDebugMarkerMarkerInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pMarkerName" VkDebugMarkerMarkerInfoEXT =
             (16)
{-# LINE 170 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pMarkerName" VkDebugMarkerMarkerInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 178 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pMarkerName" VkDebugMarkerMarkerInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerMarkerInfoEXT
-> FieldType "pMarkerName" VkDebugMarkerMarkerInfoEXT
getField VkDebugMarkerMarkerInfoEXT
x
          = IO CString -> CString
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerMarkerInfoEXT -> Ptr VkDebugMarkerMarkerInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerMarkerInfoEXT
x) (Int
16))
{-# LINE 185 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerMarkerInfoEXT
-> IO (FieldType "pMarkerName" VkDebugMarkerMarkerInfoEXT)
readField Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerMarkerInfoEXT
p (Int
16)
{-# LINE 189 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pMarkerName" VkDebugMarkerMarkerInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerMarkerInfoEXT
-> FieldType "pMarkerName" VkDebugMarkerMarkerInfoEXT -> IO ()
writeField Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerMarkerInfoEXT
p (Int
16)
{-# LINE 195 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "color" VkDebugMarkerMarkerInfoEXT where
        type FieldType "color" VkDebugMarkerMarkerInfoEXT =
             Float
{-# LINE 200 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldOptional "color" VkDebugMarkerMarkerInfoEXT = 'True -- ' closing tick for hsc2hs
        type FieldOffset "color" VkDebugMarkerMarkerInfoEXT =
             (24)
{-# LINE 203 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "color" VkDebugMarkerMarkerInfoEXT = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
24)
{-# LINE 211 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "color" idx VkDebugMarkerMarkerInfoEXT) =>
         CanReadFieldArray "color" idx VkDebugMarkerMarkerInfoEXT
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "color" 0 VkDebugMarkerMarkerInfoEXT #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "color" 1 VkDebugMarkerMarkerInfoEXT #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "color" 2 VkDebugMarkerMarkerInfoEXT #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "color" 3 VkDebugMarkerMarkerInfoEXT #-}
        type FieldArrayLength "color" VkDebugMarkerMarkerInfoEXT = 4

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength :: Int
fieldArrayLength = Int
4

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkDebugMarkerMarkerInfoEXT
-> FieldType "color" VkDebugMarkerMarkerInfoEXT
getFieldArray = VkDebugMarkerMarkerInfoEXT -> Float
VkDebugMarkerMarkerInfoEXT
-> FieldType "color" VkDebugMarkerMarkerInfoEXT
f
          where {-# NOINLINE f #-}
                f :: VkDebugMarkerMarkerInfoEXT -> Float
f VkDebugMarkerMarkerInfoEXT
x = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerMarkerInfoEXT -> Ptr VkDebugMarkerMarkerInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerMarkerInfoEXT
x) Int
off)
                off :: Int
off
                  = (Int
24) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 239 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
                      Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 240 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkDebugMarkerMarkerInfoEXT
-> IO (FieldType "color" VkDebugMarkerMarkerInfoEXT)
readFieldArray Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerMarkerInfoEXT
p
              ((Int
24) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 246 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 247 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "color" idx VkDebugMarkerMarkerInfoEXT) =>
         CanWriteFieldArray "color" idx VkDebugMarkerMarkerInfoEXT
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "color" 0 VkDebugMarkerMarkerInfoEXT #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "color" 1 VkDebugMarkerMarkerInfoEXT #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "color" 2 VkDebugMarkerMarkerInfoEXT #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "color" 3 VkDebugMarkerMarkerInfoEXT #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray :: Ptr VkDebugMarkerMarkerInfoEXT
-> FieldType "color" VkDebugMarkerMarkerInfoEXT -> IO ()
writeFieldArray Ptr VkDebugMarkerMarkerInfoEXT
p
          = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerMarkerInfoEXT
p
              ((Int
24) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 270 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 271 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance Show VkDebugMarkerMarkerInfoEXT where
        showsPrec :: Int -> VkDebugMarkerMarkerInfoEXT -> ShowS
showsPrec Int
d VkDebugMarkerMarkerInfoEXT
x
          = String -> ShowS
showString String
"VkDebugMarkerMarkerInfoEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerMarkerInfoEXT
-> FieldType "sType" VkDebugMarkerMarkerInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDebugMarkerMarkerInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerMarkerInfoEXT
-> FieldType "pNext" VkDebugMarkerMarkerInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDebugMarkerMarkerInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"pMarkerName = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> CString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerMarkerInfoEXT
-> FieldType "pMarkerName" VkDebugMarkerMarkerInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pMarkerName" VkDebugMarkerMarkerInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                (String -> ShowS
showString String
"color = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Int -> [Float] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                     (let s :: Int
s = Float -> Int
forall a. Storable a => a -> Int
sizeOf
                                                (FieldType "color" VkDebugMarkerMarkerInfoEXT
forall a. HasCallStack => a
undefined ::
                                                   FieldType "color" VkDebugMarkerMarkerInfoEXT)
                                          o :: Int
o = HasField "color" VkDebugMarkerMarkerInfoEXT => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"color" @VkDebugMarkerMarkerInfoEXT
                                          f :: Int -> IO (FieldType "color" VkDebugMarkerMarkerInfoEXT)
f Int
i
                                            = Ptr VkDebugMarkerMarkerInfoEXT -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerMarkerInfoEXT -> Ptr VkDebugMarkerMarkerInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerMarkerInfoEXT
x) Int
i ::
                                                IO (FieldType "color" VkDebugMarkerMarkerInfoEXT)
                                        in
                                        IO [Float] -> [Float]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Float] -> [Float])
-> ([Int] -> IO [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Float) -> [Int] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Float
Int -> IO (FieldType "color" VkDebugMarkerMarkerInfoEXT)
f ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$
                                          (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkDebugMarkerObjectNameInfoEXT {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkDebugReportObjectTypeEXT       objectType;
--   >     uint64_t                         object;
--   >     const char* pObjectName;
--   > } VkDebugMarkerObjectNameInfoEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDebugMarkerObjectNameInfoEXT VkDebugMarkerObjectNameInfoEXT registry at www.khronos.org>
data VkDebugMarkerObjectNameInfoEXT = VkDebugMarkerObjectNameInfoEXT# Addr#
                                                                      ByteArray#

instance Eq VkDebugMarkerObjectNameInfoEXT where
        (VkDebugMarkerObjectNameInfoEXT# Addr#
a ByteArray#
_) == :: VkDebugMarkerObjectNameInfoEXT
-> VkDebugMarkerObjectNameInfoEXT -> Bool
==
          x :: VkDebugMarkerObjectNameInfoEXT
x@(VkDebugMarkerObjectNameInfoEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugMarkerObjectNameInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugMarkerObjectNameInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkDebugMarkerObjectNameInfoEXT where
        (VkDebugMarkerObjectNameInfoEXT# Addr#
a ByteArray#
_) compare :: VkDebugMarkerObjectNameInfoEXT
-> VkDebugMarkerObjectNameInfoEXT -> Ordering
`compare`
          x :: VkDebugMarkerObjectNameInfoEXT
x@(VkDebugMarkerObjectNameInfoEXT# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugMarkerObjectNameInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugMarkerObjectNameInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkDebugMarkerObjectNameInfoEXT where
        sizeOf :: VkDebugMarkerObjectNameInfoEXT -> Int
sizeOf ~VkDebugMarkerObjectNameInfoEXT
_ = (Int
40)
{-# LINE 327 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkDebugMarkerObjectNameInfoEXT -> Int
alignment ~VkDebugMarkerObjectNameInfoEXT
_
          = Int
8
{-# LINE 331 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkDebugMarkerObjectNameInfoEXT
-> IO VkDebugMarkerObjectNameInfoEXT
peek = Ptr VkDebugMarkerObjectNameInfoEXT
-> IO VkDebugMarkerObjectNameInfoEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkDebugMarkerObjectNameInfoEXT
-> VkDebugMarkerObjectNameInfoEXT -> IO ()
poke = Ptr VkDebugMarkerObjectNameInfoEXT
-> VkDebugMarkerObjectNameInfoEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkDebugMarkerObjectNameInfoEXT where
        unsafeAddr :: VkDebugMarkerObjectNameInfoEXT -> Addr#
unsafeAddr (VkDebugMarkerObjectNameInfoEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkDebugMarkerObjectNameInfoEXT -> ByteArray#
unsafeByteArray (VkDebugMarkerObjectNameInfoEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkDebugMarkerObjectNameInfoEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkDebugMarkerObjectNameInfoEXT
VkDebugMarkerObjectNameInfoEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDebugMarkerObjectNameInfoEXT where
        type StructFields VkDebugMarkerObjectNameInfoEXT =
             '["sType", "pNext", "objectType", "object", "pObjectName"] -- ' closing tick for hsc2hs
        type CUnionType VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDebugMarkerObjectNameInfoEXT = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkDebugMarkerObjectNameInfoEXT where
        type FieldType "sType" VkDebugMarkerObjectNameInfoEXT =
             VkStructureType
        type FieldOptional "sType" VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkDebugMarkerObjectNameInfoEXT =
             (0)
{-# LINE 368 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "sType" VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 376 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkDebugMarkerObjectNameInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectNameInfoEXT
-> FieldType "sType" VkDebugMarkerObjectNameInfoEXT
getField VkDebugMarkerObjectNameInfoEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectNameInfoEXT
-> Ptr VkDebugMarkerObjectNameInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectNameInfoEXT
x) (Int
0))
{-# LINE 383 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> IO (FieldType "sType" VkDebugMarkerObjectNameInfoEXT)
readField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
0)
{-# LINE 387 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDebugMarkerObjectNameInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> FieldType "sType" VkDebugMarkerObjectNameInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
0)
{-# LINE 393 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkDebugMarkerObjectNameInfoEXT where
        type FieldType "pNext" VkDebugMarkerObjectNameInfoEXT = Ptr Void
        type FieldOptional "pNext" VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkDebugMarkerObjectNameInfoEXT =
             (8)
{-# LINE 400 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pNext" VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 408 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkDebugMarkerObjectNameInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectNameInfoEXT
-> FieldType "pNext" VkDebugMarkerObjectNameInfoEXT
getField VkDebugMarkerObjectNameInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectNameInfoEXT
-> Ptr VkDebugMarkerObjectNameInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectNameInfoEXT
x) (Int
8))
{-# LINE 415 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> IO (FieldType "pNext" VkDebugMarkerObjectNameInfoEXT)
readField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
8)
{-# LINE 419 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDebugMarkerObjectNameInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> FieldType "pNext" VkDebugMarkerObjectNameInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
8)
{-# LINE 425 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "objectType" VkDebugMarkerObjectNameInfoEXT where
        type FieldType "objectType" VkDebugMarkerObjectNameInfoEXT =
             VkDebugReportObjectTypeEXT
        type FieldOptional "objectType" VkDebugMarkerObjectNameInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "objectType" VkDebugMarkerObjectNameInfoEXT =
             (16)
{-# LINE 434 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "objectType" VkDebugMarkerObjectNameInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 443 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "objectType" VkDebugMarkerObjectNameInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectNameInfoEXT
-> FieldType "objectType" VkDebugMarkerObjectNameInfoEXT
getField VkDebugMarkerObjectNameInfoEXT
x
          = IO VkDebugReportObjectTypeEXT -> VkDebugReportObjectTypeEXT
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectNameInfoEXT
-> Int -> IO VkDebugReportObjectTypeEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectNameInfoEXT
-> Ptr VkDebugMarkerObjectNameInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectNameInfoEXT
x) (Int
16))
{-# LINE 450 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> IO (FieldType "objectType" VkDebugMarkerObjectNameInfoEXT)
readField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT
-> Int -> IO VkDebugReportObjectTypeEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
16)
{-# LINE 454 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "objectType" VkDebugMarkerObjectNameInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> FieldType "objectType" VkDebugMarkerObjectNameInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT
-> Int -> VkDebugReportObjectTypeEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
16)
{-# LINE 460 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "object" VkDebugMarkerObjectNameInfoEXT where
        type FieldType "object" VkDebugMarkerObjectNameInfoEXT = Word64
        type FieldOptional "object" VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "object" VkDebugMarkerObjectNameInfoEXT =
             (24)
{-# LINE 467 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "object" VkDebugMarkerObjectNameInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
24)
{-# LINE 475 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "object" VkDebugMarkerObjectNameInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectNameInfoEXT
-> FieldType "object" VkDebugMarkerObjectNameInfoEXT
getField VkDebugMarkerObjectNameInfoEXT
x
          = IO Word64 -> Word64
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectNameInfoEXT
-> Ptr VkDebugMarkerObjectNameInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectNameInfoEXT
x) (Int
24))
{-# LINE 482 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> IO (FieldType "object" VkDebugMarkerObjectNameInfoEXT)
readField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
24)
{-# LINE 486 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "object" VkDebugMarkerObjectNameInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> FieldType "object" VkDebugMarkerObjectNameInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
24)
{-# LINE 492 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pObjectName" VkDebugMarkerObjectNameInfoEXT where
        type FieldType "pObjectName" VkDebugMarkerObjectNameInfoEXT =
             CString
        type FieldOptional "pObjectName" VkDebugMarkerObjectNameInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pObjectName" VkDebugMarkerObjectNameInfoEXT =
             (32)
{-# LINE 501 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pObjectName" VkDebugMarkerObjectNameInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
32)
{-# LINE 510 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pObjectName" VkDebugMarkerObjectNameInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectNameInfoEXT
-> FieldType "pObjectName" VkDebugMarkerObjectNameInfoEXT
getField VkDebugMarkerObjectNameInfoEXT
x
          = IO CString -> CString
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectNameInfoEXT
-> Ptr VkDebugMarkerObjectNameInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectNameInfoEXT
x) (Int
32))
{-# LINE 517 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> IO (FieldType "pObjectName" VkDebugMarkerObjectNameInfoEXT)
readField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
32)
{-# LINE 521 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pObjectName" VkDebugMarkerObjectNameInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectNameInfoEXT
-> FieldType "pObjectName" VkDebugMarkerObjectNameInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectNameInfoEXT
p
          = Ptr VkDebugMarkerObjectNameInfoEXT -> Int -> CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectNameInfoEXT
p (Int
32)
{-# LINE 527 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance Show VkDebugMarkerObjectNameInfoEXT where
        showsPrec :: Int -> VkDebugMarkerObjectNameInfoEXT -> ShowS
showsPrec Int
d VkDebugMarkerObjectNameInfoEXT
x
          = String -> ShowS
showString String
"VkDebugMarkerObjectNameInfoEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectNameInfoEXT
-> FieldType "sType" VkDebugMarkerObjectNameInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDebugMarkerObjectNameInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectNameInfoEXT
-> FieldType "pNext" VkDebugMarkerObjectNameInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDebugMarkerObjectNameInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"objectType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkDebugReportObjectTypeEXT -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectNameInfoEXT
-> FieldType "objectType" VkDebugMarkerObjectNameInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"objectType" VkDebugMarkerObjectNameInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"object = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectNameInfoEXT
-> FieldType "object" VkDebugMarkerObjectNameInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"object" VkDebugMarkerObjectNameInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"pObjectName = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> CString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectNameInfoEXT
-> FieldType "pObjectName" VkDebugMarkerObjectNameInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pObjectName" VkDebugMarkerObjectNameInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkDebugMarkerObjectTagInfoEXT {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkDebugReportObjectTypeEXT       objectType;
--   >     uint64_t                         object;
--   >     uint64_t                         tagName;
--   >     size_t                           tagSize;
--   >     const void*        pTag;
--   > } VkDebugMarkerObjectTagInfoEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDebugMarkerObjectTagInfoEXT VkDebugMarkerObjectTagInfoEXT registry at www.khronos.org>
data VkDebugMarkerObjectTagInfoEXT = VkDebugMarkerObjectTagInfoEXT# Addr#
                                                                    ByteArray#

instance Eq VkDebugMarkerObjectTagInfoEXT where
        (VkDebugMarkerObjectTagInfoEXT# Addr#
a ByteArray#
_) == :: VkDebugMarkerObjectTagInfoEXT
-> VkDebugMarkerObjectTagInfoEXT -> Bool
==
          x :: VkDebugMarkerObjectTagInfoEXT
x@(VkDebugMarkerObjectTagInfoEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugMarkerObjectTagInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugMarkerObjectTagInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkDebugMarkerObjectTagInfoEXT where
        (VkDebugMarkerObjectTagInfoEXT# Addr#
a ByteArray#
_) compare :: VkDebugMarkerObjectTagInfoEXT
-> VkDebugMarkerObjectTagInfoEXT -> Ordering
`compare`
          x :: VkDebugMarkerObjectTagInfoEXT
x@(VkDebugMarkerObjectTagInfoEXT# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugMarkerObjectTagInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugMarkerObjectTagInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkDebugMarkerObjectTagInfoEXT where
        sizeOf :: VkDebugMarkerObjectTagInfoEXT -> Int
sizeOf ~VkDebugMarkerObjectTagInfoEXT
_ = (Int
56)
{-# LINE 575 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkDebugMarkerObjectTagInfoEXT -> Int
alignment ~VkDebugMarkerObjectTagInfoEXT
_
          = Int
8
{-# LINE 579 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO VkDebugMarkerObjectTagInfoEXT
peek = Ptr VkDebugMarkerObjectTagInfoEXT
-> IO VkDebugMarkerObjectTagInfoEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkDebugMarkerObjectTagInfoEXT
-> VkDebugMarkerObjectTagInfoEXT -> IO ()
poke = Ptr VkDebugMarkerObjectTagInfoEXT
-> VkDebugMarkerObjectTagInfoEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkDebugMarkerObjectTagInfoEXT where
        unsafeAddr :: VkDebugMarkerObjectTagInfoEXT -> Addr#
unsafeAddr (VkDebugMarkerObjectTagInfoEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkDebugMarkerObjectTagInfoEXT -> ByteArray#
unsafeByteArray (VkDebugMarkerObjectTagInfoEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkDebugMarkerObjectTagInfoEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkDebugMarkerObjectTagInfoEXT
VkDebugMarkerObjectTagInfoEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDebugMarkerObjectTagInfoEXT where
        type StructFields VkDebugMarkerObjectTagInfoEXT =
             '["sType", "pNext", "objectType", "object", "tagName", "tagSize", -- ' closing tick for hsc2hs
               "pTag"]
        type CUnionType VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDebugMarkerObjectTagInfoEXT = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "sType" VkDebugMarkerObjectTagInfoEXT =
             VkStructureType
        type FieldOptional "sType" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkDebugMarkerObjectTagInfoEXT =
             (0)
{-# LINE 617 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "sType" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 625 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "sType" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
0))
{-# LINE 632 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "sType" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
0)
{-# LINE 636 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "sType" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
0)
{-# LINE 642 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "pNext" VkDebugMarkerObjectTagInfoEXT = Ptr Void
        type FieldOptional "pNext" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkDebugMarkerObjectTagInfoEXT =
             (8)
{-# LINE 649 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pNext" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 657 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "pNext" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
8))
{-# LINE 664 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "pNext" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
8)
{-# LINE 668 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "pNext" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
8)
{-# LINE 674 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "objectType" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "objectType" VkDebugMarkerObjectTagInfoEXT =
             VkDebugReportObjectTypeEXT
        type FieldOptional "objectType" VkDebugMarkerObjectTagInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "objectType" VkDebugMarkerObjectTagInfoEXT =
             (16)
{-# LINE 683 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "objectType" VkDebugMarkerObjectTagInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 692 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "objectType" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "objectType" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO VkDebugReportObjectTypeEXT -> VkDebugReportObjectTypeEXT
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT
-> Int -> IO VkDebugReportObjectTypeEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
16))
{-# LINE 699 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "objectType" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT
-> Int -> IO VkDebugReportObjectTypeEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
16)
{-# LINE 703 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "objectType" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "objectType" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT
-> Int -> VkDebugReportObjectTypeEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
16)
{-# LINE 709 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "object" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "object" VkDebugMarkerObjectTagInfoEXT = Word64
        type FieldOptional "object" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "object" VkDebugMarkerObjectTagInfoEXT =
             (24)
{-# LINE 716 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "object" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
24)
{-# LINE 724 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "object" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "object" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO Word64 -> Word64
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
24))
{-# LINE 731 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "object" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
24)
{-# LINE 735 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "object" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "object" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
24)
{-# LINE 741 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tagName" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "tagName" VkDebugMarkerObjectTagInfoEXT = Word64
        type FieldOptional "tagName" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tagName" VkDebugMarkerObjectTagInfoEXT =
             (32)
{-# LINE 748 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "tagName" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
32)
{-# LINE 756 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tagName" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "tagName" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO Word64 -> Word64
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
32))
{-# LINE 763 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "tagName" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
32)
{-# LINE 767 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tagName" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "tagName" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
32)
{-# LINE 773 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tagSize" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "tagSize" VkDebugMarkerObjectTagInfoEXT = CSize
        type FieldOptional "tagSize" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tagSize" VkDebugMarkerObjectTagInfoEXT =
             (40)
{-# LINE 780 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "tagSize" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
40)
{-# LINE 788 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tagSize" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "tagSize" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
40))
{-# LINE 795 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "tagSize" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
40)
{-# LINE 799 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tagSize" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "tagSize" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
40)
{-# LINE 805 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pTag" VkDebugMarkerObjectTagInfoEXT where
        type FieldType "pTag" VkDebugMarkerObjectTagInfoEXT = Ptr Void
        type FieldOptional "pTag" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pTag" VkDebugMarkerObjectTagInfoEXT =
             (48)
{-# LINE 812 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pTag" VkDebugMarkerObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
48)
{-# LINE 820 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pTag" VkDebugMarkerObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugMarkerObjectTagInfoEXT
-> FieldType "pTag" VkDebugMarkerObjectTagInfoEXT
getField VkDebugMarkerObjectTagInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugMarkerObjectTagInfoEXT -> Ptr VkDebugMarkerObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugMarkerObjectTagInfoEXT
x) (Int
48))
{-# LINE 827 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> IO (FieldType "pTag" VkDebugMarkerObjectTagInfoEXT)
readField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
48)
{-# LINE 831 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pTag" VkDebugMarkerObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugMarkerObjectTagInfoEXT
-> FieldType "pTag" VkDebugMarkerObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugMarkerObjectTagInfoEXT
p
          = Ptr VkDebugMarkerObjectTagInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugMarkerObjectTagInfoEXT
p (Int
48)
{-# LINE 837 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance Show VkDebugMarkerObjectTagInfoEXT where
        showsPrec :: Int -> VkDebugMarkerObjectTagInfoEXT -> ShowS
showsPrec Int
d VkDebugMarkerObjectTagInfoEXT
x
          = String -> ShowS
showString String
"VkDebugMarkerObjectTagInfoEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "sType" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "pNext" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"objectType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkDebugReportObjectTypeEXT -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "objectType" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"objectType" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"object = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "object" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"object" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"tagName = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "tagName" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tagName" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"tagSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> CSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "tagSize" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tagSize" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"pTag = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugMarkerObjectTagInfoEXT
-> FieldType "pTag" VkDebugMarkerObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pTag" VkDebugMarkerObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkDebugReportCallbackCreateInfoEXT {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkDebugReportFlagsEXT            flags;
--   >     PFN_vkDebugReportCallbackEXT     pfnCallback;
--   >     void*            pUserData;
--   > } VkDebugReportCallbackCreateInfoEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDebugReportCallbackCreateInfoEXT VkDebugReportCallbackCreateInfoEXT registry at www.khronos.org>
data VkDebugReportCallbackCreateInfoEXT = VkDebugReportCallbackCreateInfoEXT# Addr#
                                                                              ByteArray#

instance Eq VkDebugReportCallbackCreateInfoEXT where
        (VkDebugReportCallbackCreateInfoEXT# Addr#
a ByteArray#
_) == :: VkDebugReportCallbackCreateInfoEXT
-> VkDebugReportCallbackCreateInfoEXT -> Bool
==
          x :: VkDebugReportCallbackCreateInfoEXT
x@(VkDebugReportCallbackCreateInfoEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugReportCallbackCreateInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugReportCallbackCreateInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkDebugReportCallbackCreateInfoEXT where
        (VkDebugReportCallbackCreateInfoEXT# Addr#
a ByteArray#
_) compare :: VkDebugReportCallbackCreateInfoEXT
-> VkDebugReportCallbackCreateInfoEXT -> Ordering
`compare`
          x :: VkDebugReportCallbackCreateInfoEXT
x@(VkDebugReportCallbackCreateInfoEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugReportCallbackCreateInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugReportCallbackCreateInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkDebugReportCallbackCreateInfoEXT where
        sizeOf :: VkDebugReportCallbackCreateInfoEXT -> Int
sizeOf ~VkDebugReportCallbackCreateInfoEXT
_ = (Int
40)
{-# LINE 890 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkDebugReportCallbackCreateInfoEXT -> Int
alignment ~VkDebugReportCallbackCreateInfoEXT
_
          = Int
8
{-# LINE 894 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkDebugReportCallbackCreateInfoEXT
-> IO VkDebugReportCallbackCreateInfoEXT
peek = Ptr VkDebugReportCallbackCreateInfoEXT
-> IO VkDebugReportCallbackCreateInfoEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkDebugReportCallbackCreateInfoEXT
-> VkDebugReportCallbackCreateInfoEXT -> IO ()
poke = Ptr VkDebugReportCallbackCreateInfoEXT
-> VkDebugReportCallbackCreateInfoEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkDebugReportCallbackCreateInfoEXT where
        unsafeAddr :: VkDebugReportCallbackCreateInfoEXT -> Addr#
unsafeAddr (VkDebugReportCallbackCreateInfoEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkDebugReportCallbackCreateInfoEXT -> ByteArray#
unsafeByteArray (VkDebugReportCallbackCreateInfoEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkDebugReportCallbackCreateInfoEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkDebugReportCallbackCreateInfoEXT
VkDebugReportCallbackCreateInfoEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDebugReportCallbackCreateInfoEXT where
        type StructFields VkDebugReportCallbackCreateInfoEXT =
             '["sType", "pNext", "flags", "pfnCallback", "pUserData"] -- ' closing tick for hsc2hs
        type CUnionType VkDebugReportCallbackCreateInfoEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDebugReportCallbackCreateInfoEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDebugReportCallbackCreateInfoEXT =
             '[VkInstanceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkDebugReportCallbackCreateInfoEXT where
        type FieldType "sType" VkDebugReportCallbackCreateInfoEXT =
             VkStructureType
        type FieldOptional "sType" VkDebugReportCallbackCreateInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkDebugReportCallbackCreateInfoEXT =
             (0)
{-# LINE 933 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "sType" VkDebugReportCallbackCreateInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 942 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkDebugReportCallbackCreateInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugReportCallbackCreateInfoEXT
-> FieldType "sType" VkDebugReportCallbackCreateInfoEXT
getField VkDebugReportCallbackCreateInfoEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugReportCallbackCreateInfoEXT
-> Ptr VkDebugReportCallbackCreateInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugReportCallbackCreateInfoEXT
x) (Int
0))
{-# LINE 949 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> IO (FieldType "sType" VkDebugReportCallbackCreateInfoEXT)
readField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
0)
{-# LINE 953 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDebugReportCallbackCreateInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> FieldType "sType" VkDebugReportCallbackCreateInfoEXT -> IO ()
writeField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
0)
{-# LINE 959 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkDebugReportCallbackCreateInfoEXT where
        type FieldType "pNext" VkDebugReportCallbackCreateInfoEXT =
             Ptr Void
        type FieldOptional "pNext" VkDebugReportCallbackCreateInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkDebugReportCallbackCreateInfoEXT =
             (8)
{-# LINE 968 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pNext" VkDebugReportCallbackCreateInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 977 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkDebugReportCallbackCreateInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugReportCallbackCreateInfoEXT
-> FieldType "pNext" VkDebugReportCallbackCreateInfoEXT
getField VkDebugReportCallbackCreateInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugReportCallbackCreateInfoEXT
-> Ptr VkDebugReportCallbackCreateInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugReportCallbackCreateInfoEXT
x) (Int
8))
{-# LINE 984 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> IO (FieldType "pNext" VkDebugReportCallbackCreateInfoEXT)
readField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
8)
{-# LINE 988 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDebugReportCallbackCreateInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> FieldType "pNext" VkDebugReportCallbackCreateInfoEXT -> IO ()
writeField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
8)
{-# LINE 994 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "flags" VkDebugReportCallbackCreateInfoEXT where
        type FieldType "flags" VkDebugReportCallbackCreateInfoEXT =
             VkDebugReportFlagsEXT
        type FieldOptional "flags" VkDebugReportCallbackCreateInfoEXT =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkDebugReportCallbackCreateInfoEXT =
             (16)
{-# LINE 1003 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "flags" VkDebugReportCallbackCreateInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 1012 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "flags" VkDebugReportCallbackCreateInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugReportCallbackCreateInfoEXT
-> FieldType "flags" VkDebugReportCallbackCreateInfoEXT
getField VkDebugReportCallbackCreateInfoEXT
x
          = IO VkDebugReportFlagsEXT -> VkDebugReportFlagsEXT
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> IO VkDebugReportFlagsEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugReportCallbackCreateInfoEXT
-> Ptr VkDebugReportCallbackCreateInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugReportCallbackCreateInfoEXT
x) (Int
16))
{-# LINE 1019 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> IO (FieldType "flags" VkDebugReportCallbackCreateInfoEXT)
readField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> IO VkDebugReportFlagsEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
16)
{-# LINE 1023 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkDebugReportCallbackCreateInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> FieldType "flags" VkDebugReportCallbackCreateInfoEXT -> IO ()
writeField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> VkDebugReportFlagsEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
16)
{-# LINE 1029 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pfnCallback" VkDebugReportCallbackCreateInfoEXT where
        type FieldType "pfnCallback" VkDebugReportCallbackCreateInfoEXT =
             PFN_vkDebugReportCallbackEXT
        type FieldOptional "pfnCallback" VkDebugReportCallbackCreateInfoEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pfnCallback" VkDebugReportCallbackCreateInfoEXT =
             (24)
{-# LINE 1038 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pfnCallback" VkDebugReportCallbackCreateInfoEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
24)
{-# LINE 1047 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pfnCallback" VkDebugReportCallbackCreateInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugReportCallbackCreateInfoEXT
-> FieldType "pfnCallback" VkDebugReportCallbackCreateInfoEXT
getField VkDebugReportCallbackCreateInfoEXT
x
          = IO PFN_vkDebugReportCallbackEXT -> PFN_vkDebugReportCallbackEXT
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> IO PFN_vkDebugReportCallbackEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugReportCallbackCreateInfoEXT
-> Ptr VkDebugReportCallbackCreateInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugReportCallbackCreateInfoEXT
x) (Int
24))
{-# LINE 1054 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> IO (FieldType "pfnCallback" VkDebugReportCallbackCreateInfoEXT)
readField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> IO PFN_vkDebugReportCallbackEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
24)
{-# LINE 1058 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pfnCallback" VkDebugReportCallbackCreateInfoEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> FieldType "pfnCallback" VkDebugReportCallbackCreateInfoEXT
-> IO ()
writeField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT
-> Int -> PFN_vkDebugReportCallbackEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
24)
{-# LINE 1065 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pUserData" VkDebugReportCallbackCreateInfoEXT where
        type FieldType "pUserData" VkDebugReportCallbackCreateInfoEXT =
             Ptr Void
        type FieldOptional "pUserData" VkDebugReportCallbackCreateInfoEXT =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "pUserData" VkDebugReportCallbackCreateInfoEXT =
             (32)
{-# LINE 1074 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pUserData" VkDebugReportCallbackCreateInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
32)
{-# LINE 1083 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pUserData" VkDebugReportCallbackCreateInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugReportCallbackCreateInfoEXT
-> FieldType "pUserData" VkDebugReportCallbackCreateInfoEXT
getField VkDebugReportCallbackCreateInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugReportCallbackCreateInfoEXT
-> Ptr VkDebugReportCallbackCreateInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugReportCallbackCreateInfoEXT
x) (Int
32))
{-# LINE 1090 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> IO (FieldType "pUserData" VkDebugReportCallbackCreateInfoEXT)
readField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
32)
{-# LINE 1094 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pUserData" VkDebugReportCallbackCreateInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugReportCallbackCreateInfoEXT
-> FieldType "pUserData" VkDebugReportCallbackCreateInfoEXT
-> IO ()
writeField Ptr VkDebugReportCallbackCreateInfoEXT
p
          = Ptr VkDebugReportCallbackCreateInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugReportCallbackCreateInfoEXT
p (Int
32)
{-# LINE 1100 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance Show VkDebugReportCallbackCreateInfoEXT where
        showsPrec :: Int -> VkDebugReportCallbackCreateInfoEXT -> ShowS
showsPrec Int
d VkDebugReportCallbackCreateInfoEXT
x
          = String -> ShowS
showString String
"VkDebugReportCallbackCreateInfoEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugReportCallbackCreateInfoEXT
-> FieldType "sType" VkDebugReportCallbackCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDebugReportCallbackCreateInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugReportCallbackCreateInfoEXT
-> FieldType "pNext" VkDebugReportCallbackCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDebugReportCallbackCreateInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"flags = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkDebugReportFlagsEXT -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugReportCallbackCreateInfoEXT
-> FieldType "flags" VkDebugReportCallbackCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkDebugReportCallbackCreateInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"pfnCallback = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> PFN_vkDebugReportCallbackEXT -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugReportCallbackCreateInfoEXT
-> FieldType "pfnCallback" VkDebugReportCallbackCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pfnCallback" VkDebugReportCallbackCreateInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"pUserData = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugReportCallbackCreateInfoEXT
-> FieldType "pUserData" VkDebugReportCallbackCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pUserData" VkDebugReportCallbackCreateInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkDebugUtilsObjectTagInfoEXT {
--   >     VkStructureType sType;
--   >     const void*                            pNext;
--   >     VkObjectType                           objectType;
--   >     uint64_t                               objectHandle;
--   >     uint64_t                               tagName;
--   >     size_t                                 tagSize;
--   >     const void*              pTag;
--   > } VkDebugUtilsObjectTagInfoEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDebugUtilsObjectTagInfoEXT VkDebugUtilsObjectTagInfoEXT registry at www.khronos.org>
data VkDebugUtilsObjectTagInfoEXT = VkDebugUtilsObjectTagInfoEXT# Addr#
                                                                  ByteArray#

instance Eq VkDebugUtilsObjectTagInfoEXT where
        (VkDebugUtilsObjectTagInfoEXT# Addr#
a ByteArray#
_) == :: VkDebugUtilsObjectTagInfoEXT
-> VkDebugUtilsObjectTagInfoEXT -> Bool
==
          x :: VkDebugUtilsObjectTagInfoEXT
x@(VkDebugUtilsObjectTagInfoEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugUtilsObjectTagInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugUtilsObjectTagInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkDebugUtilsObjectTagInfoEXT where
        (VkDebugUtilsObjectTagInfoEXT# Addr#
a ByteArray#
_) compare :: VkDebugUtilsObjectTagInfoEXT
-> VkDebugUtilsObjectTagInfoEXT -> Ordering
`compare`
          x :: VkDebugUtilsObjectTagInfoEXT
x@(VkDebugUtilsObjectTagInfoEXT# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkDebugUtilsObjectTagInfoEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkDebugUtilsObjectTagInfoEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkDebugUtilsObjectTagInfoEXT where
        sizeOf :: VkDebugUtilsObjectTagInfoEXT -> Int
sizeOf ~VkDebugUtilsObjectTagInfoEXT
_ = (Int
56)
{-# LINE 1148 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkDebugUtilsObjectTagInfoEXT -> Int
alignment ~VkDebugUtilsObjectTagInfoEXT
_
          = Int
8
{-# LINE 1152 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkDebugUtilsObjectTagInfoEXT -> IO VkDebugUtilsObjectTagInfoEXT
peek = Ptr VkDebugUtilsObjectTagInfoEXT -> IO VkDebugUtilsObjectTagInfoEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkDebugUtilsObjectTagInfoEXT
-> VkDebugUtilsObjectTagInfoEXT -> IO ()
poke = Ptr VkDebugUtilsObjectTagInfoEXT
-> VkDebugUtilsObjectTagInfoEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkDebugUtilsObjectTagInfoEXT where
        unsafeAddr :: VkDebugUtilsObjectTagInfoEXT -> Addr#
unsafeAddr (VkDebugUtilsObjectTagInfoEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkDebugUtilsObjectTagInfoEXT -> ByteArray#
unsafeByteArray (VkDebugUtilsObjectTagInfoEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkDebugUtilsObjectTagInfoEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkDebugUtilsObjectTagInfoEXT
VkDebugUtilsObjectTagInfoEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDebugUtilsObjectTagInfoEXT where
        type StructFields VkDebugUtilsObjectTagInfoEXT =
             '["sType", "pNext", "objectType", "objectHandle", "tagName", -- ' closing tick for hsc2hs
               "tagSize", "pTag"]
        type CUnionType VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDebugUtilsObjectTagInfoEXT = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "sType" VkDebugUtilsObjectTagInfoEXT =
             VkStructureType
        type FieldOptional "sType" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkDebugUtilsObjectTagInfoEXT =
             (0)
{-# LINE 1190 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "sType" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 1198 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "sType" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
0))
{-# LINE 1205 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "sType" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
0)
{-# LINE 1209 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "sType" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
0)
{-# LINE 1215 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "pNext" VkDebugUtilsObjectTagInfoEXT = Ptr Void
        type FieldOptional "pNext" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkDebugUtilsObjectTagInfoEXT =
             (8)
{-# LINE 1222 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pNext" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 1230 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "pNext" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
8))
{-# LINE 1237 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "pNext" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
8)
{-# LINE 1241 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "pNext" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
8)
{-# LINE 1247 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "objectType" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "objectType" VkDebugUtilsObjectTagInfoEXT =
             VkObjectType
        type FieldOptional "objectType" VkDebugUtilsObjectTagInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "objectType" VkDebugUtilsObjectTagInfoEXT =
             (16)
{-# LINE 1256 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "objectType" VkDebugUtilsObjectTagInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 1265 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "objectType" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "objectType" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO VkObjectType -> VkObjectType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO VkObjectType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
16))
{-# LINE 1272 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "objectType" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO VkObjectType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
16)
{-# LINE 1276 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "objectType" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "objectType" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> VkObjectType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
16)
{-# LINE 1282 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "objectHandle" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "objectHandle" VkDebugUtilsObjectTagInfoEXT = Word64
        type FieldOptional "objectHandle" VkDebugUtilsObjectTagInfoEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "objectHandle" VkDebugUtilsObjectTagInfoEXT =
             (24)
{-# LINE 1290 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "objectHandle" VkDebugUtilsObjectTagInfoEXT =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
24)
{-# LINE 1299 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "objectHandle" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "objectHandle" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO Word64 -> Word64
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
24))
{-# LINE 1306 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "objectHandle" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
24)
{-# LINE 1310 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "objectHandle" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "objectHandle" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
24)
{-# LINE 1316 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tagName" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "tagName" VkDebugUtilsObjectTagInfoEXT = Word64
        type FieldOptional "tagName" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tagName" VkDebugUtilsObjectTagInfoEXT =
             (32)
{-# LINE 1323 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "tagName" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
32)
{-# LINE 1331 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tagName" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "tagName" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO Word64 -> Word64
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
32))
{-# LINE 1338 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "tagName" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
32)
{-# LINE 1342 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tagName" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "tagName" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
32)
{-# LINE 1348 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tagSize" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "tagSize" VkDebugUtilsObjectTagInfoEXT = CSize
        type FieldOptional "tagSize" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tagSize" VkDebugUtilsObjectTagInfoEXT =
             (40)
{-# LINE 1355 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "tagSize" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
40)
{-# LINE 1363 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tagSize" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "tagSize" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
40))
{-# LINE 1370 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "tagSize" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
40)
{-# LINE 1374 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tagSize" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "tagSize" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
40)
{-# LINE 1380 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pTag" VkDebugUtilsObjectTagInfoEXT where
        type FieldType "pTag" VkDebugUtilsObjectTagInfoEXT = Ptr Void
        type FieldOptional "pTag" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pTag" VkDebugUtilsObjectTagInfoEXT =
             (48)
{-# LINE 1387 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}
        type FieldIsArray "pTag" VkDebugUtilsObjectTagInfoEXT = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
48)
{-# LINE 1395 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pTag" VkDebugUtilsObjectTagInfoEXT where
        {-# NOINLINE getField #-}
        getField :: VkDebugUtilsObjectTagInfoEXT
-> FieldType "pTag" VkDebugUtilsObjectTagInfoEXT
getField VkDebugUtilsObjectTagInfoEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkDebugUtilsObjectTagInfoEXT -> Ptr VkDebugUtilsObjectTagInfoEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkDebugUtilsObjectTagInfoEXT
x) (Int
48))
{-# LINE 1402 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> IO (FieldType "pTag" VkDebugUtilsObjectTagInfoEXT)
readField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
48)
{-# LINE 1406 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pTag" VkDebugUtilsObjectTagInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDebugUtilsObjectTagInfoEXT
-> FieldType "pTag" VkDebugUtilsObjectTagInfoEXT -> IO ()
writeField Ptr VkDebugUtilsObjectTagInfoEXT
p
          = Ptr VkDebugUtilsObjectTagInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDebugUtilsObjectTagInfoEXT
p (Int
48)
{-# LINE 1412 "src-gen/Graphics/Vulkan/Types/Struct/Debug.hsc" #-}

instance Show VkDebugUtilsObjectTagInfoEXT where
        showsPrec :: Int -> VkDebugUtilsObjectTagInfoEXT -> ShowS
showsPrec Int
d VkDebugUtilsObjectTagInfoEXT
x
          = String -> ShowS
showString String
"VkDebugUtilsObjectTagInfoEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "sType" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "pNext" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"objectType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkObjectType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "objectType" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"objectType" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"objectHandle = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "objectHandle" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"objectHandle" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"tagName = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "tagName" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tagName" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"tagSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> CSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "tagSize" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tagSize" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"pTag = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDebugUtilsObjectTagInfoEXT
-> FieldType "pTag" VkDebugUtilsObjectTagInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pTag" VkDebugUtilsObjectTagInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'