{-# language CPP #-}
-- No documentation found for Chapter "AllocationCallbacks"
module Vulkan.Core10.AllocationCallbacks  (AllocationCallbacks(..)) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Vulkan.Core10.FuncPointers (PFN_vkAllocationFunction)
import Vulkan.Core10.FuncPointers (PFN_vkFreeFunction)
import Vulkan.Core10.FuncPointers (PFN_vkInternalAllocationNotification)
import Vulkan.Core10.FuncPointers (PFN_vkInternalFreeNotification)
import Vulkan.Core10.FuncPointers (PFN_vkReallocationFunction)
-- | VkAllocationCallbacks - Structure containing callback function pointers
-- for memory allocation
--
-- == Valid Usage
--
-- -   #VUID-VkAllocationCallbacks-pfnAllocation-00632# @pfnAllocation@
--     /must/ be a valid pointer to a valid user-defined
--     'Vulkan.Core10.FuncPointers.PFN_vkAllocationFunction'
--
-- -   #VUID-VkAllocationCallbacks-pfnReallocation-00633# @pfnReallocation@
--     /must/ be a valid pointer to a valid user-defined
--     'Vulkan.Core10.FuncPointers.PFN_vkReallocationFunction'
--
-- -   #VUID-VkAllocationCallbacks-pfnFree-00634# @pfnFree@ /must/ be a
--     valid pointer to a valid user-defined
--     'Vulkan.Core10.FuncPointers.PFN_vkFreeFunction'
--
-- -   #VUID-VkAllocationCallbacks-pfnInternalAllocation-00635# If either
--     of @pfnInternalAllocation@ or @pfnInternalFree@ is not @NULL@, both
--     /must/ be valid callbacks
--
-- = See Also
--
-- 'Vulkan.Core10.FuncPointers.PFN_vkAllocationFunction',
-- 'Vulkan.Core10.FuncPointers.PFN_vkFreeFunction',
-- 'Vulkan.Core10.FuncPointers.PFN_vkInternalAllocationNotification',
-- 'Vulkan.Core10.FuncPointers.PFN_vkInternalFreeNotification',
-- 'Vulkan.Core10.FuncPointers.PFN_vkReallocationFunction',
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Memory.allocateMemory',
-- 'Vulkan.Extensions.VK_KHR_acceleration_structure.createAccelerationStructureKHR',
-- 'Vulkan.Extensions.VK_NV_ray_tracing.createAccelerationStructureNV',
-- 'Vulkan.Extensions.VK_KHR_android_surface.createAndroidSurfaceKHR',
-- 'Vulkan.Core10.Buffer.createBuffer',
-- 'Vulkan.Extensions.VK_FUCHSIA_buffer_collection.createBufferCollectionFUCHSIA',
-- 'Vulkan.Core10.BufferView.createBufferView',
-- 'Vulkan.Core10.CommandPool.createCommandPool',
-- 'Vulkan.Core10.Pipeline.createComputePipelines',
-- 'Vulkan.Extensions.VK_NVX_binary_import.createCuFunctionNVX',
-- 'Vulkan.Extensions.VK_NVX_binary_import.createCuModuleNVX',
-- 'Vulkan.Extensions.VK_EXT_debug_report.createDebugReportCallbackEXT',
-- 'Vulkan.Extensions.VK_EXT_debug_utils.createDebugUtilsMessengerEXT',
-- 'Vulkan.Extensions.VK_KHR_deferred_host_operations.createDeferredOperationKHR',
-- 'Vulkan.Core10.DescriptorSet.createDescriptorPool',
-- 'Vulkan.Core10.DescriptorSet.createDescriptorSetLayout',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_descriptor_update_template.createDescriptorUpdateTemplate',
-- 'Vulkan.Extensions.VK_KHR_descriptor_update_template.createDescriptorUpdateTemplateKHR',
-- 'Vulkan.Core10.Device.createDevice',
-- 'Vulkan.Extensions.VK_EXT_directfb_surface.createDirectFBSurfaceEXT',
-- 'Vulkan.Extensions.VK_KHR_display.createDisplayModeKHR',
-- 'Vulkan.Extensions.VK_KHR_display.createDisplayPlaneSurfaceKHR',
-- 'Vulkan.Core10.Event.createEvent', 'Vulkan.Core10.Fence.createFence',
-- 'Vulkan.Core10.Pass.createFramebuffer',
-- 'Vulkan.Core10.Pipeline.createGraphicsPipelines',
-- 'Vulkan.Extensions.VK_EXT_headless_surface.createHeadlessSurfaceEXT',
-- 'Vulkan.Extensions.VK_MVK_ios_surface.createIOSSurfaceMVK',
-- 'Vulkan.Core10.Image.createImage',
-- 'Vulkan.Extensions.VK_FUCHSIA_imagepipe_surface.createImagePipeSurfaceFUCHSIA',
-- 'Vulkan.Core10.ImageView.createImageView',
-- 'Vulkan.Extensions.VK_NV_device_generated_commands.createIndirectCommandsLayoutNV',
-- 'Vulkan.Core10.DeviceInitialization.createInstance',
-- 'Vulkan.Extensions.VK_MVK_macos_surface.createMacOSSurfaceMVK',
-- 'Vulkan.Extensions.VK_EXT_metal_surface.createMetalSurfaceEXT',
-- 'Vulkan.Extensions.VK_EXT_opacity_micromap.createMicromapEXT',
-- 'Vulkan.Extensions.VK_NV_optical_flow.createOpticalFlowSessionNV',
-- 'Vulkan.Core10.PipelineCache.createPipelineCache',
-- 'Vulkan.Core10.PipelineLayout.createPipelineLayout',
-- 'Vulkan.Core13.Promoted_From_VK_EXT_private_data.createPrivateDataSlot',
-- 'Vulkan.Extensions.VK_EXT_private_data.createPrivateDataSlotEXT',
-- 'Vulkan.Core10.Query.createQueryPool',
-- 'Vulkan.Extensions.VK_KHR_ray_tracing_pipeline.createRayTracingPipelinesKHR',
-- 'Vulkan.Extensions.VK_NV_ray_tracing.createRayTracingPipelinesNV',
-- 'Vulkan.Core10.Pass.createRenderPass',
-- 'Vulkan.Core12.Promoted_From_VK_KHR_create_renderpass2.createRenderPass2',
-- 'Vulkan.Extensions.VK_KHR_create_renderpass2.createRenderPass2KHR',
-- 'Vulkan.Core10.Sampler.createSampler',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.createSamplerYcbcrConversion',
-- 'Vulkan.Extensions.VK_KHR_sampler_ycbcr_conversion.createSamplerYcbcrConversionKHR',
-- 'Vulkan.Extensions.VK_QNX_screen_surface.createScreenSurfaceQNX',
-- 'Vulkan.Core10.QueueSemaphore.createSemaphore',
-- 'Vulkan.Core10.Shader.createShaderModule',
-- 'Vulkan.Extensions.VK_KHR_display_swapchain.createSharedSwapchainsKHR',
-- 'Vulkan.Extensions.VK_GGP_stream_descriptor_surface.createStreamDescriptorSurfaceGGP',
-- 'Vulkan.Extensions.VK_KHR_swapchain.createSwapchainKHR',
-- 'Vulkan.Extensions.VK_EXT_validation_cache.createValidationCacheEXT',
-- 'Vulkan.Extensions.VK_NN_vi_surface.createViSurfaceNN',
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCreateVideoSessionKHR vkCreateVideoSessionKHR>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCreateVideoSessionParametersKHR vkCreateVideoSessionParametersKHR>,
-- 'Vulkan.Extensions.VK_KHR_wayland_surface.createWaylandSurfaceKHR',
-- 'Vulkan.Extensions.VK_KHR_win32_surface.createWin32SurfaceKHR',
-- 'Vulkan.Extensions.VK_KHR_xcb_surface.createXcbSurfaceKHR',
-- 'Vulkan.Extensions.VK_KHR_xlib_surface.createXlibSurfaceKHR',
-- 'Vulkan.Extensions.VK_KHR_acceleration_structure.destroyAccelerationStructureKHR',
-- 'Vulkan.Extensions.VK_NV_ray_tracing.destroyAccelerationStructureNV',
-- 'Vulkan.Core10.Buffer.destroyBuffer',
-- 'Vulkan.Extensions.VK_FUCHSIA_buffer_collection.destroyBufferCollectionFUCHSIA',
-- 'Vulkan.Core10.BufferView.destroyBufferView',
-- 'Vulkan.Core10.CommandPool.destroyCommandPool',
-- 'Vulkan.Extensions.VK_NVX_binary_import.destroyCuFunctionNVX',
-- 'Vulkan.Extensions.VK_NVX_binary_import.destroyCuModuleNVX',
-- 'Vulkan.Extensions.VK_EXT_debug_report.destroyDebugReportCallbackEXT',
-- 'Vulkan.Extensions.VK_EXT_debug_utils.destroyDebugUtilsMessengerEXT',
-- 'Vulkan.Extensions.VK_KHR_deferred_host_operations.destroyDeferredOperationKHR',
-- 'Vulkan.Core10.DescriptorSet.destroyDescriptorPool',
-- 'Vulkan.Core10.DescriptorSet.destroyDescriptorSetLayout',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_descriptor_update_template.destroyDescriptorUpdateTemplate',
-- 'Vulkan.Extensions.VK_KHR_descriptor_update_template.destroyDescriptorUpdateTemplateKHR',
-- 'Vulkan.Core10.Device.destroyDevice',
-- 'Vulkan.Core10.Event.destroyEvent', 'Vulkan.Core10.Fence.destroyFence',
-- 'Vulkan.Core10.Pass.destroyFramebuffer',
-- 'Vulkan.Core10.Image.destroyImage',
-- 'Vulkan.Core10.ImageView.destroyImageView',
-- 'Vulkan.Extensions.VK_NV_device_generated_commands.destroyIndirectCommandsLayoutNV',
-- 'Vulkan.Core10.DeviceInitialization.destroyInstance',
-- 'Vulkan.Extensions.VK_EXT_opacity_micromap.destroyMicromapEXT',
-- 'Vulkan.Extensions.VK_NV_optical_flow.destroyOpticalFlowSessionNV',
-- 'Vulkan.Core10.Pipeline.destroyPipeline',
-- 'Vulkan.Core10.PipelineCache.destroyPipelineCache',
-- 'Vulkan.Core10.PipelineLayout.destroyPipelineLayout',
-- 'Vulkan.Core13.Promoted_From_VK_EXT_private_data.destroyPrivateDataSlot',
-- 'Vulkan.Extensions.VK_EXT_private_data.destroyPrivateDataSlotEXT',
-- 'Vulkan.Core10.Query.destroyQueryPool',
-- 'Vulkan.Core10.Pass.destroyRenderPass',
-- 'Vulkan.Core10.Sampler.destroySampler',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.destroySamplerYcbcrConversion',
-- 'Vulkan.Extensions.VK_KHR_sampler_ycbcr_conversion.destroySamplerYcbcrConversionKHR',
-- 'Vulkan.Core10.QueueSemaphore.destroySemaphore',
-- 'Vulkan.Core10.Shader.destroyShaderModule',
-- 'Vulkan.Extensions.VK_KHR_surface.destroySurfaceKHR',
-- 'Vulkan.Extensions.VK_KHR_swapchain.destroySwapchainKHR',
-- 'Vulkan.Extensions.VK_EXT_validation_cache.destroyValidationCacheEXT',
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkDestroyVideoSessionKHR vkDestroyVideoSessionKHR>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkDestroyVideoSessionParametersKHR vkDestroyVideoSessionParametersKHR>,
-- 'Vulkan.Core10.Memory.freeMemory',
-- 'Vulkan.Extensions.VK_EXT_display_control.registerDeviceEventEXT',
-- 'Vulkan.Extensions.VK_EXT_display_control.registerDisplayEventEXT'
data AllocationCallbacks = AllocationCallbacks
  { -- | @pUserData@ is a value to be interpreted by the implementation of the
    -- callbacks. When any of the callbacks in 'AllocationCallbacks' are
    -- called, the Vulkan implementation will pass this value as the first
    -- parameter to the callback. This value /can/ vary each time an allocator
    -- is passed into a command, even when the same object takes an allocator
    -- in multiple commands.
    AllocationCallbacks -> Ptr ()
userData :: Ptr ()
  , -- | @pfnAllocation@ is a
    -- 'Vulkan.Core10.FuncPointers.PFN_vkAllocationFunction' pointer to an
    -- application-defined memory allocation function.
    AllocationCallbacks -> PFN_vkAllocationFunction
pfnAllocation :: PFN_vkAllocationFunction
  , -- | @pfnReallocation@ is a
    -- 'Vulkan.Core10.FuncPointers.PFN_vkReallocationFunction' pointer to an
    -- application-defined memory reallocation function.
    AllocationCallbacks -> PFN_vkReallocationFunction
pfnReallocation :: PFN_vkReallocationFunction
  , -- | @pfnFree@ is a 'Vulkan.Core10.FuncPointers.PFN_vkFreeFunction' pointer
    -- to an application-defined memory free function.
    AllocationCallbacks -> PFN_vkFreeFunction
pfnFree :: PFN_vkFreeFunction
  , -- | @pfnInternalAllocation@ is a
    -- 'Vulkan.Core10.FuncPointers.PFN_vkInternalAllocationNotification'
    -- pointer to an application-defined function that is called by the
    -- implementation when the implementation makes internal allocations.
    AllocationCallbacks -> PFN_vkInternalAllocationNotification
pfnInternalAllocation :: PFN_vkInternalAllocationNotification
  , -- | @pfnInternalFree@ is a
    -- 'Vulkan.Core10.FuncPointers.PFN_vkInternalFreeNotification' pointer to
    -- an application-defined function that is called by the implementation
    -- when the implementation frees internal allocations.
    AllocationCallbacks -> PFN_vkInternalAllocationNotification
pfnInternalFree :: PFN_vkInternalFreeNotification
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AllocationCallbacks)
#endif
deriving instance Show AllocationCallbacks

instance ToCStruct AllocationCallbacks where
  withCStruct :: forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct AllocationCallbacks
x Ptr AllocationCallbacks -> IO b
f = Int -> (Ptr AllocationCallbacks -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr AllocationCallbacks -> IO b) -> IO b)
-> (Ptr AllocationCallbacks -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationCallbacks
p -> Ptr AllocationCallbacks -> AllocationCallbacks -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr AllocationCallbacks
p AllocationCallbacks
x (Ptr AllocationCallbacks -> IO b
f Ptr AllocationCallbacks
p)
  pokeCStruct :: forall b.
Ptr AllocationCallbacks -> AllocationCallbacks -> IO b -> IO b
pokeCStruct Ptr AllocationCallbacks
p AllocationCallbacks{Ptr ()
PFN_vkFreeFunction
PFN_vkReallocationFunction
PFN_vkAllocationFunction
PFN_vkInternalAllocationNotification
pfnInternalFree :: PFN_vkInternalAllocationNotification
pfnInternalAllocation :: PFN_vkInternalAllocationNotification
pfnFree :: PFN_vkFreeFunction
pfnReallocation :: PFN_vkReallocationFunction
pfnAllocation :: PFN_vkAllocationFunction
userData :: Ptr ()
$sel:pfnInternalFree:AllocationCallbacks :: AllocationCallbacks -> PFN_vkInternalAllocationNotification
$sel:pfnInternalAllocation:AllocationCallbacks :: AllocationCallbacks -> PFN_vkInternalAllocationNotification
$sel:pfnFree:AllocationCallbacks :: AllocationCallbacks -> PFN_vkFreeFunction
$sel:pfnReallocation:AllocationCallbacks :: AllocationCallbacks -> PFN_vkReallocationFunction
$sel:pfnAllocation:AllocationCallbacks :: AllocationCallbacks -> PFN_vkAllocationFunction
$sel:userData:AllocationCallbacks :: AllocationCallbacks -> Ptr ()
..} IO b
f = do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (Ptr ()))) (Ptr ()
userData)
    Ptr PFN_vkAllocationFunction -> PFN_vkAllocationFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkAllocationFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr PFN_vkAllocationFunction)) (PFN_vkAllocationFunction
pfnAllocation)
    Ptr PFN_vkReallocationFunction
-> PFN_vkReallocationFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkReallocationFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PFN_vkReallocationFunction)) (PFN_vkReallocationFunction
pfnReallocation)
    Ptr PFN_vkFreeFunction -> PFN_vkFreeFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkFreeFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PFN_vkFreeFunction)) (PFN_vkFreeFunction
pfnFree)
    Ptr PFN_vkInternalAllocationNotification
-> PFN_vkInternalAllocationNotification -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks
-> Int -> Ptr PFN_vkInternalAllocationNotification
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr PFN_vkInternalAllocationNotification)) (PFN_vkInternalAllocationNotification
pfnInternalAllocation)
    Ptr PFN_vkInternalAllocationNotification
-> PFN_vkInternalAllocationNotification -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks
-> Int -> Ptr PFN_vkInternalAllocationNotification
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr PFN_vkInternalFreeNotification)) (PFN_vkInternalAllocationNotification
pfnInternalFree)
    IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr AllocationCallbacks -> IO b -> IO b
pokeZeroCStruct Ptr AllocationCallbacks
p IO b
f = do
    Ptr PFN_vkAllocationFunction -> PFN_vkAllocationFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkAllocationFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr PFN_vkAllocationFunction)) (PFN_vkAllocationFunction
forall a. Zero a => a
zero)
    Ptr PFN_vkReallocationFunction
-> PFN_vkReallocationFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkReallocationFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PFN_vkReallocationFunction)) (PFN_vkReallocationFunction
forall a. Zero a => a
zero)
    Ptr PFN_vkFreeFunction -> PFN_vkFreeFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkFreeFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PFN_vkFreeFunction)) (PFN_vkFreeFunction
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct AllocationCallbacks where
  peekCStruct :: Ptr AllocationCallbacks -> IO AllocationCallbacks
peekCStruct Ptr AllocationCallbacks
p = do
    Ptr ()
pUserData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (Ptr ())))
    PFN_vkAllocationFunction
pfnAllocation <- forall a. Storable a => Ptr a -> IO a
peek @PFN_vkAllocationFunction ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkAllocationFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr PFN_vkAllocationFunction))
    PFN_vkReallocationFunction
pfnReallocation <- forall a. Storable a => Ptr a -> IO a
peek @PFN_vkReallocationFunction ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkReallocationFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PFN_vkReallocationFunction))
    PFN_vkFreeFunction
pfnFree <- forall a. Storable a => Ptr a -> IO a
peek @PFN_vkFreeFunction ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks -> Int -> Ptr PFN_vkFreeFunction
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PFN_vkFreeFunction))
    PFN_vkInternalAllocationNotification
pfnInternalAllocation <- forall a. Storable a => Ptr a -> IO a
peek @PFN_vkInternalAllocationNotification ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks
-> Int -> Ptr PFN_vkInternalAllocationNotification
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr PFN_vkInternalAllocationNotification))
    PFN_vkInternalAllocationNotification
pfnInternalFree <- forall a. Storable a => Ptr a -> IO a
peek @PFN_vkInternalFreeNotification ((Ptr AllocationCallbacks
p Ptr AllocationCallbacks
-> Int -> Ptr PFN_vkInternalAllocationNotification
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr PFN_vkInternalFreeNotification))
    AllocationCallbacks -> IO AllocationCallbacks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllocationCallbacks -> IO AllocationCallbacks)
-> AllocationCallbacks -> IO AllocationCallbacks
forall a b. (a -> b) -> a -> b
$ Ptr ()
-> PFN_vkAllocationFunction
-> PFN_vkReallocationFunction
-> PFN_vkFreeFunction
-> PFN_vkInternalAllocationNotification
-> PFN_vkInternalAllocationNotification
-> AllocationCallbacks
AllocationCallbacks
             Ptr ()
pUserData
             PFN_vkAllocationFunction
pfnAllocation
             PFN_vkReallocationFunction
pfnReallocation
             PFN_vkFreeFunction
pfnFree
             PFN_vkInternalAllocationNotification
pfnInternalAllocation
             PFN_vkInternalAllocationNotification
pfnInternalFree

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

instance Zero AllocationCallbacks where
  zero :: AllocationCallbacks
zero = Ptr ()
-> PFN_vkAllocationFunction
-> PFN_vkReallocationFunction
-> PFN_vkFreeFunction
-> PFN_vkInternalAllocationNotification
-> PFN_vkInternalAllocationNotification
-> AllocationCallbacks
AllocationCallbacks
           Ptr ()
forall a. Zero a => a
zero
           PFN_vkAllocationFunction
forall a. Zero a => a
zero
           PFN_vkReallocationFunction
forall a. Zero a => a
zero
           PFN_vkFreeFunction
forall a. Zero a => a
zero
           PFN_vkInternalAllocationNotification
forall a. Zero a => a
zero
           PFN_vkInternalAllocationNotification
forall a. Zero a => a
zero