{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_device_memory_report  ( PhysicalDeviceDeviceMemoryReportFeaturesEXT(..)
                                                      , DeviceDeviceMemoryReportCreateInfoEXT(..)
                                                      , DeviceMemoryReportCallbackDataEXT(..)
                                                      , DeviceMemoryReportFlagsEXT(..)
                                                      , DeviceMemoryReportEventTypeEXT( DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT
                                                                                      , DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT
                                                                                      , DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT
                                                                                      , DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT
                                                                                      , DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT
                                                                                      , ..
                                                                                      )
                                                      , PFN_vkDeviceMemoryReportCallbackEXT
                                                      , FN_vkDeviceMemoryReportCallbackEXT
                                                      , EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION
                                                      , pattern EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION
                                                      , EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME
                                                      , pattern EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME
                                                      ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.Bits (Bits)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Text.Read.Lex (Lexeme(Ident))
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.ObjectType (ObjectType)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_DEVICE_MEMORY_REPORT_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_MEMORY_REPORT_CALLBACK_DATA_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_MEMORY_REPORT_FEATURES_EXT))
-- | VkPhysicalDeviceDeviceMemoryReportFeaturesEXT - Structure describing
-- whether device memory report callback can be supported by an
-- implementation
--
-- = Members
--
-- The members of the 'PhysicalDeviceDeviceMemoryReportFeaturesEXT'
-- structure describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceDeviceMemoryReportFeaturesEXT' structure is
-- included in the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
-- it is filled with a value indicating whether the feature is supported.
-- 'PhysicalDeviceDeviceMemoryReportFeaturesEXT' /can/ also be used in the
-- @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to enable the
-- feature.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDeviceMemoryReportFeaturesEXT = PhysicalDeviceDeviceMemoryReportFeaturesEXT
  { -- | @deviceMemoryReport@ indicates whether the implementation supports the
    -- ability to register device memory report callbacks.
    PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
deviceMemoryReport :: Bool }
  deriving (Typeable, PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
(PhysicalDeviceDeviceMemoryReportFeaturesEXT
 -> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool)
-> (PhysicalDeviceDeviceMemoryReportFeaturesEXT
    -> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool)
-> Eq PhysicalDeviceDeviceMemoryReportFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
$c/= :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
== :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
$c== :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDeviceMemoryReportFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceDeviceMemoryReportFeaturesEXT

instance ToCStruct PhysicalDeviceDeviceMemoryReportFeaturesEXT where
  withCStruct :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> (Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
x f :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b
f = Int
-> Int
-> (Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p -> Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p PhysicalDeviceDeviceMemoryReportFeaturesEXT
x (Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b
f Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p)
  pokeCStruct :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p PhysicalDeviceDeviceMemoryReportFeaturesEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_MEMORY_REPORT_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceMemoryReport))
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_MEMORY_REPORT_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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


-- | VkDeviceDeviceMemoryReportCreateInfoEXT - Register device memory report
-- callbacks for a Vulkan device
--
-- = Description
--
-- The callback /may/ be called from multiple threads simultaneously.
--
-- The callback /must/ be called only once by the implementation when a
-- 'DeviceMemoryReportEventTypeEXT' event occurs.
--
-- Note
--
-- The callback could be called from a background thread other than the
-- thread calling the Vulkan commands.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'PFN_vkDeviceMemoryReportCallbackEXT', 'DeviceMemoryReportFlagsEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DeviceDeviceMemoryReportCreateInfoEXT = DeviceDeviceMemoryReportCreateInfoEXT
  { -- | @flags@ is 0 and reserved for future use.
    --
    -- @flags@ /must/ be @0@
    DeviceDeviceMemoryReportCreateInfoEXT -> DeviceMemoryReportFlagsEXT
flags :: DeviceMemoryReportFlagsEXT
  , -- | @pfnUserCallback@ is the application callback function to call.
    --
    -- @pfnUserCallback@ /must/ be a valid
    -- 'PFN_vkDeviceMemoryReportCallbackEXT' value
    DeviceDeviceMemoryReportCreateInfoEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback :: PFN_vkDeviceMemoryReportCallbackEXT
  , -- | @pUserData@ is user data to be passed to the callback.
    --
    -- @pUserData@ /must/ be a pointer value
    DeviceDeviceMemoryReportCreateInfoEXT -> Ptr ()
userData :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceDeviceMemoryReportCreateInfoEXT)
#endif
deriving instance Show DeviceDeviceMemoryReportCreateInfoEXT

instance ToCStruct DeviceDeviceMemoryReportCreateInfoEXT where
  withCStruct :: DeviceDeviceMemoryReportCreateInfoEXT
-> (Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b) -> IO b
withCStruct x :: DeviceDeviceMemoryReportCreateInfoEXT
x f :: Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b
f = Int
-> Int
-> (Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b) -> IO b)
-> (Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
p -> Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> DeviceDeviceMemoryReportCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceDeviceMemoryReportCreateInfoEXT
p DeviceDeviceMemoryReportCreateInfoEXT
x (Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b
f Ptr DeviceDeviceMemoryReportCreateInfoEXT
p)
  pokeCStruct :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> DeviceDeviceMemoryReportCreateInfoEXT -> IO b -> IO b
pokeCStruct p :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
p DeviceDeviceMemoryReportCreateInfoEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_DEVICE_MEMORY_REPORT_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr DeviceMemoryReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemoryReportFlagsEXT)) (DeviceMemoryReportFlagsEXT
flags)
    Ptr PFN_vkDeviceMemoryReportCallbackEXT
-> PFN_vkDeviceMemoryReportCallbackEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr PFN_vkDeviceMemoryReportCallbackEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr PFN_vkDeviceMemoryReportCallbackEXT)) (PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ()))) (Ptr ()
userData)
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_DEVICE_MEMORY_REPORT_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr DeviceMemoryReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemoryReportFlagsEXT)) (DeviceMemoryReportFlagsEXT
forall a. Zero a => a
zero)
    Ptr PFN_vkDeviceMemoryReportCallbackEXT
-> PFN_vkDeviceMemoryReportCallbackEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr PFN_vkDeviceMemoryReportCallbackEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr PFN_vkDeviceMemoryReportCallbackEXT)) (PFN_vkDeviceMemoryReportCallbackEXT
forall a. Zero a => a
zero)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ()))) (Ptr ()
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DeviceDeviceMemoryReportCreateInfoEXT where
  peekCStruct :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> IO DeviceDeviceMemoryReportCreateInfoEXT
peekCStruct p :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
p = do
    DeviceMemoryReportFlagsEXT
flags <- Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemoryReportFlagsEXT ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr DeviceMemoryReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemoryReportFlagsEXT))
    PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback <- Ptr PFN_vkDeviceMemoryReportCallbackEXT
-> IO PFN_vkDeviceMemoryReportCallbackEXT
forall a. Storable a => Ptr a -> IO a
peek @PFN_vkDeviceMemoryReportCallbackEXT ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> Int -> Ptr PFN_vkDeviceMemoryReportCallbackEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr PFN_vkDeviceMemoryReportCallbackEXT))
    Ptr ()
pUserData <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p Ptr DeviceDeviceMemoryReportCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ())))
    DeviceDeviceMemoryReportCreateInfoEXT
-> IO DeviceDeviceMemoryReportCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceDeviceMemoryReportCreateInfoEXT
 -> IO DeviceDeviceMemoryReportCreateInfoEXT)
-> DeviceDeviceMemoryReportCreateInfoEXT
-> IO DeviceDeviceMemoryReportCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ DeviceMemoryReportFlagsEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
-> Ptr ()
-> DeviceDeviceMemoryReportCreateInfoEXT
DeviceDeviceMemoryReportCreateInfoEXT
             DeviceMemoryReportFlagsEXT
flags PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback Ptr ()
pUserData

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

instance Zero DeviceDeviceMemoryReportCreateInfoEXT where
  zero :: DeviceDeviceMemoryReportCreateInfoEXT
zero = DeviceMemoryReportFlagsEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
-> Ptr ()
-> DeviceDeviceMemoryReportCreateInfoEXT
DeviceDeviceMemoryReportCreateInfoEXT
           DeviceMemoryReportFlagsEXT
forall a. Zero a => a
zero
           PFN_vkDeviceMemoryReportCallbackEXT
forall a. Zero a => a
zero
           Ptr ()
forall a. Zero a => a
zero


-- | VkDeviceMemoryReportCallbackDataEXT - Structure specifying parameters
-- returned to the callback
--
-- = Description
--
-- @memoryObjectId@ is used to avoid double-counting on the same memory
-- object.
--
-- If an internally-allocated device memory object or a
-- 'Vulkan.Core10.Handles.DeviceMemory' /cannot/ be exported,
-- @memoryObjectId@ /must/ be unique in the 'Vulkan.Core10.Handles.Device'.
--
-- If an internally-allocated device memory object or a
-- 'Vulkan.Core10.Handles.DeviceMemory' supports being exported,
-- @memoryObjectId@ /must/ be unique system wide.
--
-- If an internal device memory object or a
-- 'Vulkan.Core10.Handles.DeviceMemory' is backed by an imported external
-- memory object, @memoryObjectId@ /must/ be unique system wide.
--
-- Note
--
-- This structure should only be considered valid during the lifetime of
-- the triggered callback.
--
-- For 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT' and
-- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT' events, @objectHandle@
-- usually will not yet exist when the application or tool receives the
-- callback. @objectHandle@ will only exist when the create or allocate
-- call that triggered the event returns, and if the allocation or import
-- ends up failing @objectHandle@ won’t ever exist.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'DeviceMemoryReportEventTypeEXT', 'DeviceMemoryReportFlagsEXT',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.ObjectType.ObjectType',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DeviceMemoryReportCallbackDataEXT = DeviceMemoryReportCallbackDataEXT
  { -- | @flags@ is 0 and reserved for future use.
    DeviceMemoryReportCallbackDataEXT -> DeviceMemoryReportFlagsEXT
flags :: DeviceMemoryReportFlagsEXT
  , -- | @type@ is a 'DeviceMemoryReportEventTypeEXT' type specifying the type of
    -- event reported in this 'DeviceMemoryReportCallbackDataEXT' structure.
    DeviceMemoryReportCallbackDataEXT -> DeviceMemoryReportEventTypeEXT
type' :: DeviceMemoryReportEventTypeEXT
  , -- | @memoryObjectId@ is the unique id for the underlying memory object as
    -- described below.
    DeviceMemoryReportCallbackDataEXT -> Word64
memoryObjectId :: Word64
  , -- | @size@ is the size of the memory object in bytes. If @type@ is
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT',
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT' or
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT', @size@ /must/
    -- be a valid 'Vulkan.Core10.FundamentalTypes.DeviceSize' value.
    DeviceMemoryReportCallbackDataEXT -> Word64
size :: DeviceSize
  , -- | @objectType@ is a 'Vulkan.Core10.Enums.ObjectType.ObjectType' value
    -- specifying the type of the object associated with this device memory
    -- report event. If @type@ is
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT',
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT' or
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT', @objectType@
    -- /must/ be a valid 'Vulkan.Core10.Enums.ObjectType.ObjectType' enum.
    DeviceMemoryReportCallbackDataEXT -> ObjectType
objectType :: ObjectType
  , -- | @objectHandle@ is the object this device memory report event is
    -- attributed to. If @type@ is
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT',
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT',
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT' or
    -- 'DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT', @objectHandle@ /must/ be
    -- a valid Vulkan handle of the type associated with @objectType@ as
    -- defined in the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#debugging-object-types VkObjectType and Vulkan Handle Relationship>
    -- table.
    DeviceMemoryReportCallbackDataEXT -> Word64
objectHandle :: Word64
  , -- | @heapIndex@ describes which memory heap this device memory allocation is
    -- made from. If @type@ is 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT'
    -- or 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT', @heapIndex@
    -- /must/ correspond to one of the valid heaps from the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceMemoryProperties'
    -- structure. Otherwise, @heapIndex@ is undefined.
    DeviceMemoryReportCallbackDataEXT -> Word32
heapIndex :: Word32
  }
  deriving (Typeable, DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
(DeviceMemoryReportCallbackDataEXT
 -> DeviceMemoryReportCallbackDataEXT -> Bool)
-> (DeviceMemoryReportCallbackDataEXT
    -> DeviceMemoryReportCallbackDataEXT -> Bool)
-> Eq DeviceMemoryReportCallbackDataEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
$c/= :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
== :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
$c== :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceMemoryReportCallbackDataEXT)
#endif
deriving instance Show DeviceMemoryReportCallbackDataEXT

instance ToCStruct DeviceMemoryReportCallbackDataEXT where
  withCStruct :: DeviceMemoryReportCallbackDataEXT
-> (Ptr DeviceMemoryReportCallbackDataEXT -> IO b) -> IO b
withCStruct x :: DeviceMemoryReportCallbackDataEXT
x f :: Ptr DeviceMemoryReportCallbackDataEXT -> IO b
f = Int
-> Int -> (Ptr DeviceMemoryReportCallbackDataEXT -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 64 8 ((Ptr DeviceMemoryReportCallbackDataEXT -> IO b) -> IO b)
-> (Ptr DeviceMemoryReportCallbackDataEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr DeviceMemoryReportCallbackDataEXT
p -> Ptr DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceMemoryReportCallbackDataEXT
p DeviceMemoryReportCallbackDataEXT
x (Ptr DeviceMemoryReportCallbackDataEXT -> IO b
f Ptr DeviceMemoryReportCallbackDataEXT
p)
  pokeCStruct :: Ptr DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> IO b -> IO b
pokeCStruct p :: Ptr DeviceMemoryReportCallbackDataEXT
p DeviceMemoryReportCallbackDataEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_MEMORY_REPORT_CALLBACK_DATA_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT
-> Int -> Ptr DeviceMemoryReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemoryReportFlagsEXT)) (DeviceMemoryReportFlagsEXT
flags)
    Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT
-> Int -> Ptr DeviceMemoryReportEventTypeEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr DeviceMemoryReportEventTypeEXT)) (DeviceMemoryReportEventTypeEXT
type')
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word64)) (Word64
memoryObjectId)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr DeviceSize)) (Word64
size)
    Ptr ObjectType -> ObjectType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr ObjectType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr ObjectType)) (ObjectType
objectType)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word64)) (Word64
objectHandle)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr Word32)) (Word32
heapIndex)
    IO b
f
  cStructSize :: Int
cStructSize = 64
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr DeviceMemoryReportCallbackDataEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr DeviceMemoryReportCallbackDataEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_MEMORY_REPORT_CALLBACK_DATA_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT
-> Int -> Ptr DeviceMemoryReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemoryReportFlagsEXT)) (DeviceMemoryReportFlagsEXT
forall a. Zero a => a
zero)
    Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT
-> Int -> Ptr DeviceMemoryReportEventTypeEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr DeviceMemoryReportEventTypeEXT)) (DeviceMemoryReportEventTypeEXT
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DeviceMemoryReportCallbackDataEXT where
  peekCStruct :: Ptr DeviceMemoryReportCallbackDataEXT
-> IO DeviceMemoryReportCallbackDataEXT
peekCStruct p :: Ptr DeviceMemoryReportCallbackDataEXT
p = do
    DeviceMemoryReportFlagsEXT
flags <- Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemoryReportFlagsEXT ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT
-> Int -> Ptr DeviceMemoryReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemoryReportFlagsEXT))
    DeviceMemoryReportEventTypeEXT
type' <- Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemoryReportEventTypeEXT ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT
-> Int -> Ptr DeviceMemoryReportEventTypeEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr DeviceMemoryReportEventTypeEXT))
    Word64
memoryObjectId <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word64))
    Word64
size <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr DeviceSize))
    ObjectType
objectType <- Ptr ObjectType -> IO ObjectType
forall a. Storable a => Ptr a -> IO a
peek @ObjectType ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr ObjectType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr ObjectType))
    Word64
objectHandle <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word64))
    Word32
heapIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceMemoryReportCallbackDataEXT
p Ptr DeviceMemoryReportCallbackDataEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr Word32))
    DeviceMemoryReportCallbackDataEXT
-> IO DeviceMemoryReportCallbackDataEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceMemoryReportCallbackDataEXT
 -> IO DeviceMemoryReportCallbackDataEXT)
-> DeviceMemoryReportCallbackDataEXT
-> IO DeviceMemoryReportCallbackDataEXT
forall a b. (a -> b) -> a -> b
$ DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportEventTypeEXT
-> Word64
-> Word64
-> ObjectType
-> Word64
-> Word32
-> DeviceMemoryReportCallbackDataEXT
DeviceMemoryReportCallbackDataEXT
             DeviceMemoryReportFlagsEXT
flags DeviceMemoryReportEventTypeEXT
type' Word64
memoryObjectId Word64
size ObjectType
objectType Word64
objectHandle Word32
heapIndex

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

instance Zero DeviceMemoryReportCallbackDataEXT where
  zero :: DeviceMemoryReportCallbackDataEXT
zero = DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportEventTypeEXT
-> Word64
-> Word64
-> ObjectType
-> Word64
-> Word32
-> DeviceMemoryReportCallbackDataEXT
DeviceMemoryReportCallbackDataEXT
           DeviceMemoryReportFlagsEXT
forall a. Zero a => a
zero
           DeviceMemoryReportEventTypeEXT
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           ObjectType
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- No documentation found for TopLevel "VkDeviceMemoryReportFlagsEXT"
newtype DeviceMemoryReportFlagsEXT = DeviceMemoryReportFlagsEXT Flags
  deriving newtype (DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
(DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> Bool)
-> Eq DeviceMemoryReportFlagsEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c/= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
== :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c== :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
Eq, Eq DeviceMemoryReportFlagsEXT
Eq DeviceMemoryReportFlagsEXT =>
(DeviceMemoryReportFlagsEXT
 -> DeviceMemoryReportFlagsEXT -> Ordering)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> Bool)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> Bool)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> Bool)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> Bool)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT)
-> Ord DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> Ordering
DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cmin :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
max :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cmax :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
>= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c>= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
> :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c> :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
<= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c<= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
< :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c< :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
compare :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> Ordering
$ccompare :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> Ordering
$cp1Ord :: Eq DeviceMemoryReportFlagsEXT
Ord, Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ()
Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
Ptr DeviceMemoryReportFlagsEXT
-> Int -> IO DeviceMemoryReportFlagsEXT
Ptr DeviceMemoryReportFlagsEXT
-> Int -> DeviceMemoryReportFlagsEXT -> IO ()
Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
DeviceMemoryReportFlagsEXT -> Int
(DeviceMemoryReportFlagsEXT -> Int)
-> (DeviceMemoryReportFlagsEXT -> Int)
-> (Ptr DeviceMemoryReportFlagsEXT
    -> Int -> IO DeviceMemoryReportFlagsEXT)
-> (Ptr DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT)
-> (forall b. Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ())
-> (Ptr DeviceMemoryReportFlagsEXT
    -> IO DeviceMemoryReportFlagsEXT)
-> (Ptr DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> IO ())
-> Storable DeviceMemoryReportFlagsEXT
forall b. Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
forall b. Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
$cpoke :: Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
peek :: Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
$cpeek :: Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
pokeByteOff :: Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ()
peekByteOff :: Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
pokeElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> DeviceMemoryReportFlagsEXT -> IO ()
$cpokeElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> DeviceMemoryReportFlagsEXT -> IO ()
peekElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> IO DeviceMemoryReportFlagsEXT
$cpeekElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> IO DeviceMemoryReportFlagsEXT
alignment :: DeviceMemoryReportFlagsEXT -> Int
$calignment :: DeviceMemoryReportFlagsEXT -> Int
sizeOf :: DeviceMemoryReportFlagsEXT -> Int
$csizeOf :: DeviceMemoryReportFlagsEXT -> Int
Storable, DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> Zero DeviceMemoryReportFlagsEXT
forall a. a -> Zero a
zero :: DeviceMemoryReportFlagsEXT
$czero :: DeviceMemoryReportFlagsEXT
Zero, Eq DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT
Eq DeviceMemoryReportFlagsEXT =>
(DeviceMemoryReportFlagsEXT
 -> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> DeviceMemoryReportFlagsEXT
-> (Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT -> Int -> Bool)
-> (DeviceMemoryReportFlagsEXT -> Maybe Int)
-> (DeviceMemoryReportFlagsEXT -> Int)
-> (DeviceMemoryReportFlagsEXT -> Bool)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT
    -> Int -> DeviceMemoryReportFlagsEXT)
-> (DeviceMemoryReportFlagsEXT -> Int)
-> Bits DeviceMemoryReportFlagsEXT
Int -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> Bool
DeviceMemoryReportFlagsEXT -> Int
DeviceMemoryReportFlagsEXT -> Maybe Int
DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> Int -> Bool
DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: DeviceMemoryReportFlagsEXT -> Int
$cpopCount :: DeviceMemoryReportFlagsEXT -> Int
rotateR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$crotateR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
rotateL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$crotateL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
unsafeShiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cunsafeShiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
shiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cshiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
unsafeShiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cunsafeShiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
shiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cshiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
isSigned :: DeviceMemoryReportFlagsEXT -> Bool
$cisSigned :: DeviceMemoryReportFlagsEXT -> Bool
bitSize :: DeviceMemoryReportFlagsEXT -> Int
$cbitSize :: DeviceMemoryReportFlagsEXT -> Int
bitSizeMaybe :: DeviceMemoryReportFlagsEXT -> Maybe Int
$cbitSizeMaybe :: DeviceMemoryReportFlagsEXT -> Maybe Int
testBit :: DeviceMemoryReportFlagsEXT -> Int -> Bool
$ctestBit :: DeviceMemoryReportFlagsEXT -> Int -> Bool
complementBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$ccomplementBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
clearBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cclearBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
setBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$csetBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
bit :: Int -> DeviceMemoryReportFlagsEXT
$cbit :: Int -> DeviceMemoryReportFlagsEXT
zeroBits :: DeviceMemoryReportFlagsEXT
$czeroBits :: DeviceMemoryReportFlagsEXT
rotate :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$crotate :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
shift :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cshift :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
complement :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$ccomplement :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
xor :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cxor :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
.|. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$c.|. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
.&. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$c.&. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cp1Bits :: Eq DeviceMemoryReportFlagsEXT
Bits)



instance Show DeviceMemoryReportFlagsEXT where
  showsPrec :: Int -> DeviceMemoryReportFlagsEXT -> ShowS
showsPrec p :: Int
p = \case
    DeviceMemoryReportFlagsEXT x :: Word32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "DeviceMemoryReportFlagsEXT 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)

instance Read DeviceMemoryReportFlagsEXT where
  readPrec :: ReadPrec DeviceMemoryReportFlagsEXT
readPrec = ReadPrec DeviceMemoryReportFlagsEXT
-> ReadPrec DeviceMemoryReportFlagsEXT
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec DeviceMemoryReportFlagsEXT)]
-> ReadPrec DeviceMemoryReportFlagsEXT
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose []
                     ReadPrec DeviceMemoryReportFlagsEXT
-> ReadPrec DeviceMemoryReportFlagsEXT
-> ReadPrec DeviceMemoryReportFlagsEXT
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int
-> ReadPrec DeviceMemoryReportFlagsEXT
-> ReadPrec DeviceMemoryReportFlagsEXT
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "DeviceMemoryReportFlagsEXT")
                       Word32
v <- ReadPrec Word32 -> ReadPrec Word32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Word32
forall a. Read a => ReadPrec a
readPrec
                       DeviceMemoryReportFlagsEXT -> ReadPrec DeviceMemoryReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT Word32
v)))


-- | VkDeviceMemoryReportEventTypeEXT - Events that can occur on a device
-- memory object
--
-- = See Also
--
-- 'DeviceMemoryReportCallbackDataEXT'
newtype DeviceMemoryReportEventTypeEXT = DeviceMemoryReportEventTypeEXT Int32
  deriving newtype (DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
(DeviceMemoryReportEventTypeEXT
 -> DeviceMemoryReportEventTypeEXT -> Bool)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT -> Bool)
-> Eq DeviceMemoryReportEventTypeEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c/= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
== :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c== :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
Eq, Eq DeviceMemoryReportEventTypeEXT
Eq DeviceMemoryReportEventTypeEXT =>
(DeviceMemoryReportEventTypeEXT
 -> DeviceMemoryReportEventTypeEXT -> Ordering)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT -> Bool)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT -> Bool)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT -> Bool)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT -> Bool)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT)
-> (DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT)
-> Ord DeviceMemoryReportEventTypeEXT
DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Ordering
DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
$cmin :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
max :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
$cmax :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
>= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c>= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
> :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c> :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
<= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c<= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
< :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c< :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
compare :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Ordering
$ccompare :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Ordering
$cp1Ord :: Eq DeviceMemoryReportEventTypeEXT
Ord, Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
Ptr DeviceMemoryReportEventTypeEXT
-> Int -> IO DeviceMemoryReportEventTypeEXT
Ptr DeviceMemoryReportEventTypeEXT
-> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
DeviceMemoryReportEventTypeEXT -> Int
(DeviceMemoryReportEventTypeEXT -> Int)
-> (DeviceMemoryReportEventTypeEXT -> Int)
-> (Ptr DeviceMemoryReportEventTypeEXT
    -> Int -> IO DeviceMemoryReportEventTypeEXT)
-> (Ptr DeviceMemoryReportEventTypeEXT
    -> Int -> DeviceMemoryReportEventTypeEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT)
-> (forall b.
    Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ())
-> (Ptr DeviceMemoryReportEventTypeEXT
    -> IO DeviceMemoryReportEventTypeEXT)
-> (Ptr DeviceMemoryReportEventTypeEXT
    -> DeviceMemoryReportEventTypeEXT -> IO ())
-> Storable DeviceMemoryReportEventTypeEXT
forall b. Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
forall b. Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
$cpoke :: Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
peek :: Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
$cpeek :: Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
pokeByteOff :: Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
peekByteOff :: Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
pokeElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
$cpokeElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
peekElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> IO DeviceMemoryReportEventTypeEXT
$cpeekElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> IO DeviceMemoryReportEventTypeEXT
alignment :: DeviceMemoryReportEventTypeEXT -> Int
$calignment :: DeviceMemoryReportEventTypeEXT -> Int
sizeOf :: DeviceMemoryReportEventTypeEXT -> Int
$csizeOf :: DeviceMemoryReportEventTypeEXT -> Int
Storable, DeviceMemoryReportEventTypeEXT
DeviceMemoryReportEventTypeEXT
-> Zero DeviceMemoryReportEventTypeEXT
forall a. a -> Zero a
zero :: DeviceMemoryReportEventTypeEXT
$czero :: DeviceMemoryReportEventTypeEXT
Zero)

-- | 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT' specifies this event
-- corresponds to the allocation of an internal device memory object or a
-- 'Vulkan.Core10.Handles.DeviceMemory'.
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT :: forall r.
DeviceMemoryReportEventTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT = DeviceMemoryReportEventTypeEXT 0
-- | 'DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT' specifies this event
-- corresponds to the deallocation of an internally-allocated device memory
-- object or a 'Vulkan.Core10.Handles.DeviceMemory'.
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT :: forall r.
DeviceMemoryReportEventTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT = DeviceMemoryReportEventTypeEXT 1
-- | 'DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT' specifies this event
-- corresponds to the import of an external memory object.
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT :: forall r.
DeviceMemoryReportEventTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT = DeviceMemoryReportEventTypeEXT 2
-- | 'DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT' specifies this event is
-- the release of an imported external memory object.
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT :: forall r.
DeviceMemoryReportEventTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT = DeviceMemoryReportEventTypeEXT 3
-- | 'DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT' specifies this
-- event corresponds to the failed allocation of an internal device memory
-- object or a 'Vulkan.Core10.Handles.DeviceMemory'.
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT :: forall r.
DeviceMemoryReportEventTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT = DeviceMemoryReportEventTypeEXT 4
{-# complete DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT,
             DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT,
             DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT,
             DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT,
             DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT :: DeviceMemoryReportEventTypeEXT #-}

instance Show DeviceMemoryReportEventTypeEXT where
  showsPrec :: Int -> DeviceMemoryReportEventTypeEXT -> ShowS
showsPrec p :: Int
p = \case
    DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT -> String -> ShowS
showString "DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT"
    DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT -> String -> ShowS
showString "DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT"
    DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT -> String -> ShowS
showString "DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT"
    DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT -> String -> ShowS
showString "DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT"
    DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT -> String -> ShowS
showString "DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT"
    DeviceMemoryReportEventTypeEXT x :: Int32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "DeviceMemoryReportEventTypeEXT " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Int32
x)

instance Read DeviceMemoryReportEventTypeEXT where
  readPrec :: ReadPrec DeviceMemoryReportEventTypeEXT
readPrec = ReadPrec DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec DeviceMemoryReportEventTypeEXT)]
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT", DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT)
                            , ("DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT", DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT)
                            , ("DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT", DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT)
                            , ("DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT", DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT)
                            , ("DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT", DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT)]
                     ReadPrec DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int
-> ReadPrec DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "DeviceMemoryReportEventTypeEXT")
                       Int32
v <- ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec
                       DeviceMemoryReportEventTypeEXT
-> ReadPrec DeviceMemoryReportEventTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> DeviceMemoryReportEventTypeEXT
DeviceMemoryReportEventTypeEXT Int32
v)))


type FN_vkDeviceMemoryReportCallbackEXT = ("pCallbackData" ::: Ptr DeviceMemoryReportCallbackDataEXT) -> ("pUserData" ::: Ptr ()) -> IO ()
-- | PFN_vkDeviceMemoryReportCallbackEXT - Application-defined device memory
-- report callback function
--
-- = Description
--
-- The callback /must/ not make calls to any Vulkan commands.
--
-- = See Also
--
-- 'DeviceDeviceMemoryReportCreateInfoEXT'
type PFN_vkDeviceMemoryReportCallbackEXT = FunPtr FN_vkDeviceMemoryReportCallbackEXT


type EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION"
pattern EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_DEVICE_MEMORY_REPORT_SPEC_VERSION :: a
$mEXT_DEVICE_MEMORY_REPORT_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION = 1


type EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME = "VK_EXT_device_memory_report"

-- No documentation found for TopLevel "VK_EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME"
pattern EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME :: a
$mEXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME = "VK_EXT_device_memory_report"