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


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
module Graphics.Vulkan.Types.Struct.Subpass
       (VkSubpassDependency(..), VkSubpassDescription(..),
        VkSubpassSampleLocationsEXT(..))
       where
import           Foreign.Storable                            (Storable (..))
import           GHC.Base                                    (Addr#, ByteArray#,
                                                              byteArrayContents#,
                                                              plusAddr#)
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.Enum.AccessFlags      (VkAccessFlags)
import           Graphics.Vulkan.Types.Enum.DependencyFlags  (VkDependencyFlags)
import           Graphics.Vulkan.Types.Enum.Pipeline         (VkPipelineBindPoint,
                                                              VkPipelineStageFlags)
import           Graphics.Vulkan.Types.Enum.Subpass          (VkSubpassDescriptionFlags)
import           Graphics.Vulkan.Types.Struct.Attachment     (VkAttachmentReference)
import           Graphics.Vulkan.Types.Struct.SampleLocation (VkSampleLocationsInfoEXT)
import           System.IO.Unsafe                            (unsafeDupablePerformIO)

-- | > typedef struct VkSubpassDependency {
--   >     uint32_t               srcSubpass;
--   >     uint32_t               dstSubpass;
--   >     VkPipelineStageFlags   srcStageMask;
--   >     VkPipelineStageFlags   dstStageMask;
--   >     VkAccessFlags          srcAccessMask;
--   >     VkAccessFlags          dstAccessMask;
--   >     VkDependencyFlags      dependencyFlags;
--   > } VkSubpassDependency;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSubpassDependency VkSubpassDependency registry at www.khronos.org>
data VkSubpassDependency = VkSubpassDependency# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

        {-# INLINE sizeOf #-}
        alignment :: VkSubpassDependency -> Int
alignment ~VkSubpassDependency
_ = Int
4
{-# LINE 59 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSubpassDependency where
        type StructFields VkSubpassDependency =
             '["srcSubpass", "dstSubpass", "srcStageMask", "dstStageMask", -- ' closing tick for hsc2hs
               "srcAccessMask", "dstAccessMask", "dependencyFlags"]
        type CUnionType VkSubpassDependency = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSubpassDependency = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSubpassDependency = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "srcSubpass" VkSubpassDependency where
        type FieldType "srcSubpass" VkSubpassDependency = Word32
        type FieldOptional "srcSubpass" VkSubpassDependency = 'False -- ' closing tick for hsc2hs
        type FieldOffset "srcSubpass" VkSubpassDependency =
             (0)
{-# LINE 94 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "srcSubpass" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "srcSubpass" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
0)
{-# LINE 112 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "srcSubpass" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "srcSubpass" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
0)
{-# LINE 118 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "dstSubpass" VkSubpassDependency where
        type FieldType "dstSubpass" VkSubpassDependency = Word32
        type FieldOptional "dstSubpass" VkSubpassDependency = 'False -- ' closing tick for hsc2hs
        type FieldOffset "dstSubpass" VkSubpassDependency =
             (4)
{-# LINE 125 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "dstSubpass" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset = (Int
4)
{-# LINE 132 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "dstSubpass" VkSubpassDependency where
        {-# NOINLINE getField #-}
        getField :: VkSubpassDependency -> FieldType "dstSubpass" VkSubpassDependency
getField VkSubpassDependency
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSubpassDependency -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSubpassDependency -> Ptr VkSubpassDependency
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSubpassDependency
x) (Int
4))
{-# LINE 139 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "dstSubpass" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
4)
{-# LINE 143 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "dstSubpass" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "dstSubpass" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
4)
{-# LINE 149 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "srcStageMask" VkSubpassDependency where
        type FieldType "srcStageMask" VkSubpassDependency =
             VkPipelineStageFlags
        type FieldOptional "srcStageMask" VkSubpassDependency = 'False -- ' closing tick for hsc2hs
        type FieldOffset "srcStageMask" VkSubpassDependency =
             (8)
{-# LINE 157 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "srcStageMask" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "srcStageMask" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO VkPipelineStageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
8)
{-# LINE 176 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "srcStageMask" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "srcStageMask" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> VkPipelineStageFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
8)
{-# LINE 182 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "dstStageMask" VkSubpassDependency where
        type FieldType "dstStageMask" VkSubpassDependency =
             VkPipelineStageFlags
        type FieldOptional "dstStageMask" VkSubpassDependency = 'False -- ' closing tick for hsc2hs
        type FieldOffset "dstStageMask" VkSubpassDependency =
             (12)
{-# LINE 190 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "dstStageMask" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
12)
{-# LINE 198 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "dstStageMask" VkSubpassDependency where
        {-# NOINLINE getField #-}
        getField :: VkSubpassDependency -> FieldType "dstStageMask" VkSubpassDependency
getField VkSubpassDependency
x
          = IO VkPipelineStageFlags -> VkPipelineStageFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSubpassDependency -> Int -> IO VkPipelineStageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSubpassDependency -> Ptr VkSubpassDependency
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSubpassDependency
x) (Int
12))
{-# LINE 205 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "dstStageMask" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO VkPipelineStageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
12)
{-# LINE 209 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "dstStageMask" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "dstStageMask" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> VkPipelineStageFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
12)
{-# LINE 215 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "srcAccessMask" VkSubpassDependency where
        type FieldType "srcAccessMask" VkSubpassDependency = VkAccessFlags
        type FieldOptional "srcAccessMask" VkSubpassDependency = 'True -- ' closing tick for hsc2hs
        type FieldOffset "srcAccessMask" VkSubpassDependency =
             (16)
{-# LINE 222 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "srcAccessMask" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "srcAccessMask" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO VkAccessFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
16)
{-# LINE 241 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "srcAccessMask" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "srcAccessMask" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> VkAccessFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
16)
{-# LINE 247 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "dstAccessMask" VkSubpassDependency where
        type FieldType "dstAccessMask" VkSubpassDependency = VkAccessFlags
        type FieldOptional "dstAccessMask" VkSubpassDependency = 'True -- ' closing tick for hsc2hs
        type FieldOffset "dstAccessMask" VkSubpassDependency =
             (20)
{-# LINE 254 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "dstAccessMask" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
20)
{-# LINE 262 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "dstAccessMask" VkSubpassDependency where
        {-# NOINLINE getField #-}
        getField :: VkSubpassDependency
-> FieldType "dstAccessMask" VkSubpassDependency
getField VkSubpassDependency
x
          = IO VkAccessFlags -> VkAccessFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSubpassDependency -> Int -> IO VkAccessFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSubpassDependency -> Ptr VkSubpassDependency
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSubpassDependency
x) (Int
20))
{-# LINE 269 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "dstAccessMask" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO VkAccessFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
20)
{-# LINE 273 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "dstAccessMask" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "dstAccessMask" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> VkAccessFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
20)
{-# LINE 279 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "dependencyFlags" VkSubpassDependency where
        type FieldType "dependencyFlags" VkSubpassDependency =
             VkDependencyFlags
        type FieldOptional "dependencyFlags" VkSubpassDependency = 'True -- ' closing tick for hsc2hs
        type FieldOffset "dependencyFlags" VkSubpassDependency =
             (24)
{-# LINE 287 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "dependencyFlags" VkSubpassDependency = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDependency
-> IO (FieldType "dependencyFlags" VkSubpassDependency)
readField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> IO VkDependencyFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDependency
p (Int
24)
{-# LINE 306 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "dependencyFlags" VkSubpassDependency where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDependency
-> FieldType "dependencyFlags" VkSubpassDependency -> IO ()
writeField Ptr VkSubpassDependency
p
          = Ptr VkSubpassDependency -> Int -> VkDependencyFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDependency
p (Int
24)
{-# LINE 312 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance Show VkSubpassDependency where
        showsPrec :: Int -> VkSubpassDependency -> ShowS
showsPrec Int
d VkSubpassDependency
x
          = String -> ShowS
showString String
"VkSubpassDependency {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"srcSubpass = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency -> FieldType "srcSubpass" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"srcSubpass" VkSubpassDependency
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
"dstSubpass = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency -> FieldType "dstSubpass" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"dstSubpass" VkSubpassDependency
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
"srcStageMask = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkPipelineStageFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency -> FieldType "srcStageMask" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"srcStageMask" VkSubpassDependency
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
"dstStageMask = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkPipelineStageFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency -> FieldType "dstStageMask" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"dstStageMask" VkSubpassDependency
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
"srcAccessMask = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkAccessFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency
-> FieldType "srcAccessMask" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"srcAccessMask" VkSubpassDependency
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
"dstAccessMask = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkAccessFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency
-> FieldType "dstAccessMask" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"dstAccessMask" VkSubpassDependency
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
"dependencyFlags = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkDependencyFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDependency
-> FieldType "dependencyFlags" VkSubpassDependency
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"dependencyFlags" VkSubpassDependency
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkSubpassDescription {
--   >     VkSubpassDescriptionFlags flags;
--   >     VkPipelineBindPoint    pipelineBindPoint;
--   >     uint32_t               inputAttachmentCount;
--   >     const VkAttachmentReference* pInputAttachments;
--   >     uint32_t               colorAttachmentCount;
--   >     const VkAttachmentReference* pColorAttachments;
--   >     const VkAttachmentReference* pResolveAttachments;
--   >     const VkAttachmentReference* pDepthStencilAttachment;
--   >     uint32_t               preserveAttachmentCount;
--   >     const uint32_t* pPreserveAttachments;
--   > } VkSubpassDescription;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSubpassDescription VkSubpassDescription registry at www.khronos.org>
data VkSubpassDescription = VkSubpassDescription# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkSubpassDescription where
        sizeOf :: VkSubpassDescription -> Int
sizeOf ~VkSubpassDescription
_ = (Int
72)
{-# LINE 368 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSubpassDescription where
        type StructFields VkSubpassDescription =
             '["flags", "pipelineBindPoint", "inputAttachmentCount", -- ' closing tick for hsc2hs
               "pInputAttachments", "colorAttachmentCount", "pColorAttachments",
               "pResolveAttachments", "pDepthStencilAttachment",
               "preserveAttachmentCount", "pPreserveAttachments"]
        type CUnionType VkSubpassDescription = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSubpassDescription = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSubpassDescription = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-} HasField "flags" VkSubpassDescription
         where
        type FieldType "flags" VkSubpassDescription =
             VkSubpassDescriptionFlags
        type FieldOptional "flags" VkSubpassDescription = 'True -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkSubpassDescription =
             (0)
{-# LINE 409 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "flags" VkSubpassDescription = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "flags" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO VkSubpassDescriptionFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
0)
{-# LINE 427 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "flags" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription
-> Int -> VkSubpassDescriptionFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
0)
{-# LINE 433 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pipelineBindPoint" VkSubpassDescription where
        type FieldType "pipelineBindPoint" VkSubpassDescription =
             VkPipelineBindPoint
        type FieldOptional "pipelineBindPoint" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pipelineBindPoint" VkSubpassDescription =
             (4)
{-# LINE 442 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "pipelineBindPoint" VkSubpassDescription = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
4)
{-# LINE 450 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pipelineBindPoint" VkSubpassDescription where
        {-# NOINLINE getField #-}
        getField :: VkSubpassDescription
-> FieldType "pipelineBindPoint" VkSubpassDescription
getField VkSubpassDescription
x
          = IO VkPipelineBindPoint -> VkPipelineBindPoint
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSubpassDescription -> Int -> IO VkPipelineBindPoint
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSubpassDescription -> Ptr VkSubpassDescription
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSubpassDescription
x) (Int
4))
{-# LINE 457 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "pipelineBindPoint" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO VkPipelineBindPoint
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
4)
{-# LINE 461 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pipelineBindPoint" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "pipelineBindPoint" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> VkPipelineBindPoint -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
4)
{-# LINE 467 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "inputAttachmentCount" VkSubpassDescription where
        type FieldType "inputAttachmentCount" VkSubpassDescription = Word32
        type FieldOptional "inputAttachmentCount" VkSubpassDescription =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "inputAttachmentCount" VkSubpassDescription =
             (8)
{-# LINE 475 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "inputAttachmentCount" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "inputAttachmentCount" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
8)
{-# LINE 495 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "inputAttachmentCount" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "inputAttachmentCount" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
8)
{-# LINE 501 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pInputAttachments" VkSubpassDescription where
        type FieldType "pInputAttachments" VkSubpassDescription =
             Ptr VkAttachmentReference
        type FieldOptional "pInputAttachments" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pInputAttachments" VkSubpassDescription =
             (16)
{-# LINE 510 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "pInputAttachments" VkSubpassDescription = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "pInputAttachments" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO (Ptr VkAttachmentReference)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
16)
{-# LINE 529 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pInputAttachments" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "pInputAttachments" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription
-> Int -> Ptr VkAttachmentReference -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
16)
{-# LINE 535 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "colorAttachmentCount" VkSubpassDescription where
        type FieldType "colorAttachmentCount" VkSubpassDescription = Word32
        type FieldOptional "colorAttachmentCount" VkSubpassDescription =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "colorAttachmentCount" VkSubpassDescription =
             (24)
{-# LINE 543 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "colorAttachmentCount" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "colorAttachmentCount" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
24)
{-# LINE 563 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "colorAttachmentCount" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "colorAttachmentCount" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
24)
{-# LINE 569 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pColorAttachments" VkSubpassDescription where
        type FieldType "pColorAttachments" VkSubpassDescription =
             Ptr VkAttachmentReference
        type FieldOptional "pColorAttachments" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pColorAttachments" VkSubpassDescription =
             (32)
{-# LINE 578 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "pColorAttachments" VkSubpassDescription = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "pColorAttachments" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO (Ptr VkAttachmentReference)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
32)
{-# LINE 597 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pColorAttachments" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "pColorAttachments" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription
-> Int -> Ptr VkAttachmentReference -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
32)
{-# LINE 603 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pResolveAttachments" VkSubpassDescription where
        type FieldType "pResolveAttachments" VkSubpassDescription =
             Ptr VkAttachmentReference
        type FieldOptional "pResolveAttachments" VkSubpassDescription =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "pResolveAttachments" VkSubpassDescription =
             (40)
{-# LINE 612 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "pResolveAttachments" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "pResolveAttachments" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO (Ptr VkAttachmentReference)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
40)
{-# LINE 632 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pResolveAttachments" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "pResolveAttachments" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription
-> Int -> Ptr VkAttachmentReference -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
40)
{-# LINE 638 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pDepthStencilAttachment" VkSubpassDescription where
        type FieldType "pDepthStencilAttachment" VkSubpassDescription =
             Ptr VkAttachmentReference
        type FieldOptional "pDepthStencilAttachment" VkSubpassDescription =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "pDepthStencilAttachment" VkSubpassDescription =
             (48)
{-# LINE 647 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "pDepthStencilAttachment" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "pDepthStencilAttachment" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO (Ptr VkAttachmentReference)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
48)
{-# LINE 667 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pDepthStencilAttachment" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "pDepthStencilAttachment" VkSubpassDescription
-> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription
-> Int -> Ptr VkAttachmentReference -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
48)
{-# LINE 673 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "preserveAttachmentCount" VkSubpassDescription where
        type FieldType "preserveAttachmentCount" VkSubpassDescription =
             Word32
        type FieldOptional "preserveAttachmentCount" VkSubpassDescription =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "preserveAttachmentCount" VkSubpassDescription =
             (56)
{-# LINE 682 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "preserveAttachmentCount" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
56)
{-# LINE 691 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "preserveAttachmentCount" VkSubpassDescription where
        {-# NOINLINE getField #-}
        getField :: VkSubpassDescription
-> FieldType "preserveAttachmentCount" VkSubpassDescription
getField VkSubpassDescription
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSubpassDescription -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSubpassDescription -> Ptr VkSubpassDescription
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSubpassDescription
x) (Int
56))
{-# LINE 698 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "preserveAttachmentCount" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
56)
{-# LINE 702 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "preserveAttachmentCount" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "preserveAttachmentCount" VkSubpassDescription
-> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
56)
{-# LINE 708 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pPreserveAttachments" VkSubpassDescription where
        type FieldType "pPreserveAttachments" VkSubpassDescription =
             Ptr Word32
        type FieldOptional "pPreserveAttachments" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pPreserveAttachments" VkSubpassDescription =
             (64)
{-# LINE 717 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "pPreserveAttachments" VkSubpassDescription =
             'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
64)
{-# LINE 726 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pPreserveAttachments" VkSubpassDescription where
        {-# NOINLINE getField #-}
        getField :: VkSubpassDescription
-> FieldType "pPreserveAttachments" VkSubpassDescription
getField VkSubpassDescription
x
          = IO (Ptr Word32) -> Ptr Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSubpassDescription -> Int -> IO (Ptr Word32)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSubpassDescription -> Ptr VkSubpassDescription
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSubpassDescription
x) (Int
64))
{-# LINE 733 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassDescription
-> IO (FieldType "pPreserveAttachments" VkSubpassDescription)
readField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> IO (Ptr Word32)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassDescription
p (Int
64)
{-# LINE 737 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pPreserveAttachments" VkSubpassDescription where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassDescription
-> FieldType "pPreserveAttachments" VkSubpassDescription -> IO ()
writeField Ptr VkSubpassDescription
p
          = Ptr VkSubpassDescription -> Int -> Ptr Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassDescription
p (Int
64)
{-# LINE 743 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance Show VkSubpassDescription where
        showsPrec :: Int -> VkSubpassDescription -> ShowS
showsPrec Int
d VkSubpassDescription
x
          = String -> ShowS
showString String
"VkSubpassDescription {" 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 -> VkSubpassDescriptionFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription -> FieldType "flags" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkSubpassDescription
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
"pipelineBindPoint = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> VkPipelineBindPoint -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription
-> FieldType "pipelineBindPoint" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pipelineBindPoint" VkSubpassDescription
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
"inputAttachmentCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription
-> FieldType "inputAttachmentCount" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"inputAttachmentCount" VkSubpassDescription
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
"pInputAttachments = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Ptr VkAttachmentReference -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription
-> FieldType "pInputAttachments" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pInputAttachments" VkSubpassDescription
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
"colorAttachmentCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription
-> FieldType "colorAttachmentCount" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"colorAttachmentCount" VkSubpassDescription
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
"pColorAttachments = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> Ptr VkAttachmentReference -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription
-> FieldType "pColorAttachments" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pColorAttachments" VkSubpassDescription
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
"pResolveAttachments = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> Ptr VkAttachmentReference -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassDescription
-> FieldType "pResolveAttachments" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pResolveAttachments" VkSubpassDescription
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
"pDepthStencilAttachment = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> Ptr VkAttachmentReference -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkSubpassDescription
-> FieldType "pDepthStencilAttachment" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pDepthStencilAttachment" VkSubpassDescription
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
"preserveAttachmentCount = "
                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkSubpassDescription
-> FieldType "preserveAttachmentCount" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                     @"preserveAttachmentCount"
                                                                     VkSubpassDescription
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
"pPreserveAttachments = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> Ptr Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkSubpassDescription
-> FieldType "pPreserveAttachments" VkSubpassDescription
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"pPreserveAttachments"
                                                                           VkSubpassDescription
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkSubpassSampleLocationsEXT {
--   >     uint32_t                         subpassIndex;
--   >     VkSampleLocationsInfoEXT         sampleLocationsInfo;
--   > } VkSubpassSampleLocationsEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSubpassSampleLocationsEXT VkSubpassSampleLocationsEXT registry at www.khronos.org>
data VkSubpassSampleLocationsEXT = VkSubpassSampleLocationsEXT# Addr#
                                                                ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkSubpassSampleLocationsEXT where
        sizeOf :: VkSubpassSampleLocationsEXT -> Int
sizeOf ~VkSubpassSampleLocationsEXT
_ = (Int
48)
{-# LINE 816 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSubpassSampleLocationsEXT where
        type StructFields VkSubpassSampleLocationsEXT =
             '["subpassIndex", "sampleLocationsInfo"] -- ' closing tick for hsc2hs
        type CUnionType VkSubpassSampleLocationsEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSubpassSampleLocationsEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSubpassSampleLocationsEXT = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "subpassIndex" VkSubpassSampleLocationsEXT where
        type FieldType "subpassIndex" VkSubpassSampleLocationsEXT = Word32
        type FieldOptional "subpassIndex" VkSubpassSampleLocationsEXT =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "subpassIndex" VkSubpassSampleLocationsEXT =
             (0)
{-# LINE 856 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "subpassIndex" VkSubpassSampleLocationsEXT =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassSampleLocationsEXT
-> IO (FieldType "subpassIndex" VkSubpassSampleLocationsEXT)
readField Ptr VkSubpassSampleLocationsEXT
p
          = Ptr VkSubpassSampleLocationsEXT -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassSampleLocationsEXT
p (Int
0)
{-# LINE 876 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subpassIndex" VkSubpassSampleLocationsEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassSampleLocationsEXT
-> FieldType "subpassIndex" VkSubpassSampleLocationsEXT -> IO ()
writeField Ptr VkSubpassSampleLocationsEXT
p
          = Ptr VkSubpassSampleLocationsEXT -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassSampleLocationsEXT
p (Int
0)
{-# LINE 882 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampleLocationsInfo" VkSubpassSampleLocationsEXT where
        type FieldType "sampleLocationsInfo" VkSubpassSampleLocationsEXT =
             VkSampleLocationsInfoEXT
        type FieldOptional "sampleLocationsInfo"
               VkSubpassSampleLocationsEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sampleLocationsInfo" VkSubpassSampleLocationsEXT
             =
             (8)
{-# LINE 893 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}
        type FieldIsArray "sampleLocationsInfo" VkSubpassSampleLocationsEXT
             = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSubpassSampleLocationsEXT
-> IO (FieldType "sampleLocationsInfo" VkSubpassSampleLocationsEXT)
readField Ptr VkSubpassSampleLocationsEXT
p
          = Ptr VkSubpassSampleLocationsEXT
-> Int -> IO VkSampleLocationsInfoEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSubpassSampleLocationsEXT
p (Int
8)
{-# LINE 914 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampleLocationsInfo" VkSubpassSampleLocationsEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSubpassSampleLocationsEXT
-> FieldType "sampleLocationsInfo" VkSubpassSampleLocationsEXT
-> IO ()
writeField Ptr VkSubpassSampleLocationsEXT
p
          = Ptr VkSubpassSampleLocationsEXT
-> Int -> VkSampleLocationsInfoEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSubpassSampleLocationsEXT
p (Int
8)
{-# LINE 921 "src-gen/Graphics/Vulkan/Types/Struct/Subpass.hsc" #-}

instance Show VkSubpassSampleLocationsEXT where
        showsPrec :: Int -> VkSubpassSampleLocationsEXT -> ShowS
showsPrec Int
d VkSubpassSampleLocationsEXT
x
          = String -> ShowS
showString String
"VkSubpassSampleLocationsEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"subpassIndex = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassSampleLocationsEXT
-> FieldType "subpassIndex" VkSubpassSampleLocationsEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"subpassIndex" VkSubpassSampleLocationsEXT
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
"sampleLocationsInfo = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> VkSampleLocationsInfoEXT -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSubpassSampleLocationsEXT
-> FieldType "sampleLocationsInfo" VkSubpassSampleLocationsEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sampleLocationsInfo" VkSubpassSampleLocationsEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'