{-# language CPP #-}
module Vulkan.Core10.DeviceInitialization  ( createInstance
                                           , withInstance
                                           , destroyInstance
                                           , enumeratePhysicalDevices
                                           , getDeviceProcAddr
                                           , getInstanceProcAddr
                                           , getPhysicalDeviceProperties
                                           , getPhysicalDeviceQueueFamilyProperties
                                           , getPhysicalDeviceMemoryProperties
                                           , getPhysicalDeviceFeatures
                                           , getPhysicalDeviceFormatProperties
                                           , getPhysicalDeviceImageFormatProperties
                                           , PhysicalDeviceProperties(..)
                                           , ApplicationInfo(..)
                                           , InstanceCreateInfo(..)
                                           , QueueFamilyProperties(..)
                                           , PhysicalDeviceMemoryProperties(..)
                                           , MemoryType(..)
                                           , MemoryHeap(..)
                                           , FormatProperties(..)
                                           , ImageFormatProperties(..)
                                           , PhysicalDeviceFeatures(..)
                                           , PhysicalDeviceSparseProperties(..)
                                           , PhysicalDeviceLimits(..)
                                           , Instance(..)
                                           , PhysicalDevice(..)
                                           , AllocationCallbacks(..)
                                           , InstanceCreateFlags(..)
                                           , ImageType(..)
                                           , ImageTiling(..)
                                           , InternalAllocationType(..)
                                           , SystemAllocationScope(..)
                                           , PhysicalDeviceType(..)
                                           , Format(..)
                                           , StructureType(..)
                                           , QueueFlagBits(..)
                                           , QueueFlags
                                           , MemoryPropertyFlagBits(..)
                                           , MemoryPropertyFlags
                                           , MemoryHeapFlagBits(..)
                                           , MemoryHeapFlags
                                           , ImageUsageFlagBits(..)
                                           , ImageUsageFlags
                                           , ImageCreateFlagBits(..)
                                           , ImageCreateFlags
                                           , FormatFeatureFlagBits(..)
                                           , FormatFeatureFlags
                                           , SampleCountFlagBits(..)
                                           , SampleCountFlags
                                           , FN_vkInternalAllocationNotification
                                           , PFN_vkInternalAllocationNotification
                                           , FN_vkInternalFreeNotification
                                           , PFN_vkInternalFreeNotification
                                           , FN_vkReallocationFunction
                                           , PFN_vkReallocationFunction
                                           , FN_vkAllocationFunction
                                           , PFN_vkAllocationFunction
                                           , FN_vkFreeFunction
                                           , PFN_vkFreeFunction
                                           , FN_vkVoidFunction
                                           , PFN_vkVoidFunction
                                           ) where

import Vulkan.CStruct.Utils (FixedArray)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import Foreign.Ptr (castFunPtr)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Foreign.C.Types (CChar(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(CFloat))
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Ptr (Ptr(Ptr))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Dynamic (getInstanceProcAddr')
import Vulkan.Dynamic (initInstanceCmds)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct.Extends (Chain)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_debug_report (DebugReportCallbackCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_debug_utils (DebugUtilsMessengerCreateInfoEXT)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceProcAddr))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.Format (Format(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling(..))
import Vulkan.Core10.Enums.ImageType (ImageType)
import Vulkan.Core10.Enums.ImageType (ImageType(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlagBits(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Core10.Handles (Instance)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Core10.Handles (Instance(Instance))
import Vulkan.Dynamic (InstanceCmds(pVkDestroyInstance))
import Vulkan.Dynamic (InstanceCmds(pVkEnumeratePhysicalDevices))
import Vulkan.Dynamic (InstanceCmds(pVkGetInstanceProcAddr))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceFeatures))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceFormatProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceImageFormatProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceMemoryProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceQueueFamilyProperties))
import Vulkan.Core10.Enums.InstanceCreateFlags (InstanceCreateFlags)
import Vulkan.Core10.Handles (Instance_T)
import Vulkan.Core10.APIConstants (MAX_MEMORY_HEAPS)
import Vulkan.Core10.APIConstants (MAX_MEMORY_TYPES)
import Vulkan.Core10.APIConstants (MAX_PHYSICAL_DEVICE_NAME_SIZE)
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlags)
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlags)
import Vulkan.Core10.FuncPointers (PFN_vkVoidFunction)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Enums.PhysicalDeviceType (PhysicalDeviceType)
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlags)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlags)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Core10.APIConstants (UUID_SIZE)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_features (ValidationFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_flags (ValidationFlagsEXT)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.APIConstants (pattern MAX_MEMORY_HEAPS)
import Vulkan.Core10.APIConstants (pattern MAX_MEMORY_TYPES)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_APPLICATION_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_INSTANCE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks(..))
import Vulkan.Core10.FuncPointers (FN_vkAllocationFunction)
import Vulkan.Core10.FuncPointers (FN_vkFreeFunction)
import Vulkan.Core10.FuncPointers (FN_vkInternalAllocationNotification)
import Vulkan.Core10.FuncPointers (FN_vkInternalFreeNotification)
import Vulkan.Core10.FuncPointers (FN_vkReallocationFunction)
import Vulkan.Core10.FuncPointers (FN_vkVoidFunction)
import Vulkan.Core10.Enums.Format (Format(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlagBits(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling(..))
import Vulkan.Core10.Enums.ImageType (ImageType(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlagBits(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Core10.Enums.InstanceCreateFlags (InstanceCreateFlags(..))
import Vulkan.Core10.Enums.InternalAllocationType (InternalAllocationType(..))
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlagBits(..))
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlags)
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlagBits(..))
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlags)
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)
import Vulkan.Core10.FuncPointers (PFN_vkVoidFunction)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Enums.PhysicalDeviceType (PhysicalDeviceType(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlagBits(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlags)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
import Vulkan.Core10.Enums.SystemAllocationScope (SystemAllocationScope(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateInstance
  :: FunPtr (Ptr (SomeStruct InstanceCreateInfo) -> Ptr AllocationCallbacks -> Ptr (Ptr Instance_T) -> IO Result) -> Ptr (SomeStruct InstanceCreateInfo) -> Ptr AllocationCallbacks -> Ptr (Ptr Instance_T) -> IO Result

-- | vkCreateInstance - Create a new Vulkan instance
--
-- = Description
--
-- 'createInstance' verifies that the requested layers exist. If not,
-- 'createInstance' will return
-- 'Vulkan.Core10.Enums.Result.ERROR_LAYER_NOT_PRESENT'. Next
-- 'createInstance' verifies that the requested extensions are supported
-- (e.g. in the implementation or in any enabled instance layer) and if any
-- requested extension is not supported, 'createInstance' /must/ return
-- 'Vulkan.Core10.Enums.Result.ERROR_EXTENSION_NOT_PRESENT'. After
-- verifying and enabling the instance layers and extensions the
-- 'Vulkan.Core10.Handles.Instance' object is created and returned to the
-- application. If a requested extension is only supported by a layer, both
-- the layer and the extension need to be specified at 'createInstance'
-- time for the creation to succeed.
--
-- == Valid Usage
--
-- -   All
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-extensions-extensiondependencies required extensions>
--     for each extension in the
--     'InstanceCreateInfo'::@ppEnabledExtensionNames@ list /must/ also be
--     present in that list
--
-- == Valid Usage (Implicit)
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'InstanceCreateInfo' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pInstance@ /must/ be a valid pointer to a
--     'Vulkan.Core10.Handles.Instance' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_LAYER_NOT_PRESENT'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_EXTENSION_NOT_PRESENT'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INCOMPATIBLE_DRIVER'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Instance', 'InstanceCreateInfo'
createInstance :: forall a io
                . (Extendss InstanceCreateInfo a, PokeChain a, MonadIO io)
               => -- | @pCreateInfo@ is a pointer to a 'InstanceCreateInfo' structure
                  -- controlling creation of the instance.
                  (InstanceCreateInfo a)
               -> -- | @pAllocator@ controls host memory allocation as described in the
                  -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                  -- chapter.
                  ("allocator" ::: Maybe AllocationCallbacks)
               -> io (Instance)
createInstance :: InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
createInstance createInfo :: InstanceCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO Instance -> io Instance
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Instance -> io Instance)
-> (ContT Instance IO Instance -> IO Instance)
-> ContT Instance IO Instance
-> io Instance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Instance IO Instance -> IO Instance
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Instance IO Instance -> io Instance)
-> ContT Instance IO Instance -> io Instance
forall a b. (a -> b) -> a -> b
$ do
  FunPtr
  (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pInstance" ::: Ptr (Ptr Instance_T))
   -> IO Result)
vkCreateInstancePtr <- IO
  (FunPtr
     (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pInstance" ::: Ptr (Ptr Instance_T))
      -> IO Result))
-> ContT
     Instance
     IO
     (FunPtr
        (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
         -> ("pAllocator" ::: Ptr AllocationCallbacks)
         -> ("pInstance" ::: Ptr (Ptr Instance_T))
         -> IO Result))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO
   (FunPtr
      (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
       -> ("pAllocator" ::: Ptr AllocationCallbacks)
       -> ("pInstance" ::: Ptr (Ptr Instance_T))
       -> IO Result))
 -> ContT
      Instance
      IO
      (FunPtr
         (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
          -> ("pAllocator" ::: Ptr AllocationCallbacks)
          -> ("pInstance" ::: Ptr (Ptr Instance_T))
          -> IO Result)))
-> IO
     (FunPtr
        (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
         -> ("pAllocator" ::: Ptr AllocationCallbacks)
         -> ("pInstance" ::: Ptr (Ptr Instance_T))
         -> IO Result))
-> ContT
     Instance
     IO
     (FunPtr
        (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
         -> ("pAllocator" ::: Ptr AllocationCallbacks)
         -> ("pInstance" ::: Ptr (Ptr Instance_T))
         -> IO Result))
forall a b. (a -> b) -> a -> b
$ FunPtr FN_vkVoidFunction
-> FunPtr
     (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pInstance" ::: Ptr (Ptr Instance_T))
      -> IO Result)
forall a b. FunPtr a -> FunPtr b
castFunPtr @_ @(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo)) -> ("pAllocator" ::: Ptr AllocationCallbacks) -> ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Result) (FunPtr FN_vkVoidFunction
 -> FunPtr
      (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
       -> ("pAllocator" ::: Ptr AllocationCallbacks)
       -> ("pInstance" ::: Ptr (Ptr Instance_T))
       -> IO Result))
-> IO (FunPtr FN_vkVoidFunction)
-> IO
     (FunPtr
        (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
         -> ("pAllocator" ::: Ptr AllocationCallbacks)
         -> ("pInstance" ::: Ptr (Ptr Instance_T))
         -> IO Result))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
getInstanceProcAddr' Ptr Instance_T
forall a. Ptr a
nullPtr (Addr# -> "pName" ::: Ptr CChar
forall a. Addr# -> Ptr a
Ptr "vkCreateInstance"#)
  IO () -> ContT Instance IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Instance IO ()) -> IO () -> ContT Instance IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pInstance" ::: Ptr (Ptr Instance_T))
   -> IO Result)
vkCreateInstancePtr FunPtr
  (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pInstance" ::: Ptr (Ptr Instance_T))
   -> IO Result)
-> FunPtr
     (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pInstance" ::: Ptr (Ptr Instance_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pInstance" ::: Ptr (Ptr Instance_T))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateInstance is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateInstance' :: ("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
vkCreateInstance' = FunPtr
  (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pInstance" ::: Ptr (Ptr Instance_T))
   -> IO Result)
-> ("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
mkVkCreateInstance FunPtr
  (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pInstance" ::: Ptr (Ptr Instance_T))
   -> IO Result)
vkCreateInstancePtr
  Ptr (InstanceCreateInfo a)
pCreateInfo <- ((Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance)
-> ContT Instance IO (Ptr (InstanceCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance)
 -> ContT Instance IO (Ptr (InstanceCreateInfo a)))
-> ((Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance)
-> ContT Instance IO (Ptr (InstanceCreateInfo a))
forall a b. (a -> b) -> a -> b
$ InstanceCreateInfo a
-> (Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (InstanceCreateInfo a
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
 -> IO Instance)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
  -> IO Instance)
 -> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
    -> IO Instance)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
-> IO Instance
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pInstance" ::: Ptr (Ptr Instance_T)
pPInstance <- ((("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
 -> IO Instance)
-> ContT Instance IO ("pInstance" ::: Ptr (Ptr Instance_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
  -> IO Instance)
 -> ContT Instance IO ("pInstance" ::: Ptr (Ptr Instance_T)))
-> ((("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
    -> IO Instance)
-> ContT Instance IO ("pInstance" ::: Ptr (Ptr Instance_T))
forall a b. (a -> b) -> a -> b
$ IO ("pInstance" ::: Ptr (Ptr Instance_T))
-> (("pInstance" ::: Ptr (Ptr Instance_T)) -> IO ())
-> (("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
-> IO Instance
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pInstance" ::: Ptr (Ptr Instance_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Instance_T) 8) ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Instance IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Instance IO Result)
-> IO Result -> ContT Instance IO Result
forall a b. (a -> b) -> a -> b
$ ("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
vkCreateInstance' (Ptr (InstanceCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (InstanceCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pInstance" ::: Ptr (Ptr Instance_T)
pPInstance)
  IO () -> ContT Instance IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Instance IO ()) -> IO () -> ContT Instance IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Ptr Instance_T
pInstance <- IO (Ptr Instance_T) -> ContT Instance IO (Ptr Instance_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Instance_T) -> ContT Instance IO (Ptr Instance_T))
-> IO (Ptr Instance_T) -> ContT Instance IO (Ptr Instance_T)
forall a b. (a -> b) -> a -> b
$ ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO (Ptr Instance_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Instance_T) "pInstance" ::: Ptr (Ptr Instance_T)
pPInstance
  Instance
pInstance' <- IO Instance -> ContT Instance IO Instance
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Instance -> ContT Instance IO Instance)
-> IO Instance -> ContT Instance IO Instance
forall a b. (a -> b) -> a -> b
$ (\h :: Ptr Instance_T
h -> Ptr Instance_T -> InstanceCmds -> Instance
Instance Ptr Instance_T
h (InstanceCmds -> Instance) -> IO InstanceCmds -> IO Instance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Instance_T -> IO InstanceCmds
initInstanceCmds Ptr Instance_T
h) Ptr Instance_T
pInstance
  Instance -> ContT Instance IO Instance
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instance -> ContT Instance IO Instance)
-> Instance -> ContT Instance IO Instance
forall a b. (a -> b) -> a -> b
$ (Instance
pInstance')

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createInstance' and 'destroyInstance'
--
-- To ensure that 'destroyInstance' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withInstance :: forall a io r . (Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) => InstanceCreateInfo a -> Maybe AllocationCallbacks -> (io (Instance) -> ((Instance) -> io ()) -> r) -> r
withInstance :: InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Instance -> (Instance -> io ()) -> r)
-> r
withInstance pCreateInfo :: InstanceCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io Instance -> (Instance -> io ()) -> r
b =
  io Instance -> (Instance -> io ()) -> r
b (InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
forall (a :: [*]) (io :: * -> *).
(Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) =>
InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
createInstance InstanceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(Instance
o0) -> Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyInstance Instance
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkDestroyInstance
  :: FunPtr (Ptr Instance_T -> Ptr AllocationCallbacks -> IO ()) -> Ptr Instance_T -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyInstance - Destroy an instance of Vulkan
--
-- == Valid Usage
--
-- -   All child objects created using @instance@ /must/ have been
--     destroyed prior to destroying @instance@
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @instance@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @instance@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   If @instance@ is not @NULL@, @instance@ /must/ be a valid
--     'Vulkan.Core10.Handles.Instance' handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- == Host Synchronization
--
-- -   Host access to @instance@ /must/ be externally synchronized
--
-- -   Host access to all 'Vulkan.Core10.Handles.PhysicalDevice' objects
--     enumerated from @instance@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Instance'
destroyInstance :: forall io
                 . (MonadIO io)
                => -- | @instance@ is the handle of the instance to destroy.
                   Instance
                -> -- | @pAllocator@ controls host memory allocation as described in the
                   -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                   -- chapter.
                   ("allocator" ::: Maybe AllocationCallbacks)
                -> io ()
destroyInstance :: Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyInstance instance' :: Instance
instance' allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyInstancePtr :: FunPtr
  (Ptr Instance_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyInstance (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr FunPtr
  (Ptr Instance_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
     (Ptr Instance_T
      -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroyInstance is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyInstance' :: Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyInstance' = FunPtr
  (Ptr Instance_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyInstance FunPtr
  (Ptr Instance_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyInstance' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkEnumeratePhysicalDevices
  :: FunPtr (Ptr Instance_T -> Ptr Word32 -> Ptr (Ptr PhysicalDevice_T) -> IO Result) -> Ptr Instance_T -> Ptr Word32 -> Ptr (Ptr PhysicalDevice_T) -> IO Result

-- | vkEnumeratePhysicalDevices - Enumerates the physical devices accessible
-- to a Vulkan instance
--
-- = Description
--
-- If @pPhysicalDevices@ is @NULL@, then the number of physical devices
-- available is returned in @pPhysicalDeviceCount@. Otherwise,
-- @pPhysicalDeviceCount@ /must/ point to a variable set by the user to the
-- number of elements in the @pPhysicalDevices@ array, and on return the
-- variable is overwritten with the number of handles actually written to
-- @pPhysicalDevices@. If @pPhysicalDeviceCount@ is less than the number of
-- physical devices available, at most @pPhysicalDeviceCount@ structures
-- will be written. If @pPhysicalDeviceCount@ is smaller than the number of
-- physical devices available, 'Vulkan.Core10.Enums.Result.INCOMPLETE' will
-- be returned instead of 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate
-- that not all the available physical devices were returned.
--
-- == Valid Usage (Implicit)
--
-- -   @instance@ /must/ be a valid 'Vulkan.Core10.Handles.Instance' handle
--
-- -   @pPhysicalDeviceCount@ /must/ be a valid pointer to a @uint32_t@
--     value
--
-- -   If the value referenced by @pPhysicalDeviceCount@ is not @0@, and
--     @pPhysicalDevices@ is not @NULL@, @pPhysicalDevices@ /must/ be a
--     valid pointer to an array of @pPhysicalDeviceCount@
--     'Vulkan.Core10.Handles.PhysicalDevice' handles
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Instance', 'Vulkan.Core10.Handles.PhysicalDevice'
enumeratePhysicalDevices :: forall io
                          . (MonadIO io)
                         => -- | @instance@ is a handle to a Vulkan instance previously created with
                            -- 'createInstance'.
                            Instance
                         -> io (Result, ("physicalDevices" ::: Vector PhysicalDevice))
enumeratePhysicalDevices :: Instance
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
enumeratePhysicalDevices instance' :: Instance
instance' = IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
 -> io (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> (ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice)
      IO
      (Result, "physicalDevices" ::: Vector PhysicalDevice)
    -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "physicalDevices" ::: Vector PhysicalDevice)
  IO
  (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "physicalDevices" ::: Vector PhysicalDevice)
   IO
   (Result, "physicalDevices" ::: Vector PhysicalDevice)
 -> io (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: InstanceCmds
cmds = Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance)
  let vkEnumeratePhysicalDevicesPtr :: FunPtr
  (Ptr Instance_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO Result)
vkEnumeratePhysicalDevicesPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("pPhysicalDeviceCount" ::: Ptr Word32)
      -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
      -> IO Result)
pVkEnumeratePhysicalDevices InstanceCmds
cmds
  IO ()
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ())
-> IO ()
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO Result)
vkEnumeratePhysicalDevicesPtr FunPtr
  (Ptr Instance_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("pPhysicalDeviceCount" ::: Ptr Word32)
      -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkEnumeratePhysicalDevices is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkEnumeratePhysicalDevices' :: Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
vkEnumeratePhysicalDevices' = FunPtr
  (Ptr Instance_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO Result)
-> Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
mkVkEnumeratePhysicalDevices FunPtr
  (Ptr Instance_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO Result)
vkEnumeratePhysicalDevicesPtr
  let instance'' :: Ptr Instance_T
instance'' = Instance -> Ptr Instance_T
instanceHandle (Instance
instance')
  "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount <- ((("pPhysicalDeviceCount" ::: Ptr Word32)
  -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
 -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     ("pPhysicalDeviceCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPhysicalDeviceCount" ::: Ptr Word32)
   -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
  -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice)
      IO
      ("pPhysicalDeviceCount" ::: Ptr Word32))
-> ((("pPhysicalDeviceCount" ::: Ptr Word32)
     -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
    -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     ("pPhysicalDeviceCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPhysicalDeviceCount" ::: Ptr Word32)
-> (("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ())
-> (("pPhysicalDeviceCount" ::: Ptr Word32)
    -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPhysicalDeviceCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result)
-> IO Result
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
vkEnumeratePhysicalDevices' Ptr Instance_T
instance'' ("pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount) ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
forall a. Ptr a
nullPtr)
  IO ()
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ())
-> IO ()
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pPhysicalDeviceCount <- IO Word32
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32)
-> IO Word32
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount
  "pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices <- ((("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
  -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
 -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
   -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
  -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice)
      IO
      ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)))
-> ((("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
     -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
    -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
forall a b. (a -> b) -> a -> b
$ IO ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)) -> IO ())
-> (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
    -> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr PhysicalDevice_T) ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result)
-> IO Result
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
vkEnumeratePhysicalDevices' Ptr Instance_T
instance'' ("pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount) ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices)
  IO ()
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ())
-> IO ()
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pPhysicalDeviceCount' <- IO Word32
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32)
-> IO Word32
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount
  "physicalDevices" ::: Vector PhysicalDevice
pPhysicalDevices' <- IO ("physicalDevices" ::: Vector PhysicalDevice)
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     ("physicalDevices" ::: Vector PhysicalDevice)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("physicalDevices" ::: Vector PhysicalDevice)
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice)
      IO
      ("physicalDevices" ::: Vector PhysicalDevice))
-> IO ("physicalDevices" ::: Vector PhysicalDevice)
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     ("physicalDevices" ::: Vector PhysicalDevice)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO PhysicalDevice)
-> IO ("physicalDevices" ::: Vector PhysicalDevice)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceCount')) (\i :: Int
i -> do
    Ptr PhysicalDevice_T
pPhysicalDevicesElem <- ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO (Ptr PhysicalDevice_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDevice_T) (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> Int -> "pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T)))
    PhysicalDevice -> IO PhysicalDevice
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDevice -> IO PhysicalDevice)
-> PhysicalDevice -> IO PhysicalDevice
forall a b. (a -> b) -> a -> b
$ (\h :: Ptr PhysicalDevice_T
h -> Ptr PhysicalDevice_T -> InstanceCmds -> PhysicalDevice
PhysicalDevice Ptr PhysicalDevice_T
h InstanceCmds
cmds ) Ptr PhysicalDevice_T
pPhysicalDevicesElem)
  (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "physicalDevices" ::: Vector PhysicalDevice)
 -> ContT
      (Result, "physicalDevices" ::: Vector PhysicalDevice)
      IO
      (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> ContT
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
     IO
     (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "physicalDevices" ::: Vector PhysicalDevice
pPhysicalDevices')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDeviceProcAddr
  :: FunPtr (Ptr Device_T -> Ptr CChar -> IO PFN_vkVoidFunction) -> Ptr Device_T -> Ptr CChar -> IO PFN_vkVoidFunction

-- | vkGetDeviceProcAddr - Return a function pointer for a command
--
-- = Parameters
--
-- The table below defines the various use cases for 'getDeviceProcAddr'
-- and expected return value for each case.
--
-- = Description
--
-- The returned function pointer is of type
-- 'Vulkan.Core10.FuncPointers.PFN_vkVoidFunction', and /must/ be cast to
-- the type of the command being queried before use. The function pointer
-- /must/ only be called with a dispatchable object (the first parameter)
-- that is @device@ or a child of @device@.
--
-- +----------------------+----------------------+-----------------------+
-- | @device@             | @pName@              | return value          |
-- +======================+======================+=======================+
-- | @NULL@               | *1                   | undefined             |
-- +----------------------+----------------------+-----------------------+
-- | invalid device       | *1                   | undefined             |
-- +----------------------+----------------------+-----------------------+
-- | device               | @NULL@               | undefined             |
-- +----------------------+----------------------+-----------------------+
-- | device               | core device-level    | fp2                   |
-- |                      | Vulkan command       |                       |
-- +----------------------+----------------------+-----------------------+
-- | device               | enabled extension    | fp2                   |
-- |                      | device-level         |                       |
-- |                      | commands             |                       |
-- +----------------------+----------------------+-----------------------+
-- | any other case, not  | @NULL@               |                       |
-- | covered above        |                      |                       |
-- +----------------------+----------------------+-----------------------+
--
-- 'getDeviceProcAddr' behavior
--
-- [1]
--     \"*\" means any representable value for the parameter (including
--     valid values, invalid values, and @NULL@).
--
-- [2]
--     The returned function pointer /must/ only be called with a
--     dispatchable object (the first parameter) that is @device@ or a
--     child of @device@ e.g. 'Vulkan.Core10.Handles.Device',
--     'Vulkan.Core10.Handles.Queue', or
--     'Vulkan.Core10.Handles.CommandBuffer'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FuncPointers.PFN_vkVoidFunction',
-- 'Vulkan.Core10.Handles.Device'
getDeviceProcAddr :: forall io
                   . (MonadIO io)
                  => -- | @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                     Device
                  -> -- | @pName@ /must/ be a null-terminated UTF-8 string
                     ("name" ::: ByteString)
                  -> io (PFN_vkVoidFunction)
getDeviceProcAddr :: Device -> ("name" ::: ByteString) -> io (FunPtr FN_vkVoidFunction)
getDeviceProcAddr device :: Device
device name :: "name" ::: ByteString
name = IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction))
-> (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
    -> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> IO (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
 -> io (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDeviceProcAddrPtr :: FunPtr
  (Ptr Device_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetDeviceProcAddrPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
pVkGetDeviceProcAddr (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (FunPtr FN_vkVoidFunction) IO ())
-> IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetDeviceProcAddrPtr FunPtr
  (Ptr Device_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> FunPtr
     (Ptr Device_T
      -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetDeviceProcAddr is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDeviceProcAddr' :: Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetDeviceProcAddr' = FunPtr
  (Ptr Device_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Ptr Device_T
-> ("pName" ::: Ptr CChar)
-> IO (FunPtr FN_vkVoidFunction)
mkVkGetDeviceProcAddr FunPtr
  (Ptr Device_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetDeviceProcAddrPtr
  "pName" ::: Ptr CChar
pName <- ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
 -> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
  -> IO (FunPtr FN_vkVoidFunction))
 -> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
    -> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
name)
  FunPtr FN_vkVoidFunction
r <- IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (FunPtr FN_vkVoidFunction)
 -> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetDeviceProcAddr' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pName" ::: Ptr CChar
pName
  FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunPtr FN_vkVoidFunction
 -> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ (FunPtr FN_vkVoidFunction
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetInstanceProcAddr
  :: FunPtr (Ptr Instance_T -> Ptr CChar -> IO PFN_vkVoidFunction) -> Ptr Instance_T -> Ptr CChar -> IO PFN_vkVoidFunction

-- | vkGetInstanceProcAddr - Return a function pointer for a command
--
-- = Description
--
-- 'getInstanceProcAddr' itself is obtained in a platform- and loader-
-- specific manner. Typically, the loader library will export this command
-- as a function symbol, so applications /can/ link against the loader
-- library, or load it dynamically and look up the symbol using
-- platform-specific APIs.
--
-- The table below defines the various use cases for 'getInstanceProcAddr'
-- and expected return value (“fp” is “function pointer”) for each case.
--
-- The returned function pointer is of type
-- 'Vulkan.Core10.FuncPointers.PFN_vkVoidFunction', and /must/ be cast to
-- the type of the command being queried before use.
--
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | @instance@           | @pName@                                                                 | return value          |
-- +======================+=========================================================================+=======================+
-- | *1                   | @NULL@                                                                  | undefined             |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | invalid non-@NULL@   | *1                                                                      | undefined             |
-- | instance             |                                                                         |                       |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | @NULL@               | 'getInstanceProcAddr'                                                   | fp4                   |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | @NULL@               | 'Vulkan.Core11.DeviceInitialization.enumerateInstanceVersion'           | fp                    |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | @NULL@               | 'Vulkan.Core10.ExtensionDiscovery.enumerateInstanceExtensionProperties' | fp                    |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | @NULL@               | 'Vulkan.Core10.LayerDiscovery.enumerateInstanceLayerProperties'         | fp                    |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | @NULL@               | 'createInstance'                                                        | fp                    |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | instance             | core Vulkan command                                                     | fp2                   |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | instance             | enabled instance extension commands for @instance@                      | fp2                   |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | instance             | available device extension3 commands for @instance@                     | fp2                   |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
-- | any other case, not  | @NULL@                                                                  |                       |
-- | covered above        |                                                                         |                       |
-- +----------------------+-------------------------------------------------------------------------+-----------------------+
--
-- 'getInstanceProcAddr' behavior
--
-- [1]
--     \"*\" means any representable value for the parameter (including
--     valid values, invalid values, and @NULL@).
--
-- [2]
--     The returned function pointer /must/ only be called with a
--     dispatchable object (the first parameter) that is @instance@ or a
--     child of @instance@, e.g. 'Vulkan.Core10.Handles.Instance',
--     'Vulkan.Core10.Handles.PhysicalDevice',
--     'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Queue', or
--     'Vulkan.Core10.Handles.CommandBuffer'.
--
-- [3]
--     An “available device extension” is a device extension supported by
--     any physical device enumerated by @instance@.
--
-- [4]
--     Starting with Vulkan 1.2, 'getInstanceProcAddr' can resolve itself
--     with a @NULL@ instance pointer.
--
-- == Valid Usage (Implicit)
--
-- -   If @instance@ is not @NULL@, @instance@ /must/ be a valid
--     'Vulkan.Core10.Handles.Instance' handle
--
-- -   @pName@ /must/ be a null-terminated UTF-8 string
--
-- = See Also
--
-- 'Vulkan.Core10.FuncPointers.PFN_vkVoidFunction',
-- 'Vulkan.Core10.Handles.Instance'
getInstanceProcAddr :: forall io
                     . (MonadIO io)
                    => -- | @instance@ is the instance that the function pointer will be compatible
                       -- with, or @NULL@ for commands not dependent on any instance.
                       Instance
                    -> -- | @pName@ is the name of the command to obtain.
                       ("name" ::: ByteString)
                    -> io (PFN_vkVoidFunction)
getInstanceProcAddr :: Instance
-> ("name" ::: ByteString) -> io (FunPtr FN_vkVoidFunction)
getInstanceProcAddr instance' :: Instance
instance' name :: "name" ::: ByteString
name = IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction))
-> (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
    -> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> IO (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
 -> io (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetInstanceProcAddrPtr :: FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetInstanceProcAddrPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
pVkGetInstanceProcAddr (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (FunPtr FN_vkVoidFunction) IO ())
-> IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetInstanceProcAddrPtr FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> FunPtr
     (Ptr Instance_T
      -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetInstanceProcAddr is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetInstanceProcAddr' :: Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetInstanceProcAddr' = FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Ptr Instance_T
-> ("pName" ::: Ptr CChar)
-> IO (FunPtr FN_vkVoidFunction)
mkVkGetInstanceProcAddr FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetInstanceProcAddrPtr
  "pName" ::: Ptr CChar
pName <- ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
 -> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
  -> IO (FunPtr FN_vkVoidFunction))
 -> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
    -> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
name)
  FunPtr FN_vkVoidFunction
r <- IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (FunPtr FN_vkVoidFunction)
 -> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetInstanceProcAddr' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "pName" ::: Ptr CChar
pName
  FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunPtr FN_vkVoidFunction
 -> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ (FunPtr FN_vkVoidFunction
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr PhysicalDeviceProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr PhysicalDeviceProperties -> IO ()

-- | vkGetPhysicalDeviceProperties - Returns properties of a physical device
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.PhysicalDevice', 'PhysicalDeviceProperties'
getPhysicalDeviceProperties :: forall io
                             . (MonadIO io)
                            => -- | @physicalDevice@ is the handle to the physical device whose properties
                               -- will be queried.
                               --
                               -- @physicalDevice@ /must/ be a valid
                               -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                               PhysicalDevice
                            -> io (PhysicalDeviceProperties)
getPhysicalDeviceProperties :: PhysicalDevice -> io PhysicalDeviceProperties
getPhysicalDeviceProperties physicalDevice :: PhysicalDevice
physicalDevice = IO PhysicalDeviceProperties -> io PhysicalDeviceProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PhysicalDeviceProperties -> io PhysicalDeviceProperties)
-> (ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
    -> IO PhysicalDeviceProperties)
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> io PhysicalDeviceProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> IO PhysicalDeviceProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
 -> io PhysicalDeviceProperties)
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> io PhysicalDeviceProperties
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDevicePropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
pVkGetPhysicalDeviceProperties (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO () -> ContT PhysicalDeviceProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceProperties IO ())
-> IO () -> ContT PhysicalDeviceProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceProperties' :: Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ()
vkGetPhysicalDeviceProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
-> Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO ()
mkVkGetPhysicalDeviceProperties FunPtr
  (Ptr PhysicalDevice_T
   -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr
  "pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties <- ((("pProperties" ::: Ptr PhysicalDeviceProperties)
  -> IO PhysicalDeviceProperties)
 -> IO PhysicalDeviceProperties)
-> ContT
     PhysicalDeviceProperties
     IO
     ("pProperties" ::: Ptr PhysicalDeviceProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct PhysicalDeviceProperties =>
(("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceProperties)
  IO () -> ContT PhysicalDeviceProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceProperties IO ())
-> IO () -> ContT PhysicalDeviceProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ()
vkGetPhysicalDeviceProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) ("pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties)
  PhysicalDeviceProperties
pProperties <- IO PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PhysicalDeviceProperties
 -> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceProperties "pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties
  PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceProperties
 -> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties)
-> PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall a b. (a -> b) -> a -> b
$ (PhysicalDeviceProperties
pProperties)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceQueueFamilyProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr QueueFamilyProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr QueueFamilyProperties -> IO ()

-- | vkGetPhysicalDeviceQueueFamilyProperties - Reports properties of the
-- queues of the specified physical device
--
-- = Description
--
-- If @pQueueFamilyProperties@ is @NULL@, then the number of queue families
-- available is returned in @pQueueFamilyPropertyCount@. Implementations
-- /must/ support at least one queue family. Otherwise,
-- @pQueueFamilyPropertyCount@ /must/ point to a variable set by the user
-- to the number of elements in the @pQueueFamilyProperties@ array, and on
-- return the variable is overwritten with the number of structures
-- actually written to @pQueueFamilyProperties@. If
-- @pQueueFamilyPropertyCount@ is less than the number of queue families
-- available, at most @pQueueFamilyPropertyCount@ structures will be
-- written.
--
-- == Valid Usage (Implicit)
--
-- -   @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   @pQueueFamilyPropertyCount@ /must/ be a valid pointer to a
--     @uint32_t@ value
--
-- -   If the value referenced by @pQueueFamilyPropertyCount@ is not @0@,
--     and @pQueueFamilyProperties@ is not @NULL@, @pQueueFamilyProperties@
--     /must/ be a valid pointer to an array of @pQueueFamilyPropertyCount@
--     'QueueFamilyProperties' structures
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.PhysicalDevice', 'QueueFamilyProperties'
getPhysicalDeviceQueueFamilyProperties :: forall io
                                        . (MonadIO io)
                                       => -- | @physicalDevice@ is the handle to the physical device whose properties
                                          -- will be queried.
                                          PhysicalDevice
                                       -> io (("queueFamilyProperties" ::: Vector QueueFamilyProperties))
getPhysicalDeviceQueueFamilyProperties :: PhysicalDevice
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
getPhysicalDeviceQueueFamilyProperties physicalDevice :: PhysicalDevice
physicalDevice = IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
 -> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> (ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
  IO
  ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
   IO
   ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
 -> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceQueueFamilyPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPhysicalDeviceCount" ::: Ptr Word32)
      -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
      -> IO ())
pVkGetPhysicalDeviceQueueFamilyProperties (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO ()
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> IO ()
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPhysicalDeviceCount" ::: Ptr Word32)
      -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceQueueFamilyProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceQueueFamilyProperties' :: Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ())
-> Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
mkVkGetPhysicalDeviceQueueFamilyProperties FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPhysicalDeviceCount" ::: Ptr Word32)
   -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount <- ((("pPhysicalDeviceCount" ::: Ptr Word32)
  -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
 -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("pPhysicalDeviceCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPhysicalDeviceCount" ::: Ptr Word32)
   -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
  -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      ("pPhysicalDeviceCount" ::: Ptr Word32))
-> ((("pPhysicalDeviceCount" ::: Ptr Word32)
     -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("pPhysicalDeviceCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPhysicalDeviceCount" ::: Ptr Word32)
-> (("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ())
-> (("pPhysicalDeviceCount" ::: Ptr Word32)
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPhysicalDeviceCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  IO ()
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> IO ()
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties' Ptr PhysicalDevice_T
physicalDevice' ("pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount) ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
forall a. Ptr a
nullPtr)
  Word32
pQueueFamilyPropertyCount <- IO Word32
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      Word32)
-> IO Word32
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount
  "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties <- ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
  -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
 -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
   -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
  -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties))
-> ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
     -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ IO ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
    -> IO ())
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
forall a. Int -> IO (Ptr a)
callocBytes @QueueFamilyProperties ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 24)) ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> [Int]
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\i :: Int
i -> ((()
  -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
 -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
   -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
  -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> ((()
     -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 24) :: Ptr QueueFamilyProperties) (IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
 -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ((()
     -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> (()
    -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
 -> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ ())) [0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
  IO ()
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> IO ()
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties' Ptr PhysicalDevice_T
physicalDevice' ("pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount) (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties))
  Word32
pQueueFamilyPropertyCount' <- IO Word32
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      Word32)
-> IO Word32
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount
  "queueFamilyProperties" ::: Vector QueueFamilyProperties
pQueueFamilyProperties' <- IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount')) (\i :: Int
i -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO QueueFamilyProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @QueueFamilyProperties ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties) ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr QueueFamilyProperties)))
  ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("queueFamilyProperties" ::: Vector QueueFamilyProperties)
 -> ContT
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
      IO
      ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
     IO
     ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ ("queueFamilyProperties" ::: Vector QueueFamilyProperties
pQueueFamilyProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceMemoryProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr PhysicalDeviceMemoryProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr PhysicalDeviceMemoryProperties -> IO ()

-- | vkGetPhysicalDeviceMemoryProperties - Reports memory information for the
-- specified physical device
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.PhysicalDevice', 'PhysicalDeviceMemoryProperties'
getPhysicalDeviceMemoryProperties :: forall io
                                   . (MonadIO io)
                                  => -- | @physicalDevice@ is the handle to the device to query.
                                     --
                                     -- @physicalDevice@ /must/ be a valid
                                     -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                                     PhysicalDevice
                                  -> io (PhysicalDeviceMemoryProperties)
getPhysicalDeviceMemoryProperties :: PhysicalDevice -> io PhysicalDeviceMemoryProperties
getPhysicalDeviceMemoryProperties physicalDevice :: PhysicalDevice
physicalDevice = IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PhysicalDeviceMemoryProperties
 -> io PhysicalDeviceMemoryProperties)
-> (ContT
      PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
    -> IO PhysicalDeviceMemoryProperties)
-> ContT
     PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> IO PhysicalDeviceMemoryProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
 -> io PhysicalDeviceMemoryProperties)
-> ContT
     PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceMemoryPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
   -> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
      -> IO ())
pVkGetPhysicalDeviceMemoryProperties (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceMemoryProperties IO ())
-> IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
   -> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
   -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceMemoryProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceMemoryProperties' :: Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
vkGetPhysicalDeviceMemoryProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
   -> IO ())
-> Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
mkVkGetPhysicalDeviceMemoryProperties FunPtr
  (Ptr PhysicalDevice_T
   -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
   -> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr
  "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties <- ((("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
  -> IO PhysicalDeviceMemoryProperties)
 -> IO PhysicalDeviceMemoryProperties)
-> ContT
     PhysicalDeviceMemoryProperties
     IO
     ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct PhysicalDeviceMemoryProperties =>
(("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
 -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceMemoryProperties)
  IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceMemoryProperties IO ())
-> IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
vkGetPhysicalDeviceMemoryProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties)
  PhysicalDeviceMemoryProperties
pMemoryProperties <- IO PhysicalDeviceMemoryProperties
-> ContT
     PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PhysicalDeviceMemoryProperties
 -> ContT
      PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
-> ContT
     PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall a b. (a -> b) -> a -> b
$ ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceMemoryProperties "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties
  PhysicalDeviceMemoryProperties
-> ContT
     PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceMemoryProperties
 -> ContT
      PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties
-> ContT
     PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall a b. (a -> b) -> a -> b
$ (PhysicalDeviceMemoryProperties
pMemoryProperties)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceFeatures
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr PhysicalDeviceFeatures -> IO ()) -> Ptr PhysicalDevice_T -> Ptr PhysicalDeviceFeatures -> IO ()

-- | vkGetPhysicalDeviceFeatures - Reports capabilities of a physical device
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.PhysicalDevice', 'PhysicalDeviceFeatures'
getPhysicalDeviceFeatures :: forall io
                           . (MonadIO io)
                          => -- | @physicalDevice@ is the physical device from which to query the
                             -- supported features.
                             --
                             -- @physicalDevice@ /must/ be a valid
                             -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                             PhysicalDevice
                          -> io (PhysicalDeviceFeatures)
getPhysicalDeviceFeatures :: PhysicalDevice -> io PhysicalDeviceFeatures
getPhysicalDeviceFeatures physicalDevice :: PhysicalDevice
physicalDevice = IO PhysicalDeviceFeatures -> io PhysicalDeviceFeatures
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PhysicalDeviceFeatures -> io PhysicalDeviceFeatures)
-> (ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
    -> IO PhysicalDeviceFeatures)
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> io PhysicalDeviceFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> IO PhysicalDeviceFeatures
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
 -> io PhysicalDeviceFeatures)
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> io PhysicalDeviceFeatures
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceFeaturesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
pVkGetPhysicalDeviceFeatures (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO () -> ContT PhysicalDeviceFeatures IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceFeatures IO ())
-> IO () -> ContT PhysicalDeviceFeatures IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceFeatures is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceFeatures' :: Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ()
vkGetPhysicalDeviceFeatures' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
-> Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO ()
mkVkGetPhysicalDeviceFeatures FunPtr
  (Ptr PhysicalDevice_T
   -> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr
  "pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures <- ((("pFeatures" ::: Ptr PhysicalDeviceFeatures)
  -> IO PhysicalDeviceFeatures)
 -> IO PhysicalDeviceFeatures)
-> ContT
     PhysicalDeviceFeatures
     IO
     ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct PhysicalDeviceFeatures =>
(("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceFeatures)
  IO () -> ContT PhysicalDeviceFeatures IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceFeatures IO ())
-> IO () -> ContT PhysicalDeviceFeatures IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ()
vkGetPhysicalDeviceFeatures' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) ("pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures)
  PhysicalDeviceFeatures
pFeatures <- IO PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PhysicalDeviceFeatures
 -> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall a b. (a -> b) -> a -> b
$ ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceFeatures "pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures
  PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceFeatures
 -> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures)
-> PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall a b. (a -> b) -> a -> b
$ (PhysicalDeviceFeatures
pFeatures)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceFormatProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Format -> Ptr FormatProperties -> IO ()) -> Ptr PhysicalDevice_T -> Format -> Ptr FormatProperties -> IO ()

-- | vkGetPhysicalDeviceFormatProperties - Lists physical device’s format
-- capabilities
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.Format.Format', 'FormatProperties',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
getPhysicalDeviceFormatProperties :: forall io
                                   . (MonadIO io)
                                  => -- | @physicalDevice@ is the physical device from which to query the format
                                     -- properties.
                                     --
                                     -- @physicalDevice@ /must/ be a valid
                                     -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                                     PhysicalDevice
                                  -> -- | @format@ is the format whose properties are queried.
                                     --
                                     -- @format@ /must/ be a valid 'Vulkan.Core10.Enums.Format.Format' value
                                     Format
                                  -> io (FormatProperties)
getPhysicalDeviceFormatProperties :: PhysicalDevice -> Format -> io FormatProperties
getPhysicalDeviceFormatProperties physicalDevice :: PhysicalDevice
physicalDevice format :: Format
format = IO FormatProperties -> io FormatProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormatProperties -> io FormatProperties)
-> (ContT FormatProperties IO FormatProperties
    -> IO FormatProperties)
-> ContT FormatProperties IO FormatProperties
-> io FormatProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT FormatProperties IO FormatProperties -> IO FormatProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT FormatProperties IO FormatProperties -> io FormatProperties)
-> ContT FormatProperties IO FormatProperties
-> io FormatProperties
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceFormatPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ("pFormatProperties" ::: Ptr FormatProperties)
   -> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Format
      -> ("pFormatProperties" ::: Ptr FormatProperties)
      -> IO ())
pVkGetPhysicalDeviceFormatProperties (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO () -> ContT FormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT FormatProperties IO ())
-> IO () -> ContT FormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ("pFormatProperties" ::: Ptr FormatProperties)
   -> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ("pFormatProperties" ::: Ptr FormatProperties)
   -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Format
      -> ("pFormatProperties" ::: Ptr FormatProperties)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ("pFormatProperties" ::: Ptr FormatProperties)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceFormatProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceFormatProperties' :: Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
vkGetPhysicalDeviceFormatProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ("pFormatProperties" ::: Ptr FormatProperties)
   -> IO ())
-> Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
mkVkGetPhysicalDeviceFormatProperties FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ("pFormatProperties" ::: Ptr FormatProperties)
   -> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr
  "pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties <- ((("pFormatProperties" ::: Ptr FormatProperties)
  -> IO FormatProperties)
 -> IO FormatProperties)
-> ContT
     FormatProperties IO ("pFormatProperties" ::: Ptr FormatProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct FormatProperties =>
(("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @FormatProperties)
  IO () -> ContT FormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT FormatProperties IO ())
-> IO () -> ContT FormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
vkGetPhysicalDeviceFormatProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (Format
format) ("pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties)
  FormatProperties
pFormatProperties <- IO FormatProperties -> ContT FormatProperties IO FormatProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FormatProperties -> ContT FormatProperties IO FormatProperties)
-> IO FormatProperties
-> ContT FormatProperties IO FormatProperties
forall a b. (a -> b) -> a -> b
$ ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @FormatProperties "pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties
  FormatProperties -> ContT FormatProperties IO FormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatProperties -> ContT FormatProperties IO FormatProperties)
-> FormatProperties -> ContT FormatProperties IO FormatProperties
forall a b. (a -> b) -> a -> b
$ (FormatProperties
pFormatProperties)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceImageFormatProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Format -> ImageType -> ImageTiling -> ImageUsageFlags -> ImageCreateFlags -> Ptr ImageFormatProperties -> IO Result) -> Ptr PhysicalDevice_T -> Format -> ImageType -> ImageTiling -> ImageUsageFlags -> ImageCreateFlags -> Ptr ImageFormatProperties -> IO Result

-- | vkGetPhysicalDeviceImageFormatProperties - Lists physical device’s image
-- format capabilities
--
-- = Description
--
-- The @format@, @type@, @tiling@, @usage@, and @flags@ parameters
-- correspond to parameters that would be consumed by
-- 'Vulkan.Core10.Image.createImage' (as members of
-- 'Vulkan.Core10.Image.ImageCreateInfo').
--
-- If @format@ is not a supported image format, or if the combination of
-- @format@, @type@, @tiling@, @usage@, and @flags@ is not supported for
-- images, then 'getPhysicalDeviceImageFormatProperties' returns
-- 'Vulkan.Core10.Enums.Result.ERROR_FORMAT_NOT_SUPPORTED'.
--
-- The limitations on an image format that are reported by
-- 'getPhysicalDeviceImageFormatProperties' have the following property: if
-- @usage1@ and @usage2@ of type
-- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlags' are such that
-- the bits set in @usage1@ are a subset of the bits set in @usage2@, and
-- @flags1@ and @flags2@ of type
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlags' are such that
-- the bits set in @flags1@ are a subset of the bits set in @flags2@, then
-- the limitations for @usage1@ and @flags1@ /must/ be no more strict than
-- the limitations for @usage2@ and @flags2@, for all values of @format@,
-- @type@, and @tiling@.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_FORMAT_NOT_SUPPORTED'
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlags',
-- 'ImageFormatProperties', 'Vulkan.Core10.Enums.ImageTiling.ImageTiling',
-- 'Vulkan.Core10.Enums.ImageType.ImageType',
-- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlags',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
getPhysicalDeviceImageFormatProperties :: forall io
                                        . (MonadIO io)
                                       => -- | @physicalDevice@ is the physical device from which to query the image
                                          -- capabilities.
                                          --
                                          -- @physicalDevice@ /must/ be a valid
                                          -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                                          PhysicalDevice
                                       -> -- | @format@ is a 'Vulkan.Core10.Enums.Format.Format' value specifying the
                                          -- image format, corresponding to
                                          -- 'Vulkan.Core10.Image.ImageCreateInfo'::@format@.
                                          --
                                          -- @format@ /must/ be a valid 'Vulkan.Core10.Enums.Format.Format' value
                                          Format
                                       -> -- | @type@ is a 'Vulkan.Core10.Enums.ImageType.ImageType' value specifying
                                          -- the image type, corresponding to
                                          -- 'Vulkan.Core10.Image.ImageCreateInfo'::@imageType@.
                                          --
                                          -- @type@ /must/ be a valid 'Vulkan.Core10.Enums.ImageType.ImageType' value
                                          ImageType
                                       -> -- | @tiling@ is a 'Vulkan.Core10.Enums.ImageTiling.ImageTiling' value
                                          -- specifying the image tiling, corresponding to
                                          -- 'Vulkan.Core10.Image.ImageCreateInfo'::@tiling@.
                                          --
                                          -- @tiling@ /must/ not be
                                          -- 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_DRM_FORMAT_MODIFIER_EXT'.
                                          -- (Use
                                          -- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
                                          -- instead)
                                          --
                                          -- @tiling@ /must/ be a valid 'Vulkan.Core10.Enums.ImageTiling.ImageTiling'
                                          -- value
                                          ImageTiling
                                       -> -- | @usage@ is a bitmask of
                                          -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits' specifying
                                          -- the intended usage of the image, corresponding to
                                          -- 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@.
                                          --
                                          -- @usage@ /must/ be a valid combination of
                                          -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits' values
                                          --
                                          -- @usage@ /must/ not be @0@
                                          ImageUsageFlags
                                       -> -- | @flags@ is a bitmask of
                                          -- 'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlagBits' specifying
                                          -- additional parameters of the image, corresponding to
                                          -- 'Vulkan.Core10.Image.ImageCreateInfo'::@flags@.
                                          --
                                          -- @flags@ /must/ be a valid combination of
                                          -- 'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlagBits' values
                                          ImageCreateFlags
                                       -> io (ImageFormatProperties)
getPhysicalDeviceImageFormatProperties :: PhysicalDevice
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> io ImageFormatProperties
getPhysicalDeviceImageFormatProperties physicalDevice :: PhysicalDevice
physicalDevice format :: Format
format type' :: ImageType
type' tiling :: ImageTiling
tiling usage :: ImageUsageFlags
usage flags :: ImageCreateFlags
flags = IO ImageFormatProperties -> io ImageFormatProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImageFormatProperties -> io ImageFormatProperties)
-> (ContT ImageFormatProperties IO ImageFormatProperties
    -> IO ImageFormatProperties)
-> ContT ImageFormatProperties IO ImageFormatProperties
-> io ImageFormatProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ImageFormatProperties IO ImageFormatProperties
-> IO ImageFormatProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ImageFormatProperties IO ImageFormatProperties
 -> io ImageFormatProperties)
-> ContT ImageFormatProperties IO ImageFormatProperties
-> io ImageFormatProperties
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceImageFormatPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ImageTiling
   -> ImageUsageFlags
   -> ImageCreateFlags
   -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
   -> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Format
      -> ImageType
      -> ImageTiling
      -> ImageUsageFlags
      -> ImageCreateFlags
      -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
      -> IO Result)
pVkGetPhysicalDeviceImageFormatProperties (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO () -> ContT ImageFormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageFormatProperties IO ())
-> IO () -> ContT ImageFormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ImageTiling
   -> ImageUsageFlags
   -> ImageCreateFlags
   -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
   -> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ImageTiling
   -> ImageUsageFlags
   -> ImageCreateFlags
   -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Format
      -> ImageType
      -> ImageTiling
      -> ImageUsageFlags
      -> ImageCreateFlags
      -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ImageTiling
   -> ImageUsageFlags
   -> ImageCreateFlags
   -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceImageFormatProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceImageFormatProperties' :: Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result
vkGetPhysicalDeviceImageFormatProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ImageTiling
   -> ImageUsageFlags
   -> ImageCreateFlags
   -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result
mkVkGetPhysicalDeviceImageFormatProperties FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ImageTiling
   -> ImageUsageFlags
   -> ImageCreateFlags
   -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
   -> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr
  "pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties <- ((("pImageFormatProperties" ::: Ptr ImageFormatProperties)
  -> IO ImageFormatProperties)
 -> IO ImageFormatProperties)
-> ContT
     ImageFormatProperties
     IO
     ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ImageFormatProperties =>
(("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ImageFormatProperties)
  Result
r <- IO Result -> ContT ImageFormatProperties IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ImageFormatProperties IO Result)
-> IO Result -> ContT ImageFormatProperties IO Result
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result
vkGetPhysicalDeviceImageFormatProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (Format
format) (ImageType
type') (ImageTiling
tiling) (ImageUsageFlags
usage) (ImageCreateFlags
flags) ("pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties)
  IO () -> ContT ImageFormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageFormatProperties IO ())
-> IO () -> ContT ImageFormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  ImageFormatProperties
pImageFormatProperties <- IO ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ImageFormatProperties
 -> ContT ImageFormatProperties IO ImageFormatProperties)
-> IO ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall a b. (a -> b) -> a -> b
$ ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageFormatProperties "pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties
  ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageFormatProperties
 -> ContT ImageFormatProperties IO ImageFormatProperties)
-> ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall a b. (a -> b) -> a -> b
$ (ImageFormatProperties
pImageFormatProperties)


-- | VkPhysicalDeviceProperties - Structure specifying physical device
-- properties
--
-- = Description
--
-- Note
--
-- The value of @apiVersion@ /may/ be different than the version returned
-- by 'Vulkan.Core11.DeviceInitialization.enumerateInstanceVersion'; either
-- higher or lower. In such cases, the application /must/ not use
-- functionality that exceeds the version of Vulkan associated with a given
-- object. The @pApiVersion@ parameter returned by
-- 'Vulkan.Core11.DeviceInitialization.enumerateInstanceVersion' is the
-- version associated with a 'Vulkan.Core10.Handles.Instance' and its
-- children, except for a 'Vulkan.Core10.Handles.PhysicalDevice' and its
-- children. 'PhysicalDeviceProperties'::@apiVersion@ is the version
-- associated with a 'Vulkan.Core10.Handles.PhysicalDevice' and its
-- children.
--
-- The @vendorID@ and @deviceID@ fields are provided to allow applications
-- to adapt to device characteristics that are not adequately exposed by
-- other Vulkan queries.
--
-- Note
--
-- These /may/ include performance profiles, hardware errata, or other
-- characteristics.
--
-- The /vendor/ identified by @vendorID@ is the entity responsible for the
-- most salient characteristics of the underlying implementation of the
-- 'Vulkan.Core10.Handles.PhysicalDevice' being queried.
--
-- Note
--
-- For example, in the case of a discrete GPU implementation, this /should/
-- be the GPU chipset vendor. In the case of a hardware accelerator
-- integrated into a system-on-chip (SoC), this /should/ be the supplier of
-- the silicon IP used to create the accelerator.
--
-- If the vendor has a
-- <https://pcisig.com/membership/member-companies PCI vendor ID>, the low
-- 16 bits of @vendorID@ /must/ contain that PCI vendor ID, and the
-- remaining bits /must/ be set to zero. Otherwise, the value returned
-- /must/ be a valid Khronos vendor ID, obtained as described in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vulkan-styleguide Vulkan Documentation and Extensions: Procedures and Conventions>
-- document in the section “Registering a Vendor ID with Khronos”. Khronos
-- vendor IDs are allocated starting at 0x10000, to distinguish them from
-- the PCI vendor ID namespace. Khronos vendor IDs are symbolically defined
-- in the 'Vulkan.Core10.Enums.VendorId.VendorId' type.
--
-- The vendor is also responsible for the value returned in @deviceID@. If
-- the implementation is driven primarily by a
-- <https://pcisig.com/ PCI device> with a
-- <https://pcisig.com/ PCI device ID>, the low 16 bits of @deviceID@
-- /must/ contain that PCI device ID, and the remaining bits /must/ be set
-- to zero. Otherwise, the choice of what values to return /may/ be
-- dictated by operating system or platform policies - but /should/
-- uniquely identify both the device version and any major configuration
-- options (for example, core count in the case of multicore devices).
--
-- Note
--
-- The same device ID /should/ be used for all physical implementations of
-- that device version and configuration. For example, all uses of a
-- specific silicon IP GPU version and configuration /should/ use the same
-- device ID, even if those uses occur in different SoCs.
--
-- = See Also
--
-- 'PhysicalDeviceLimits',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2',
-- 'PhysicalDeviceSparseProperties',
-- 'Vulkan.Core10.Enums.PhysicalDeviceType.PhysicalDeviceType',
-- 'getPhysicalDeviceProperties'
data PhysicalDeviceProperties = PhysicalDeviceProperties
  { -- | @apiVersion@ is the version of Vulkan supported by the device, encoded
    -- as described in
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-coreversions-versionnumbers>.
    PhysicalDeviceProperties -> Word32
apiVersion :: Word32
  , -- | @driverVersion@ is the vendor-specified version of the driver.
    PhysicalDeviceProperties -> Word32
driverVersion :: Word32
  , -- | @vendorID@ is a unique identifier for the /vendor/ (see below) of the
    -- physical device.
    PhysicalDeviceProperties -> Word32
vendorID :: Word32
  , -- | @deviceID@ is a unique identifier for the physical device among devices
    -- available from the vendor.
    PhysicalDeviceProperties -> Word32
deviceID :: Word32
  , -- | @deviceType@ is a
    -- 'Vulkan.Core10.Enums.PhysicalDeviceType.PhysicalDeviceType' specifying
    -- the type of device.
    PhysicalDeviceProperties -> PhysicalDeviceType
deviceType :: PhysicalDeviceType
  , -- | @deviceName@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_PHYSICAL_DEVICE_NAME_SIZE' @char@
    -- containing a null-terminated UTF-8 string which is the name of the
    -- device.
    PhysicalDeviceProperties -> "name" ::: ByteString
deviceName :: ByteString
  , -- | @pipelineCacheUUID@ is an array of
    -- 'Vulkan.Core10.APIConstants.UUID_SIZE' @uint8_t@ values representing a
    -- universally unique identifier for the device.
    PhysicalDeviceProperties -> "name" ::: ByteString
pipelineCacheUUID :: ByteString
  , -- | @limits@ is the 'PhysicalDeviceLimits' structure specifying
    -- device-specific limits of the physical device. See
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits Limits>
    -- for details.
    PhysicalDeviceProperties -> PhysicalDeviceLimits
limits :: PhysicalDeviceLimits
  , -- | @sparseProperties@ is the 'PhysicalDeviceSparseProperties' structure
    -- specifying various sparse related properties of the physical device. See
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#sparsememory-physicalprops Sparse Properties>
    -- for details.
    PhysicalDeviceProperties -> PhysicalDeviceSparseProperties
sparseProperties :: PhysicalDeviceSparseProperties
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceProperties)
#endif
deriving instance Show PhysicalDeviceProperties

instance ToCStruct PhysicalDeviceProperties where
  withCStruct :: PhysicalDeviceProperties
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceProperties
x f :: ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b
f = Int
-> Int
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 824 8 ((("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
 -> IO b)
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p -> ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PhysicalDeviceProperties
p PhysicalDeviceProperties
x (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b
f "pProperties" ::: Ptr PhysicalDeviceProperties
p)
  pokeCStruct :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO b -> IO b
pokeCStruct p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p PhysicalDeviceProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
apiVersion)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
driverVersion)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
vendorID)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
deviceID)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceType -> PhysicalDeviceType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PhysicalDeviceType)) (PhysicalDeviceType
deviceType)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))) ("name" ::: ByteString
deviceName)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray UUID_SIZE Word8)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 276 :: Ptr (FixedArray UUID_SIZE Word8))) ("name" ::: ByteString
pipelineCacheUUID)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceLimits -> PhysicalDeviceLimits -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceLimits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr PhysicalDeviceLimits)) (PhysicalDeviceLimits
limits) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceSparseProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 800 :: Ptr PhysicalDeviceSparseProperties)) (PhysicalDeviceSparseProperties
sparseProperties) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 824
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b -> IO b
pokeZeroCStruct p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceType -> PhysicalDeviceType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PhysicalDeviceType)) (PhysicalDeviceType
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))) ("name" ::: ByteString
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray UUID_SIZE Word8)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 276 :: Ptr (FixedArray UUID_SIZE Word8))) ("name" ::: ByteString
forall a. Monoid a => a
mempty)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceLimits -> PhysicalDeviceLimits -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceLimits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr PhysicalDeviceLimits)) (PhysicalDeviceLimits
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceSparseProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 800 :: Ptr PhysicalDeviceSparseProperties)) (PhysicalDeviceSparseProperties
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct PhysicalDeviceProperties where
  peekCStruct :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
peekCStruct p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p = do
    Word32
apiVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
    Word32
driverVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
    Word32
vendorID <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32))
    Word32
deviceID <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32))
    PhysicalDeviceType
deviceType <- Ptr PhysicalDeviceType -> IO PhysicalDeviceType
forall a. Storable a => Ptr a -> IO a
peek @PhysicalDeviceType (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PhysicalDeviceType))
    "name" ::: ByteString
deviceName <- ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
-> "pName" ::: Ptr CChar
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))))
    "name" ::: ByteString
pipelineCacheUUID <- Ptr (FixedArray UUID_SIZE Word8) -> IO ("name" ::: ByteString)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ("name" ::: ByteString)
peekByteStringFromSizedVectorPtr (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 276 :: Ptr (FixedArray UUID_SIZE Word8)))
    PhysicalDeviceLimits
limits <- Ptr PhysicalDeviceLimits -> IO PhysicalDeviceLimits
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceLimits (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceLimits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr PhysicalDeviceLimits))
    PhysicalDeviceSparseProperties
sparseProperties <- Ptr PhysicalDeviceSparseProperties
-> IO PhysicalDeviceSparseProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceSparseProperties (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceSparseProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 800 :: Ptr PhysicalDeviceSparseProperties))
    PhysicalDeviceProperties -> IO PhysicalDeviceProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceProperties -> IO PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO PhysicalDeviceProperties
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDeviceType
-> ("name" ::: ByteString)
-> ("name" ::: ByteString)
-> PhysicalDeviceLimits
-> PhysicalDeviceSparseProperties
-> PhysicalDeviceProperties
PhysicalDeviceProperties
             Word32
apiVersion Word32
driverVersion Word32
vendorID Word32
deviceID PhysicalDeviceType
deviceType "name" ::: ByteString
deviceName "name" ::: ByteString
pipelineCacheUUID PhysicalDeviceLimits
limits PhysicalDeviceSparseProperties
sparseProperties

instance Zero PhysicalDeviceProperties where
  zero :: PhysicalDeviceProperties
zero = Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDeviceType
-> ("name" ::: ByteString)
-> ("name" ::: ByteString)
-> PhysicalDeviceLimits
-> PhysicalDeviceSparseProperties
-> PhysicalDeviceProperties
PhysicalDeviceProperties
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           PhysicalDeviceType
forall a. Zero a => a
zero
           "name" ::: ByteString
forall a. Monoid a => a
mempty
           "name" ::: ByteString
forall a. Monoid a => a
mempty
           PhysicalDeviceLimits
forall a. Zero a => a
zero
           PhysicalDeviceSparseProperties
forall a. Zero a => a
zero


-- | VkApplicationInfo - Structure specifying application info
--
-- = Description
--
-- Vulkan 1.0 implementations were required to return
-- 'Vulkan.Core10.Enums.Result.ERROR_INCOMPATIBLE_DRIVER' if @apiVersion@
-- was larger than 1.0. Implementations that support Vulkan 1.1 or later
-- /must/ not return 'Vulkan.Core10.Enums.Result.ERROR_INCOMPATIBLE_DRIVER'
-- for any value of @apiVersion@.
--
-- Note
--
-- Because Vulkan 1.0 implementations /may/ fail with
-- 'Vulkan.Core10.Enums.Result.ERROR_INCOMPATIBLE_DRIVER', applications
-- /should/ determine the version of Vulkan available before calling
-- 'createInstance'. If the 'getInstanceProcAddr' returns @NULL@ for
-- 'Vulkan.Core11.DeviceInitialization.enumerateInstanceVersion', it is a
-- Vulkan 1.0 implementation. Otherwise, the application /can/ call
-- 'Vulkan.Core11.DeviceInitialization.enumerateInstanceVersion' to
-- determine the version of Vulkan.
--
-- As long as the instance supports at least Vulkan 1.1, an application
-- /can/ use different versions of Vulkan with an instance than it does
-- with a device or physical device.
--
-- Note
--
-- The Khronos validation layers will treat @apiVersion@ as the highest API
-- version the application targets, and will validate API usage against the
-- minimum of that version and the implementation version (instance or
-- device, depending on context). If an application tries to use
-- functionality from a greater version than this, a validation error will
-- be triggered.
--
-- For example, if the instance supports Vulkan 1.1 and three physical
-- devices support Vulkan 1.0, Vulkan 1.1, and Vulkan 1.2, respectively,
-- and if the application sets @apiVersion@ to 1.2, the application /can/
-- use the following versions of Vulkan:
--
-- -   Vulkan 1.0 /can/ be used with the instance and with all physical
--     devices.
--
-- -   Vulkan 1.1 /can/ be used with the instance and with the physical
--     devices that support Vulkan 1.1 and Vulkan 1.2.
--
-- -   Vulkan 1.2 /can/ be used with the physical device that supports
--     Vulkan 1.2.
--
-- If we modify the above example so that the application sets @apiVersion@
-- to 1.1, then the application /must/ not use Vulkan 1.2 functionality on
-- the physical device that supports Vulkan 1.2.
--
-- Implicit layers /must/ be disabled if they do not support a version at
-- least as high as @apiVersion@. See the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#LoaderAndLayerInterface Vulkan Loader Specification and Architecture Overview>
-- document for additional information.
--
-- Note
--
-- Providing a @NULL@ 'InstanceCreateInfo'::@pApplicationInfo@ or providing
-- an @apiVersion@ of 0 is equivalent to providing an @apiVersion@ of
-- @VK_MAKE_VERSION(1,0,0)@.
--
-- == Valid Usage
--
-- -   If @apiVersion@ is not @0@, then it /must/ be greater or equal to
--     'Vulkan.Core10.API_VERSION_1_0'
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_APPLICATION_INFO'
--
-- -   @pNext@ /must/ be @NULL@
--
-- -   If @pApplicationName@ is not @NULL@, @pApplicationName@ /must/ be a
--     null-terminated UTF-8 string
--
-- -   If @pEngineName@ is not @NULL@, @pEngineName@ /must/ be a
--     null-terminated UTF-8 string
--
-- = See Also
--
-- 'InstanceCreateInfo', 'Vulkan.Core10.Enums.StructureType.StructureType'
data ApplicationInfo = ApplicationInfo
  { -- | @pApplicationName@ is @NULL@ or is a pointer to a null-terminated UTF-8
    -- string containing the name of the application.
    ApplicationInfo -> Maybe ("name" ::: ByteString)
applicationName :: Maybe ByteString
  , -- | @applicationVersion@ is an unsigned integer variable containing the
    -- developer-supplied version number of the application.
    ApplicationInfo -> Word32
applicationVersion :: Word32
  , -- | @pEngineName@ is @NULL@ or is a pointer to a null-terminated UTF-8
    -- string containing the name of the engine (if any) used to create the
    -- application.
    ApplicationInfo -> Maybe ("name" ::: ByteString)
engineName :: Maybe ByteString
  , -- | @engineVersion@ is an unsigned integer variable containing the
    -- developer-supplied version number of the engine used to create the
    -- application.
    ApplicationInfo -> Word32
engineVersion :: Word32
  , -- | @apiVersion@ /must/ be the highest version of Vulkan that the
    -- application is designed to use, encoded as described in
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-coreversions-versionnumbers>.
    -- The patch version number specified in @apiVersion@ is ignored when
    -- creating an instance object. Only the major and minor versions of the
    -- instance /must/ match those requested in @apiVersion@.
    ApplicationInfo -> Word32
apiVersion :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ApplicationInfo)
#endif
deriving instance Show ApplicationInfo

instance ToCStruct ApplicationInfo where
  withCStruct :: ApplicationInfo -> (Ptr ApplicationInfo -> IO b) -> IO b
withCStruct x :: ApplicationInfo
x f :: Ptr ApplicationInfo -> IO b
f = Int -> Int -> (Ptr ApplicationInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr ApplicationInfo -> IO b) -> IO b)
-> (Ptr ApplicationInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ApplicationInfo
p -> Ptr ApplicationInfo -> ApplicationInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ApplicationInfo
p ApplicationInfo
x (Ptr ApplicationInfo -> IO b
f Ptr ApplicationInfo
p)
  pokeCStruct :: Ptr ApplicationInfo -> ApplicationInfo -> IO b -> IO b
pokeCStruct p :: Ptr ApplicationInfo
p ApplicationInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_APPLICATION_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    "pName" ::: Ptr CChar
pApplicationName'' <- case (Maybe ("name" ::: ByteString)
applicationName) of
      Nothing -> ("pName" ::: Ptr CChar) -> ContT b IO ("pName" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pName" ::: Ptr CChar
forall a. Ptr a
nullPtr
      Just j :: "name" ::: ByteString
j -> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
j)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr CChar))) "pName" ::: Ptr CChar
pApplicationName''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
applicationVersion)
    "pName" ::: Ptr CChar
pEngineName'' <- case (Maybe ("name" ::: ByteString)
engineName) of
      Nothing -> ("pName" ::: Ptr CChar) -> ContT b IO ("pName" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pName" ::: Ptr CChar
forall a. Ptr a
nullPtr
      Just j :: "name" ::: ByteString
j -> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
j)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar))) "pName" ::: Ptr CChar
pEngineName''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) (Word32
engineVersion)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) (Word32
apiVersion)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 48
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ApplicationInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ApplicationInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_APPLICATION_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ApplicationInfo where
  peekCStruct :: Ptr ApplicationInfo -> IO ApplicationInfo
peekCStruct p :: Ptr ApplicationInfo
p = do
    "pName" ::: Ptr CChar
pApplicationName <- Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr CChar)))
    Maybe ("name" ::: ByteString)
pApplicationName' <- (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> ("pName" ::: Ptr CChar) -> IO (Maybe ("name" ::: ByteString))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: "pName" ::: Ptr CChar
j -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString  ("pName" ::: Ptr CChar
j)) "pName" ::: Ptr CChar
pApplicationName
    Word32
applicationVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
    "pName" ::: Ptr CChar
pEngineName <- Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar)))
    Maybe ("name" ::: ByteString)
pEngineName' <- (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> ("pName" ::: Ptr CChar) -> IO (Maybe ("name" ::: ByteString))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: "pName" ::: Ptr CChar
j -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString  ("pName" ::: Ptr CChar
j)) "pName" ::: Ptr CChar
pEngineName
    Word32
engineVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32))
    Word32
apiVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32))
    ApplicationInfo -> IO ApplicationInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApplicationInfo -> IO ApplicationInfo)
-> ApplicationInfo -> IO ApplicationInfo
forall a b. (a -> b) -> a -> b
$ Maybe ("name" ::: ByteString)
-> Word32
-> Maybe ("name" ::: ByteString)
-> Word32
-> Word32
-> ApplicationInfo
ApplicationInfo
             Maybe ("name" ::: ByteString)
pApplicationName' Word32
applicationVersion Maybe ("name" ::: ByteString)
pEngineName' Word32
engineVersion Word32
apiVersion

instance Zero ApplicationInfo where
  zero :: ApplicationInfo
zero = Maybe ("name" ::: ByteString)
-> Word32
-> Maybe ("name" ::: ByteString)
-> Word32
-> Word32
-> ApplicationInfo
ApplicationInfo
           Maybe ("name" ::: ByteString)
forall a. Maybe a
Nothing
           Word32
forall a. Zero a => a
zero
           Maybe ("name" ::: ByteString)
forall a. Maybe a
Nothing
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | VkInstanceCreateInfo - Structure specifying parameters of a newly
-- created instance
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_INSTANCE_CREATE_INFO'
--
-- -   Each @pNext@ member of any structure (including this one) in the
--     @pNext@ chain /must/ be either @NULL@ or a pointer to a valid
--     instance of
--     'Vulkan.Extensions.VK_EXT_debug_report.DebugReportCallbackCreateInfoEXT',
--     'Vulkan.Extensions.VK_EXT_debug_utils.DebugUtilsMessengerCreateInfoEXT',
--     'Vulkan.Extensions.VK_EXT_validation_features.ValidationFeaturesEXT',
--     or 'Vulkan.Extensions.VK_EXT_validation_flags.ValidationFlagsEXT'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique, with the exception of structures of type
--     'Vulkan.Extensions.VK_EXT_debug_utils.DebugUtilsMessengerCreateInfoEXT'
--
-- -   @flags@ /must/ be @0@
--
-- -   If @pApplicationInfo@ is not @NULL@, @pApplicationInfo@ /must/ be a
--     valid pointer to a valid 'ApplicationInfo' structure
--
-- -   If @enabledLayerCount@ is not @0@, @ppEnabledLayerNames@ /must/ be a
--     valid pointer to an array of @enabledLayerCount@ null-terminated
--     UTF-8 strings
--
-- -   If @enabledExtensionCount@ is not @0@, @ppEnabledExtensionNames@
--     /must/ be a valid pointer to an array of @enabledExtensionCount@
--     null-terminated UTF-8 strings
--
-- = See Also
--
-- 'ApplicationInfo',
-- 'Vulkan.Core10.Enums.InstanceCreateFlags.InstanceCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createInstance'
data InstanceCreateInfo (es :: [Type]) = InstanceCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    InstanceCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    InstanceCreateInfo es -> InstanceCreateFlags
flags :: InstanceCreateFlags
  , -- | @pApplicationInfo@ is @NULL@ or a pointer to a 'ApplicationInfo'
    -- structure. If not @NULL@, this information helps implementations
    -- recognize behavior inherent to classes of applications.
    -- 'ApplicationInfo' is defined in detail below.
    InstanceCreateInfo es -> Maybe ApplicationInfo
applicationInfo :: Maybe ApplicationInfo
  , -- | @ppEnabledLayerNames@ is a pointer to an array of @enabledLayerCount@
    -- null-terminated UTF-8 strings containing the names of layers to enable
    -- for the created instance. The layers are loaded in the order they are
    -- listed in this array, with the first array element being the closest to
    -- the application, and the last array element being the closest to the
    -- driver. See the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-layers>
    -- section for further details.
    InstanceCreateInfo es -> Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ByteString
  , -- | @ppEnabledExtensionNames@ is a pointer to an array of
    -- @enabledExtensionCount@ null-terminated UTF-8 strings containing the
    -- names of extensions to enable.
    InstanceCreateInfo es -> Vector ("name" ::: ByteString)
enabledExtensionNames :: Vector ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (InstanceCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (InstanceCreateInfo es)

instance Extensible InstanceCreateInfo where
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO
  setNext :: InstanceCreateInfo ds -> Chain es -> InstanceCreateInfo es
setNext x :: InstanceCreateInfo ds
x next :: Chain es
next = InstanceCreateInfo ds
x{$sel:next:InstanceCreateInfo :: Chain es
next = Chain es
next}
  getNext :: InstanceCreateInfo es -> Chain es
getNext InstanceCreateInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends InstanceCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends InstanceCreateInfo e => b) -> Maybe b
extends _ f :: Extends InstanceCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable DebugUtilsMessengerCreateInfoEXT) =>
Maybe (e :~: DebugUtilsMessengerCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DebugUtilsMessengerCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ValidationFeaturesEXT) =>
Maybe (e :~: ValidationFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ValidationFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ValidationFlagsEXT) =>
Maybe (e :~: ValidationFlagsEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ValidationFlagsEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable DebugReportCallbackCreateInfoEXT) =>
Maybe (e :~: DebugReportCallbackCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DebugReportCallbackCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss InstanceCreateInfo es, PokeChain es) => ToCStruct (InstanceCreateInfo es) where
  withCStruct :: InstanceCreateInfo es
-> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
withCStruct x :: InstanceCreateInfo es
x f :: Ptr (InstanceCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 64 8 ((Ptr (InstanceCreateInfo es) -> IO b) -> IO b)
-> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (InstanceCreateInfo es)
p -> Ptr (InstanceCreateInfo es)
-> InstanceCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (InstanceCreateInfo es)
p InstanceCreateInfo es
x (Ptr (InstanceCreateInfo es) -> IO b
f Ptr (InstanceCreateInfo es)
p)
  pokeCStruct :: Ptr (InstanceCreateInfo es)
-> InstanceCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (InstanceCreateInfo es)
p InstanceCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr InstanceCreateFlags -> InstanceCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr InstanceCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr InstanceCreateFlags)) (InstanceCreateFlags
flags)
    Ptr ApplicationInfo
pApplicationInfo'' <- case (Maybe ApplicationInfo
applicationInfo) of
      Nothing -> Ptr ApplicationInfo -> ContT b IO (Ptr ApplicationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ApplicationInfo
forall a. Ptr a
nullPtr
      Just j :: ApplicationInfo
j -> ((Ptr ApplicationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr ApplicationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ApplicationInfo -> IO b) -> IO b)
 -> ContT b IO (Ptr ApplicationInfo))
-> ((Ptr ApplicationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr ApplicationInfo)
forall a b. (a -> b) -> a -> b
$ ApplicationInfo -> (Ptr ApplicationInfo -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ApplicationInfo
j)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ApplicationInfo) -> Ptr ApplicationInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ApplicationInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ApplicationInfo))) Ptr ApplicationInfo
pApplicationInfo''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString) -> Int)
-> Vector ("name" ::: ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ("name" ::: ByteString)
enabledLayerNames)) :: Word32))
    Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString)
enabledLayerNames)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    (Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
      "pName" ::: Ptr CChar
ppEnabledLayerNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
      IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledLayerNames'') (Vector ("name" ::: ByteString)
enabledLayerNames)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames')
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString) -> Int)
-> Vector ("name" ::: ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ("name" ::: ByteString)
enabledExtensionNames)) :: Word32))
    Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString)
enabledExtensionNames)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    (Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
      "pName" ::: Ptr CChar
ppEnabledExtensionNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
      IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledExtensionNames'') (Vector ("name" ::: ByteString)
enabledExtensionNames)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 64
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (InstanceCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (InstanceCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    (Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
      "pName" ::: Ptr CChar
ppEnabledLayerNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
      IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledLayerNames'') (Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames')
    Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    (Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
      "pName" ::: Ptr CChar
ppEnabledExtensionNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
      IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledExtensionNames'') (Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss InstanceCreateInfo es, PeekChain es) => FromCStruct (InstanceCreateInfo es) where
  peekCStruct :: Ptr (InstanceCreateInfo es) -> IO (InstanceCreateInfo es)
peekCStruct p :: Ptr (InstanceCreateInfo es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    InstanceCreateFlags
flags <- Ptr InstanceCreateFlags -> IO InstanceCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @InstanceCreateFlags ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr InstanceCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr InstanceCreateFlags))
    Ptr ApplicationInfo
pApplicationInfo <- Ptr (Ptr ApplicationInfo) -> IO (Ptr ApplicationInfo)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ApplicationInfo) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ApplicationInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ApplicationInfo)))
    Maybe ApplicationInfo
pApplicationInfo' <- (Ptr ApplicationInfo -> IO ApplicationInfo)
-> Ptr ApplicationInfo -> IO (Maybe ApplicationInfo)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: Ptr ApplicationInfo
j -> Ptr ApplicationInfo -> IO ApplicationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ApplicationInfo (Ptr ApplicationInfo
j)) Ptr ApplicationInfo
pApplicationInfo
    Word32
enabledLayerCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32))
    Ptr ("pName" ::: Ptr CChar)
ppEnabledLayerNames <- Ptr (Ptr ("pName" ::: Ptr CChar))
-> IO (Ptr ("pName" ::: Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (Ptr CChar))))
    Vector ("name" ::: ByteString)
ppEnabledLayerNames' <- Int
-> (Int -> IO ("name" ::: ByteString))
-> IO (Vector ("name" ::: ByteString))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledLayerCount) (\i :: Int
i -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> IO ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr ("pName" ::: Ptr CChar)
ppEnabledLayerNames Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
    Word32
enabledExtensionCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32))
    Ptr ("pName" ::: Ptr CChar)
ppEnabledExtensionNames <- Ptr (Ptr ("pName" ::: Ptr CChar))
-> IO (Ptr ("pName" ::: Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr (Ptr CChar))))
    Vector ("name" ::: ByteString)
ppEnabledExtensionNames' <- Int
-> (Int -> IO ("name" ::: ByteString))
-> IO (Vector ("name" ::: ByteString))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledExtensionCount) (\i :: Int
i -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> IO ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr ("pName" ::: Ptr CChar)
ppEnabledExtensionNames Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
    InstanceCreateInfo es -> IO (InstanceCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstanceCreateInfo es -> IO (InstanceCreateInfo es))
-> InstanceCreateInfo es -> IO (InstanceCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
forall (es :: [*]).
Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
InstanceCreateInfo
             Chain es
next InstanceCreateFlags
flags Maybe ApplicationInfo
pApplicationInfo' Vector ("name" ::: ByteString)
ppEnabledLayerNames' Vector ("name" ::: ByteString)
ppEnabledExtensionNames'

instance es ~ '[] => Zero (InstanceCreateInfo es) where
  zero :: InstanceCreateInfo es
zero = Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
forall (es :: [*]).
Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
InstanceCreateInfo
           ()
           InstanceCreateFlags
forall a. Zero a => a
zero
           Maybe ApplicationInfo
forall a. Maybe a
Nothing
           Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty
           Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty


-- | VkQueueFamilyProperties - Structure providing information about a queue
-- family
--
-- = Description
--
-- The value returned in @minImageTransferGranularity@ has a unit of
-- compressed texel blocks for images having a block-compressed format, and
-- a unit of texels otherwise.
--
-- Possible values of @minImageTransferGranularity@ are:
--
-- -   (0,0,0) which indicates that only whole mip levels /must/ be
--     transferred using the image transfer operations on the corresponding
--     queues. In this case, the following restrictions apply to all offset
--     and extent parameters of image transfer operations:
--
--     -   The @x@, @y@, and @z@ members of a
--         'Vulkan.Core10.FundamentalTypes.Offset3D' parameter /must/
--         always be zero.
--
--     -   The @width@, @height@, and @depth@ members of a
--         'Vulkan.Core10.FundamentalTypes.Extent3D' parameter /must/
--         always match the width, height, and depth of the image
--         subresource corresponding to the parameter, respectively.
--
-- -   (Ax, Ay, Az) where Ax, Ay, and Az are all integer powers of two. In
--     this case the following restrictions apply to all image transfer
--     operations:
--
--     -   @x@, @y@, and @z@ of a 'Vulkan.Core10.FundamentalTypes.Offset3D'
--         parameter /must/ be integer multiples of Ax, Ay, and Az,
--         respectively.
--
--     -   @width@ of a 'Vulkan.Core10.FundamentalTypes.Extent3D' parameter
--         /must/ be an integer multiple of Ax, or else @x@ + @width@
--         /must/ equal the width of the image subresource corresponding to
--         the parameter.
--
--     -   @height@ of a 'Vulkan.Core10.FundamentalTypes.Extent3D'
--         parameter /must/ be an integer multiple of Ay, or else @y@ +
--         @height@ /must/ equal the height of the image subresource
--         corresponding to the parameter.
--
--     -   @depth@ of a 'Vulkan.Core10.FundamentalTypes.Extent3D' parameter
--         /must/ be an integer multiple of Az, or else @z@ + @depth@
--         /must/ equal the depth of the image subresource corresponding to
--         the parameter.
--
--     -   If the format of the image corresponding to the parameters is
--         one of the block-compressed formats then for the purposes of the
--         above calculations the granularity /must/ be scaled up by the
--         compressed texel block dimensions.
--
-- Queues supporting graphics and\/or compute operations /must/ report
-- (1,1,1) in @minImageTransferGranularity@, meaning that there are no
-- additional restrictions on the granularity of image transfer operations
-- for these queues. Other queues supporting image transfer operations are
-- only /required/ to support whole mip level transfers, thus
-- @minImageTransferGranularity@ for queues belonging to such queue
-- families /may/ be (0,0,0).
--
-- The
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-device Device Memory>
-- section describes memory properties queried from the physical device.
--
-- For physical device feature queries see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features Features>
-- chapter.
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.QueueFamilyProperties2',
-- 'Vulkan.Core10.Enums.QueueFlagBits.QueueFlags',
-- 'getPhysicalDeviceQueueFamilyProperties'
data QueueFamilyProperties = QueueFamilyProperties
  { -- | @queueFlags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QueueFlagBits' indicating
    -- capabilities of the queues in this queue family.
    QueueFamilyProperties -> QueueFlags
queueFlags :: QueueFlags
  , -- | @queueCount@ is the unsigned integer count of queues in this queue
    -- family. Each queue family /must/ support at least one queue.
    QueueFamilyProperties -> Word32
queueCount :: Word32
  , -- | @timestampValidBits@ is the unsigned integer count of meaningful bits in
    -- the timestamps written via
    -- 'Vulkan.Core10.CommandBufferBuilding.cmdWriteTimestamp'. The valid range
    -- for the count is 36..64 bits, or a value of 0, indicating no support for
    -- timestamps. Bits outside the valid range are guaranteed to be zeros.
    QueueFamilyProperties -> Word32
timestampValidBits :: Word32
  , -- | @minImageTransferGranularity@ is the minimum granularity supported for
    -- image transfer operations on the queues in this queue family.
    QueueFamilyProperties -> Extent3D
minImageTransferGranularity :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (QueueFamilyProperties)
#endif
deriving instance Show QueueFamilyProperties

instance ToCStruct QueueFamilyProperties where
  withCStruct :: QueueFamilyProperties
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
    -> IO b)
-> IO b
withCStruct x :: QueueFamilyProperties
x f :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b
f = Int
-> Int
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
    -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 4 ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b)
 -> IO b)
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> QueueFamilyProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p QueueFamilyProperties
x (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b
f "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p)
  pokeCStruct :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> QueueFamilyProperties -> IO b -> IO b
pokeCStruct p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p QueueFamilyProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr QueueFlags -> QueueFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr QueueFlags)) (QueueFlags
queueFlags)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
queueCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
timestampValidBits)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Extent3D)) (Extent3D
minImageTransferGranularity) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct QueueFamilyProperties where
  peekCStruct :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO QueueFamilyProperties
peekCStruct p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p = do
    QueueFlags
queueFlags <- Ptr QueueFlags -> IO QueueFlags
forall a. Storable a => Ptr a -> IO a
peek @QueueFlags (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr QueueFlags))
    Word32
queueCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
    Word32
timestampValidBits <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32))
    Extent3D
minImageTransferGranularity <- Ptr Extent3D -> IO Extent3D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Extent3D))
    QueueFamilyProperties -> IO QueueFamilyProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueueFamilyProperties -> IO QueueFamilyProperties)
-> QueueFamilyProperties -> IO QueueFamilyProperties
forall a b. (a -> b) -> a -> b
$ QueueFlags -> Word32 -> Word32 -> Extent3D -> QueueFamilyProperties
QueueFamilyProperties
             QueueFlags
queueFlags Word32
queueCount Word32
timestampValidBits Extent3D
minImageTransferGranularity

instance Zero QueueFamilyProperties where
  zero :: QueueFamilyProperties
zero = QueueFlags -> Word32 -> Word32 -> Extent3D -> QueueFamilyProperties
QueueFamilyProperties
           QueueFlags
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Extent3D
forall a. Zero a => a
zero


-- | VkPhysicalDeviceMemoryProperties - Structure specifying physical device
-- memory properties
--
-- = Description
--
-- The 'PhysicalDeviceMemoryProperties' structure describes a number of
-- /memory heaps/ as well as a number of /memory types/ that /can/ be used
-- to access memory allocated in those heaps. Each heap describes a memory
-- resource of a particular size, and each memory type describes a set of
-- memory properties (e.g. host cached vs uncached) that /can/ be used with
-- a given memory heap. Allocations using a particular memory type will
-- consume resources from the heap indicated by that memory type’s heap
-- index. More than one memory type /may/ share each heap, and the heaps
-- and memory types provide a mechanism to advertise an accurate size of
-- the physical memory resources while allowing the memory to be used with
-- a variety of different properties.
--
-- The number of memory heaps is given by @memoryHeapCount@ and is less
-- than or equal to 'Vulkan.Core10.APIConstants.MAX_MEMORY_HEAPS'. Each
-- heap is described by an element of the @memoryHeaps@ array as a
-- 'MemoryHeap' structure. The number of memory types available across all
-- memory heaps is given by @memoryTypeCount@ and is less than or equal to
-- 'Vulkan.Core10.APIConstants.MAX_MEMORY_TYPES'. Each memory type is
-- described by an element of the @memoryTypes@ array as a 'MemoryType'
-- structure.
--
-- At least one heap /must/ include
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_DEVICE_LOCAL_BIT' in
-- 'MemoryHeap'::@flags@. If there are multiple heaps that all have similar
-- performance characteristics, they /may/ all include
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_DEVICE_LOCAL_BIT'.
-- In a unified memory architecture (UMA) system there is often only a
-- single memory heap which is considered to be equally “local” to the host
-- and to the device, and such an implementation /must/ advertise the heap
-- as device-local.
--
-- Each memory type returned by 'getPhysicalDeviceMemoryProperties' /must/
-- have its @propertyFlags@ set to one of the following values:
--
-- -   0
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_PROTECTED_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_PROTECTED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD'
--
-- -   'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_CACHED_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--     |
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD'
--
-- There /must/ be at least one memory type with both the
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
-- and
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
-- bits set in its @propertyFlags@. There /must/ be at least one memory
-- type with the
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
-- bit set in its @propertyFlags@. If the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-deviceCoherentMemory deviceCoherentMemory>
-- feature is enabled, there /must/ be at least one memory type with the
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
-- bit set in its @propertyFlags@.
--
-- For each pair of elements __X__ and __Y__ returned in @memoryTypes@,
-- __X__ /must/ be placed at a lower index position than __Y__ if:
--
-- -   the set of bit flags returned in the @propertyFlags@ member of __X__
--     is a strict subset of the set of bit flags returned in the
--     @propertyFlags@ member of __Y__; or
--
-- -   the @propertyFlags@ members of __X__ and __Y__ are equal, and __X__
--     belongs to a memory heap with greater performance (as determined in
--     an implementation-specific manner) ; or
--
-- -   the @propertyFlags@ members of __Y__ includes
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--     or
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD'
--     and __X__ does not
--
-- Note
--
-- There is no ordering requirement between __X__ and __Y__ elements for
-- the case their @propertyFlags@ members are not in a subset relation.
-- That potentially allows more than one possible way to order the same set
-- of memory types. Notice that the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-device-bitmask-list list of all allowed memory property flag combinations>
-- is written in a valid order. But if instead
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_LOCAL_BIT'
-- was before
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
-- |
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT',
-- the list would still be in a valid order.
--
-- There may be a performance penalty for using device coherent or uncached
-- device memory types, and using these accidentally is undesirable. In
-- order to avoid this, memory types with these properties always appear at
-- the end of the list; but are subject to the same rules otherwise.
--
-- This ordering requirement enables applications to use a simple search
-- loop to select the desired memory type along the lines of:
--
-- > // Find a memory in `memoryTypeBitsRequirement` that includes all of `requiredProperties`
-- > int32_t findProperties(const VkPhysicalDeviceMemoryProperties* pMemoryProperties,
-- >                        uint32_t memoryTypeBitsRequirement,
-- >                        VkMemoryPropertyFlags requiredProperties) {
-- >     const uint32_t memoryCount = pMemoryProperties->memoryTypeCount;
-- >     for (uint32_t memoryIndex = 0; memoryIndex < memoryCount; ++memoryIndex) {
-- >         const uint32_t memoryTypeBits = (1 << memoryIndex);
-- >         const bool isRequiredMemoryType = memoryTypeBitsRequirement & memoryTypeBits;
-- >
-- >         const VkMemoryPropertyFlags properties =
-- >             pMemoryProperties->memoryTypes[memoryIndex].propertyFlags;
-- >         const bool hasRequiredProperties =
-- >             (properties & requiredProperties) == requiredProperties;
-- >
-- >         if (isRequiredMemoryType && hasRequiredProperties)
-- >             return static_cast<int32_t>(memoryIndex);
-- >     }
-- >
-- >     // failed to find memory type
-- >     return -1;
-- > }
-- >
-- > // Try to find an optimal memory type, or if it does not exist try fallback memory type
-- > // `device` is the VkDevice
-- > // `image` is the VkImage that requires memory to be bound
-- > // `memoryProperties` properties as returned by vkGetPhysicalDeviceMemoryProperties
-- > // `requiredProperties` are the property flags that must be present
-- > // `optimalProperties` are the property flags that are preferred by the application
-- > VkMemoryRequirements memoryRequirements;
-- > vkGetImageMemoryRequirements(device, image, &memoryRequirements);
-- > int32_t memoryType =
-- >     findProperties(&memoryProperties, memoryRequirements.memoryTypeBits, optimalProperties);
-- > if (memoryType == -1) // not found; try fallback properties
-- >     memoryType =
-- >         findProperties(&memoryProperties, memoryRequirements.memoryTypeBits, requiredProperties);
--
-- = See Also
--
-- 'MemoryHeap', 'MemoryType',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceMemoryProperties2',
-- 'getPhysicalDeviceMemoryProperties'
data PhysicalDeviceMemoryProperties = PhysicalDeviceMemoryProperties
  { -- | @memoryTypeCount@ is the number of valid elements in the @memoryTypes@
    -- array.
    PhysicalDeviceMemoryProperties -> Word32
memoryTypeCount :: Word32
  , -- | @memoryTypes@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_MEMORY_TYPES' 'MemoryType' structures
    -- describing the /memory types/ that /can/ be used to access memory
    -- allocated from the heaps specified by @memoryHeaps@.
    PhysicalDeviceMemoryProperties -> Vector MemoryType
memoryTypes :: Vector MemoryType
  , -- | @memoryHeapCount@ is the number of valid elements in the @memoryHeaps@
    -- array.
    PhysicalDeviceMemoryProperties -> Word32
memoryHeapCount :: Word32
  , -- | @memoryHeaps@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_MEMORY_HEAPS' 'MemoryHeap' structures
    -- describing the /memory heaps/ from which memory /can/ be allocated.
    PhysicalDeviceMemoryProperties -> Vector MemoryHeap
memoryHeaps :: Vector MemoryHeap
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMemoryProperties)
#endif
deriving instance Show PhysicalDeviceMemoryProperties

instance ToCStruct PhysicalDeviceMemoryProperties where
  withCStruct :: PhysicalDeviceMemoryProperties
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
    -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceMemoryProperties
x f :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b
f = Int
-> Int
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
    -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 520 8 ((("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
  -> IO b)
 -> IO b)
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p PhysicalDeviceMemoryProperties
x (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b
f "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p)
  pokeCStruct :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties -> IO b -> IO b
pokeCStruct p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p PhysicalDeviceMemoryProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
memoryTypeCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector MemoryType -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MemoryType -> Int) -> Vector MemoryType -> Int
forall a b. (a -> b) -> a -> b
$ (Vector MemoryType
memoryTypes)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_TYPES) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryTypes is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
    (Int -> MemoryType -> ContT b IO ())
-> Vector MemoryType -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryType
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryType -> MemoryType -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray MAX_MEMORY_TYPES MemoryType) -> Ptr MemoryType
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) Ptr MemoryType -> Int -> Ptr MemoryType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType) (MemoryType
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryType
memoryTypes)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 260 :: Ptr Word32)) (Word32
memoryHeapCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector MemoryHeap -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MemoryHeap -> Int) -> Vector MemoryHeap -> Int
forall a b. (a -> b) -> a -> b
$ (Vector MemoryHeap
memoryHeaps)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryHeaps is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
    (Int -> MemoryHeap -> ContT b IO ())
-> Vector MemoryHeap -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryHeap
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray UUID_SIZE MemoryHeap) -> Ptr MemoryHeap
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray UUID_SIZE MemoryHeap)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) Ptr MemoryHeap -> Int -> Ptr MemoryHeap
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap) (MemoryHeap
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryHeap
memoryHeaps)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 520
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any -> Int) -> Vector Any -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_TYPES) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryTypes is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
    (Int -> MemoryType -> ContT b IO ())
-> Vector MemoryType -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryType
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryType -> MemoryType -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray MAX_MEMORY_TYPES MemoryType) -> Ptr MemoryType
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) Ptr MemoryType -> Int -> Ptr MemoryType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType) (MemoryType
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryType
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 260 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any -> Int) -> Vector Any -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryHeaps is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
    (Int -> MemoryHeap -> ContT b IO ())
-> Vector MemoryHeap -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryHeap
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray UUID_SIZE MemoryHeap) -> Ptr MemoryHeap
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray UUID_SIZE MemoryHeap)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) Ptr MemoryHeap -> Int -> Ptr MemoryHeap
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap) (MemoryHeap
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryHeap
forall a. Monoid a => a
mempty)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct PhysicalDeviceMemoryProperties where
  peekCStruct :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
peekCStruct p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p = do
    Word32
memoryTypeCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
    Vector MemoryType
memoryTypes <- Int -> (Int -> IO MemoryType) -> IO (Vector MemoryType)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Int
forall a. Integral a => a
MAX_MEMORY_TYPES) (\i :: Int
i -> Ptr MemoryType -> IO MemoryType
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryType (((Ptr (FixedArray MAX_MEMORY_TYPES MemoryType) -> Ptr MemoryType
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @MemoryType (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) Ptr MemoryType -> Int -> Ptr MemoryType
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType)))
    Word32
memoryHeapCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 260 :: Ptr Word32))
    Vector MemoryHeap
memoryHeaps <- Int -> (Int -> IO MemoryHeap) -> IO (Vector MemoryHeap)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) (\i :: Int
i -> Ptr MemoryHeap -> IO MemoryHeap
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryHeap (((Ptr (FixedArray UUID_SIZE MemoryHeap) -> Ptr MemoryHeap
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @MemoryHeap (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray UUID_SIZE MemoryHeap)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) Ptr MemoryHeap -> Int -> Ptr MemoryHeap
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap)))
    PhysicalDeviceMemoryProperties -> IO PhysicalDeviceMemoryProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceMemoryProperties
 -> IO PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties
-> IO PhysicalDeviceMemoryProperties
forall a b. (a -> b) -> a -> b
$ Word32
-> Vector MemoryType
-> Word32
-> Vector MemoryHeap
-> PhysicalDeviceMemoryProperties
PhysicalDeviceMemoryProperties
             Word32
memoryTypeCount Vector MemoryType
memoryTypes Word32
memoryHeapCount Vector MemoryHeap
memoryHeaps

instance Zero PhysicalDeviceMemoryProperties where
  zero :: PhysicalDeviceMemoryProperties
zero = Word32
-> Vector MemoryType
-> Word32
-> Vector MemoryHeap
-> PhysicalDeviceMemoryProperties
PhysicalDeviceMemoryProperties
           Word32
forall a. Zero a => a
zero
           Vector MemoryType
forall a. Monoid a => a
mempty
           Word32
forall a. Zero a => a
zero
           Vector MemoryHeap
forall a. Monoid a => a
mempty


-- | VkMemoryType - Structure specifying memory type
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MemoryPropertyFlags',
-- 'PhysicalDeviceMemoryProperties'
data MemoryType = MemoryType
  { -- | @propertyFlags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MemoryPropertyFlagBits' of
    -- properties for this memory type.
    MemoryType -> MemoryPropertyFlags
propertyFlags :: MemoryPropertyFlags
  , -- | @heapIndex@ describes which memory heap this memory type corresponds to,
    -- and /must/ be less than @memoryHeapCount@ from the
    -- 'PhysicalDeviceMemoryProperties' structure.
    MemoryType -> Word32
heapIndex :: Word32
  }
  deriving (Typeable, MemoryType -> MemoryType -> Bool
(MemoryType -> MemoryType -> Bool)
-> (MemoryType -> MemoryType -> Bool) -> Eq MemoryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryType -> MemoryType -> Bool
$c/= :: MemoryType -> MemoryType -> Bool
== :: MemoryType -> MemoryType -> Bool
$c== :: MemoryType -> MemoryType -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryType)
#endif
deriving instance Show MemoryType

instance ToCStruct MemoryType where
  withCStruct :: MemoryType -> (Ptr MemoryType -> IO b) -> IO b
withCStruct x :: MemoryType
x f :: Ptr MemoryType -> IO b
f = Int -> Int -> (Ptr MemoryType -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 8 4 ((Ptr MemoryType -> IO b) -> IO b)
-> (Ptr MemoryType -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr MemoryType
p -> Ptr MemoryType -> MemoryType -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryType
p MemoryType
x (Ptr MemoryType -> IO b
f Ptr MemoryType
p)
  pokeCStruct :: Ptr MemoryType -> MemoryType -> IO b -> IO b
pokeCStruct p :: Ptr MemoryType
p MemoryType{..} f :: IO b
f = do
    Ptr MemoryPropertyFlags -> MemoryPropertyFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p Ptr MemoryType -> Int -> Ptr MemoryPropertyFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr MemoryPropertyFlags)) (MemoryPropertyFlags
propertyFlags)
    ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p Ptr MemoryType -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
heapIndex)
    IO b
f
  cStructSize :: Int
cStructSize = 8
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr MemoryType -> IO b -> IO b
pokeZeroCStruct p :: Ptr MemoryType
p f :: IO b
f = do
    ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p Ptr MemoryType -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryType where
  peekCStruct :: Ptr MemoryType -> IO MemoryType
peekCStruct p :: Ptr MemoryType
p = do
    MemoryPropertyFlags
propertyFlags <- Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags
forall a. Storable a => Ptr a -> IO a
peek @MemoryPropertyFlags ((Ptr MemoryType
p Ptr MemoryType -> Int -> Ptr MemoryPropertyFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr MemoryPropertyFlags))
    Word32
heapIndex <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryType
p Ptr MemoryType -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
    MemoryType -> IO MemoryType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryType -> IO MemoryType) -> MemoryType -> IO MemoryType
forall a b. (a -> b) -> a -> b
$ MemoryPropertyFlags -> Word32 -> MemoryType
MemoryType
             MemoryPropertyFlags
propertyFlags Word32
heapIndex

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

instance Zero MemoryType where
  zero :: MemoryType
zero = MemoryPropertyFlags -> Word32 -> MemoryType
MemoryType
           MemoryPropertyFlags
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | VkMemoryHeap - Structure specifying a memory heap
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MemoryHeapFlags',
-- 'PhysicalDeviceMemoryProperties'
data MemoryHeap = MemoryHeap
  { -- | @size@ is the total memory size in bytes in the heap.
    MemoryHeap -> DeviceSize
size :: DeviceSize
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MemoryHeapFlagBits' specifying
    -- attribute flags for the heap.
    MemoryHeap -> MemoryHeapFlags
flags :: MemoryHeapFlags
  }
  deriving (Typeable, MemoryHeap -> MemoryHeap -> Bool
(MemoryHeap -> MemoryHeap -> Bool)
-> (MemoryHeap -> MemoryHeap -> Bool) -> Eq MemoryHeap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryHeap -> MemoryHeap -> Bool
$c/= :: MemoryHeap -> MemoryHeap -> Bool
== :: MemoryHeap -> MemoryHeap -> Bool
$c== :: MemoryHeap -> MemoryHeap -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryHeap)
#endif
deriving instance Show MemoryHeap

instance ToCStruct MemoryHeap where
  withCStruct :: MemoryHeap -> (Ptr MemoryHeap -> IO b) -> IO b
withCStruct x :: MemoryHeap
x f :: Ptr MemoryHeap -> IO b
f = Int -> Int -> (Ptr MemoryHeap -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr MemoryHeap -> IO b) -> IO b)
-> (Ptr MemoryHeap -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr MemoryHeap
p -> Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryHeap
p MemoryHeap
x (Ptr MemoryHeap -> IO b
f Ptr MemoryHeap
p)
  pokeCStruct :: Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
pokeCStruct p :: Ptr MemoryHeap
p MemoryHeap{..} f :: IO b
f = do
    Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr DeviceSize)) (DeviceSize
size)
    Ptr MemoryHeapFlags -> MemoryHeapFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr MemoryHeapFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr MemoryHeapFlags)) (MemoryHeapFlags
flags)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr MemoryHeap -> IO b -> IO b
pokeZeroCStruct p :: Ptr MemoryHeap
p f :: IO b
f = do
    Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryHeap where
  peekCStruct :: Ptr MemoryHeap -> IO MemoryHeap
peekCStruct p :: Ptr MemoryHeap
p = do
    DeviceSize
size <- Ptr DeviceSize -> IO DeviceSize
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr DeviceSize))
    MemoryHeapFlags
flags <- Ptr MemoryHeapFlags -> IO MemoryHeapFlags
forall a. Storable a => Ptr a -> IO a
peek @MemoryHeapFlags ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr MemoryHeapFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr MemoryHeapFlags))
    MemoryHeap -> IO MemoryHeap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryHeap -> IO MemoryHeap) -> MemoryHeap -> IO MemoryHeap
forall a b. (a -> b) -> a -> b
$ DeviceSize -> MemoryHeapFlags -> MemoryHeap
MemoryHeap
             DeviceSize
size MemoryHeapFlags
flags

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

instance Zero MemoryHeap where
  zero :: MemoryHeap
zero = DeviceSize -> MemoryHeapFlags -> MemoryHeap
MemoryHeap
           DeviceSize
forall a. Zero a => a
zero
           MemoryHeapFlags
forall a. Zero a => a
zero


-- | VkFormatProperties - Structure specifying image format properties
--
-- = Description
--
-- Note
--
-- If no format feature flags are supported, the format itself is not
-- supported, and images of that format cannot be created.
--
-- If @format@ is a block-compressed format, then @bufferFeatures@ /must/
-- not support any features for the format.
--
-- If @format@ is not a multi-plane format then @linearTilingFeatures@ and
-- @optimalTilingFeatures@ /must/ not contain
-- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DISJOINT_BIT'.
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FormatFeatureFlags',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.FormatProperties2',
-- 'getPhysicalDeviceFormatProperties'
data FormatProperties = FormatProperties
  { -- | @linearTilingFeatures@ is a bitmask of
    -- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FormatFeatureFlagBits'
    -- specifying features supported by images created with a @tiling@
    -- parameter of 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR'.
    FormatProperties -> FormatFeatureFlags
linearTilingFeatures :: FormatFeatureFlags
  , -- | @optimalTilingFeatures@ is a bitmask of
    -- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FormatFeatureFlagBits'
    -- specifying features supported by images created with a @tiling@
    -- parameter of 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_OPTIMAL'.
    FormatProperties -> FormatFeatureFlags
optimalTilingFeatures :: FormatFeatureFlags
  , -- | @bufferFeatures@ is a bitmask of
    -- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FormatFeatureFlagBits'
    -- specifying features supported by buffers.
    FormatProperties -> FormatFeatureFlags
bufferFeatures :: FormatFeatureFlags
  }
  deriving (Typeable, FormatProperties -> FormatProperties -> Bool
(FormatProperties -> FormatProperties -> Bool)
-> (FormatProperties -> FormatProperties -> Bool)
-> Eq FormatProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatProperties -> FormatProperties -> Bool
$c/= :: FormatProperties -> FormatProperties -> Bool
== :: FormatProperties -> FormatProperties -> Bool
$c== :: FormatProperties -> FormatProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FormatProperties)
#endif
deriving instance Show FormatProperties

instance ToCStruct FormatProperties where
  withCStruct :: FormatProperties
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
withCStruct x :: FormatProperties
x f :: ("pFormatProperties" ::: Ptr FormatProperties) -> IO b
f = Int
-> Int
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 12 4 ((("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b)
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pFormatProperties" ::: Ptr FormatProperties
p -> ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFormatProperties" ::: Ptr FormatProperties
p FormatProperties
x (("pFormatProperties" ::: Ptr FormatProperties) -> IO b
f "pFormatProperties" ::: Ptr FormatProperties
p)
  pokeCStruct :: ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO b -> IO b
pokeCStruct p :: "pFormatProperties" ::: Ptr FormatProperties
p FormatProperties{..} f :: IO b
f = do
    Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
linearTilingFeatures)
    Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
optimalTilingFeatures)
    Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
bufferFeatures)
    IO b
f
  cStructSize :: Int
cStructSize = 12
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: ("pFormatProperties" ::: Ptr FormatProperties) -> IO b -> IO b
pokeZeroCStruct _ f :: IO b
f = IO b
f

instance FromCStruct FormatProperties where
  peekCStruct :: ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
peekCStruct p :: "pFormatProperties" ::: Ptr FormatProperties
p = do
    FormatFeatureFlags
linearTilingFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr FormatFeatureFlags))
    FormatFeatureFlags
optimalTilingFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr FormatFeatureFlags))
    FormatFeatureFlags
bufferFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr FormatFeatureFlags))
    FormatProperties -> IO FormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatProperties -> IO FormatProperties)
-> FormatProperties -> IO FormatProperties
forall a b. (a -> b) -> a -> b
$ FormatFeatureFlags
-> FormatFeatureFlags -> FormatFeatureFlags -> FormatProperties
FormatProperties
             FormatFeatureFlags
linearTilingFeatures FormatFeatureFlags
optimalTilingFeatures FormatFeatureFlags
bufferFeatures

instance Storable FormatProperties where
  sizeOf :: FormatProperties -> Int
sizeOf ~FormatProperties
_ = 12
  alignment :: FormatProperties -> Int
alignment ~FormatProperties
_ = 4
  peek :: ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
peek = ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO ()
poke ptr :: "pFormatProperties" ::: Ptr FormatProperties
ptr poked :: FormatProperties
poked = ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFormatProperties" ::: Ptr FormatProperties
ptr FormatProperties
poked (FN_vkVoidFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero FormatProperties where
  zero :: FormatProperties
zero = FormatFeatureFlags
-> FormatFeatureFlags -> FormatFeatureFlags -> FormatProperties
FormatProperties
           FormatFeatureFlags
forall a. Zero a => a
zero
           FormatFeatureFlags
forall a. Zero a => a
zero
           FormatFeatureFlags
forall a. Zero a => a
zero


-- | VkImageFormatProperties - Structure specifying an image format
-- properties
--
-- = Members
--
-- -   @maxExtent@ are the maximum image dimensions. See the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extentperimagetype Allowed Extent Values>
--     section below for how these values are constrained by @type@.
--
-- -   @maxMipLevels@ is the maximum number of mipmap levels.
--     @maxMipLevels@ /must/ be equal to the number of levels in the
--     complete mipmap chain based on the @maxExtent.width@,
--     @maxExtent.height@, and @maxExtent.depth@, except when one of the
--     following conditions is true, in which case it /may/ instead be @1@:
--
--     -   'getPhysicalDeviceImageFormatProperties'::@tiling@ was
--         'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR'
--
--     -   'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceImageFormatInfo2'::@tiling@
--         was
--         'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_DRM_FORMAT_MODIFIER_EXT'
--
--     -   the
--         'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceImageFormatInfo2'::@pNext@
--         chain included a
--         'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.PhysicalDeviceExternalImageFormatInfo'
--         structure with a handle type included in the @handleTypes@
--         member for which mipmap image support is not required
--
--     -   image @format@ is one of those listed in
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion>
--
--     -   @flags@ contains
--         'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   @maxArrayLayers@ is the maximum number of array layers.
--     @maxArrayLayers@ /must/ be no less than
--     'PhysicalDeviceLimits'::@maxImageArrayLayers@, except when one of
--     the following conditions is true, in which case it /may/ instead be
--     @1@:
--
--     -   @tiling@ is
--         'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR'
--
--     -   @tiling@ is
--         'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_OPTIMAL' and
--         @type@ is 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D'
--
--     -   @format@ is one of those listed in
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion>
--
-- -   If @tiling@ is
--     'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_DRM_FORMAT_MODIFIER_EXT',
--     then @maxArrayLayers@ /must/ not be 0.
--
-- -   @sampleCounts@ is a bitmask of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits'
--     specifying all the supported sample counts for this image as
--     described
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-supported-sample-counts below>.
--
-- -   @maxResourceSize@ is an upper bound on the total image size in
--     bytes, inclusive of all image subresources. Implementations /may/
--     have an address space limit on total size of a resource, which is
--     advertised by this property. @maxResourceSize@ /must/ be at least
--     231.
--
-- = Description
--
-- Note
--
-- There is no mechanism to query the size of an image before creating it,
-- to compare that size against @maxResourceSize@. If an application
-- attempts to create an image that exceeds this limit, the creation will
-- fail and 'Vulkan.Core10.Image.createImage' will return
-- 'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'. While the
-- advertised limit /must/ be at least 231, it /may/ not be possible to
-- create an image that approaches that size, particularly for
-- 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D'.
--
-- If the combination of parameters to
-- 'getPhysicalDeviceImageFormatProperties' is not supported by the
-- implementation for use in 'Vulkan.Core10.Image.createImage', then all
-- members of 'ImageFormatProperties' will be filled with zero.
--
-- Note
--
-- Filling 'ImageFormatProperties' with zero for unsupported formats is an
-- exception to the usual rule that output structures have undefined
-- contents on error. This exception was unintentional, but is preserved
-- for backwards compatibility.
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Extensions.VK_NV_external_memory_capabilities.ExternalImageFormatPropertiesNV',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.ImageFormatProperties2',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlags',
-- 'getPhysicalDeviceImageFormatProperties'
data ImageFormatProperties = ImageFormatProperties
  { -- No documentation found for Nested "VkImageFormatProperties" "maxExtent"
    ImageFormatProperties -> Extent3D
maxExtent :: Extent3D
  , -- No documentation found for Nested "VkImageFormatProperties" "maxMipLevels"
    ImageFormatProperties -> Word32
maxMipLevels :: Word32
  , -- No documentation found for Nested "VkImageFormatProperties" "maxArrayLayers"
    ImageFormatProperties -> Word32
maxArrayLayers :: Word32
  , -- No documentation found for Nested "VkImageFormatProperties" "sampleCounts"
    ImageFormatProperties -> SampleCountFlags
sampleCounts :: SampleCountFlags
  , -- No documentation found for Nested "VkImageFormatProperties" "maxResourceSize"
    ImageFormatProperties -> DeviceSize
maxResourceSize :: DeviceSize
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageFormatProperties)
#endif
deriving instance Show ImageFormatProperties

instance ToCStruct ImageFormatProperties where
  withCStruct :: ImageFormatProperties
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
    -> IO b)
-> IO b
withCStruct x :: ImageFormatProperties
x f :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b
f = Int
-> Int
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
    -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b)
 -> IO b)
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> ImageFormatProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pImageFormatProperties" ::: Ptr ImageFormatProperties
p ImageFormatProperties
x (("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b
f "pImageFormatProperties" ::: Ptr ImageFormatProperties
p)
  pokeCStruct :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> ImageFormatProperties -> IO b -> IO b
pokeCStruct p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p ImageFormatProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Extent3D)) (Extent3D
maxExtent) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
maxMipLevels)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
maxArrayLayers)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SampleCountFlags -> SampleCountFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr SampleCountFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr SampleCountFlags)) (SampleCountFlags
sampleCounts)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) (DeviceSize
maxResourceSize)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct ImageFormatProperties where
  peekCStruct :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties
peekCStruct p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p = do
    Extent3D
maxExtent <- Ptr Extent3D -> IO Extent3D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Extent3D))
    Word32
maxMipLevels <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p