{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_EXT_private_data"
module Vulkan.Core13.Promoted_From_VK_EXT_private_data  ( createPrivateDataSlot
                                                        , withPrivateDataSlot
                                                        , destroyPrivateDataSlot
                                                        , setPrivateData
                                                        , getPrivateData
                                                        , DevicePrivateDataCreateInfo(..)
                                                        , PrivateDataSlotCreateInfo(..)
                                                        , PhysicalDevicePrivateDataFeatures(..)
                                                        , PrivateDataSlot(..)
                                                        , PrivateDataSlotCreateFlags(..)
                                                        , StructureType(..)
                                                        , ObjectType(..)
                                                        ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreatePrivateDataSlot))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyPrivateDataSlot))
import Vulkan.Dynamic (DeviceCmds(pVkGetPrivateData))
import Vulkan.Dynamic (DeviceCmds(pVkSetPrivateData))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.ObjectType (ObjectType)
import Vulkan.Core10.Enums.ObjectType (ObjectType(..))
import Vulkan.Core13.Handles (PrivateDataSlot)
import Vulkan.Core13.Handles (PrivateDataSlot(..))
import Vulkan.Core13.Enums.PrivateDataSlotCreateFlags (PrivateDataSlotCreateFlags)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_PRIVATE_DATA_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PRIVATE_DATA_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PRIVATE_DATA_SLOT_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.ObjectType (ObjectType(..))
import Vulkan.Core13.Handles (PrivateDataSlot(..))
import Vulkan.Core13.Enums.PrivateDataSlotCreateFlags (PrivateDataSlotCreateFlags(..))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreatePrivateDataSlot
  :: FunPtr (Ptr Device_T -> Ptr PrivateDataSlotCreateInfo -> Ptr AllocationCallbacks -> Ptr PrivateDataSlot -> IO Result) -> Ptr Device_T -> Ptr PrivateDataSlotCreateInfo -> Ptr AllocationCallbacks -> Ptr PrivateDataSlot -> IO Result

-- | vkCreatePrivateDataSlot - Create a slot for private data storage
--
-- == Valid Usage
--
-- -   #VUID-vkCreatePrivateDataSlot-privateData-04564# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-privateData privateData>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreatePrivateDataSlot-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreatePrivateDataSlot-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'PrivateDataSlotCreateInfo'
--     structure
--
-- -   #VUID-vkCreatePrivateDataSlot-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreatePrivateDataSlot-pPrivateDataSlot-parameter#
--     @pPrivateDataSlot@ /must/ be a valid pointer to a
--     'Vulkan.Core13.Handles.PrivateDataSlot' 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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core13.Handles.PrivateDataSlot',
-- 'PrivateDataSlotCreateInfo'
createPrivateDataSlot :: forall io
                       . (MonadIO io)
                      => -- | @device@ is the logical device associated with the creation of the
                         -- object(s) holding the private data slot.
                         Device
                      -> -- | @pCreateInfo@ is a pointer to a 'PrivateDataSlotCreateInfo'
                         PrivateDataSlotCreateInfo
                      -> -- | @pAllocator@ controls host memory allocation as described in the
                         -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                         -- chapter.
                         ("allocator" ::: Maybe AllocationCallbacks)
                      -> io (PrivateDataSlot)
createPrivateDataSlot :: forall (io :: * -> *).
MonadIO io =>
Device
-> PrivateDataSlotCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io PrivateDataSlot
createPrivateDataSlot Device
device PrivateDataSlotCreateInfo
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO PrivateDataSlot -> io PrivateDataSlot
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrivateDataSlot -> io PrivateDataSlot)
-> (ContT PrivateDataSlot IO PrivateDataSlot -> IO PrivateDataSlot)
-> ContT PrivateDataSlot IO PrivateDataSlot
-> io PrivateDataSlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PrivateDataSlot IO PrivateDataSlot -> IO PrivateDataSlot
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT PrivateDataSlot IO PrivateDataSlot -> io PrivateDataSlot)
-> ContT PrivateDataSlot IO PrivateDataSlot -> io PrivateDataSlot
forall a b. (a -> b) -> a -> b
$ do
  let vkCreatePrivateDataSlotPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO Result)
vkCreatePrivateDataSlotPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
      -> IO Result)
pVkCreatePrivateDataSlot (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT PrivateDataSlot IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PrivateDataSlot IO ())
-> IO () -> ContT PrivateDataSlot IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO Result)
vkCreatePrivateDataSlotPtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> 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 String
"" String
"The function pointer for vkCreatePrivateDataSlot is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreatePrivateDataSlot' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
-> IO Result
vkCreatePrivateDataSlot' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
-> IO Result
mkVkCreatePrivateDataSlot FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO Result)
vkCreatePrivateDataSlotPtr
  "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
pCreateInfo <- ((("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
  -> IO PrivateDataSlot)
 -> IO PrivateDataSlot)
-> ContT
     PrivateDataSlot
     IO
     ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> IO PrivateDataSlot)
  -> IO PrivateDataSlot)
 -> ContT
      PrivateDataSlot
      IO
      ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo))
-> ((("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
     -> IO PrivateDataSlot)
    -> IO PrivateDataSlot)
-> ContT
     PrivateDataSlot
     IO
     ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
forall a b. (a -> b) -> a -> b
$ PrivateDataSlotCreateInfo
-> (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
    -> IO PrivateDataSlot)
-> IO PrivateDataSlot
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PrivateDataSlotCreateInfo
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
     PrivateDataSlot IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO PrivateDataSlot)
 -> IO PrivateDataSlot)
-> ContT
     PrivateDataSlot 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 PrivateDataSlot)
  -> IO PrivateDataSlot)
 -> ContT
      PrivateDataSlot IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
     -> IO PrivateDataSlot)
    -> IO PrivateDataSlot)
-> ContT
     PrivateDataSlot IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
    -> IO PrivateDataSlot)
-> IO PrivateDataSlot
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pPrivateDataSlot" ::: Ptr PrivateDataSlot
pPPrivateDataSlot <- ((("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
  -> IO PrivateDataSlot)
 -> IO PrivateDataSlot)
-> ContT
     PrivateDataSlot IO ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO PrivateDataSlot)
  -> IO PrivateDataSlot)
 -> ContT
      PrivateDataSlot IO ("pPrivateDataSlot" ::: Ptr PrivateDataSlot))
-> ((("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
     -> IO PrivateDataSlot)
    -> IO PrivateDataSlot)
-> ContT
     PrivateDataSlot IO ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
forall a b. (a -> b) -> a -> b
$ IO ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
-> (("pPrivateDataSlot" ::: Ptr PrivateDataSlot) -> IO ())
-> (("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
    -> IO PrivateDataSlot)
-> IO PrivateDataSlot
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @PrivateDataSlot Int
8) ("pPrivateDataSlot" ::: Ptr PrivateDataSlot) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT PrivateDataSlot IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT PrivateDataSlot IO Result)
-> IO Result -> ContT PrivateDataSlot IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreatePrivateDataSlot" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
-> IO Result
vkCreatePrivateDataSlot'
                                                            (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                            "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
pCreateInfo
                                                            "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                            ("pPrivateDataSlot" ::: Ptr PrivateDataSlot
pPPrivateDataSlot))
  IO () -> ContT PrivateDataSlot IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PrivateDataSlot IO ())
-> IO () -> ContT PrivateDataSlot 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))
  PrivateDataSlot
pPrivateDataSlot <- IO PrivateDataSlot -> ContT PrivateDataSlot IO PrivateDataSlot
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PrivateDataSlot -> ContT PrivateDataSlot IO PrivateDataSlot)
-> IO PrivateDataSlot -> ContT PrivateDataSlot IO PrivateDataSlot
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @PrivateDataSlot "pPrivateDataSlot" ::: Ptr PrivateDataSlot
pPPrivateDataSlot
  PrivateDataSlot -> ContT PrivateDataSlot IO PrivateDataSlot
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateDataSlot -> ContT PrivateDataSlot IO PrivateDataSlot)
-> PrivateDataSlot -> ContT PrivateDataSlot IO PrivateDataSlot
forall a b. (a -> b) -> a -> b
$ (PrivateDataSlot
pPrivateDataSlot)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createPrivateDataSlot' and 'destroyPrivateDataSlot'
--
-- To ensure that 'destroyPrivateDataSlot' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withPrivateDataSlot :: forall io r . MonadIO io => Device -> PrivateDataSlotCreateInfo -> Maybe AllocationCallbacks -> (io PrivateDataSlot -> (PrivateDataSlot -> io ()) -> r) -> r
withPrivateDataSlot :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> PrivateDataSlotCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io PrivateDataSlot -> (PrivateDataSlot -> io ()) -> r)
-> r
withPrivateDataSlot Device
device PrivateDataSlotCreateInfo
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io PrivateDataSlot -> (PrivateDataSlot -> io ()) -> r
b =
  io PrivateDataSlot -> (PrivateDataSlot -> io ()) -> r
b (Device
-> PrivateDataSlotCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io PrivateDataSlot
forall (io :: * -> *).
MonadIO io =>
Device
-> PrivateDataSlotCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io PrivateDataSlot
createPrivateDataSlot Device
device PrivateDataSlotCreateInfo
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(PrivateDataSlot
o0) -> Device
-> PrivateDataSlot
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> PrivateDataSlot
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyPrivateDataSlot Device
device PrivateDataSlot
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkDestroyPrivateDataSlot - Destroy a private data slot
--
-- == Valid Usage
--
-- -   #VUID-vkDestroyPrivateDataSlot-privateDataSlot-04062# If
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @privateDataSlot@ was created, a compatible set of
--     callbacks /must/ be provided here
--
-- -   #VUID-vkDestroyPrivateDataSlot-privateDataSlot-04063# If no
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @privateDataSlot@ was created, @pAllocator@ /must/ be
--     @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyPrivateDataSlot-device-parameter# @device@ /must/ be
--     a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyPrivateDataSlot-privateDataSlot-parameter# If
--     @privateDataSlot@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @privateDataSlot@ /must/ be a valid
--     'Vulkan.Core13.Handles.PrivateDataSlot' handle
--
-- -   #VUID-vkDestroyPrivateDataSlot-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyPrivateDataSlot-privateDataSlot-parent# If
--     @privateDataSlot@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @privateDataSlot@ /must/ be externally synchronized
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core13.Handles.PrivateDataSlot'
destroyPrivateDataSlot :: forall io
                        . (MonadIO io)
                       => -- | @device@ is the logical device associated with the creation of the
                          -- object(s) holding the private data slot.
                          Device
                       -> -- | @privateDataSlot@ is the private data slot to destroy.
                          PrivateDataSlot
                       -> -- | @pAllocator@ controls host memory allocation as described in the
                          -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                          -- chapter.
                          ("allocator" ::: Maybe AllocationCallbacks)
                       -> io ()
destroyPrivateDataSlot :: forall (io :: * -> *).
MonadIO io =>
Device
-> PrivateDataSlot
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyPrivateDataSlot Device
device
                         PrivateDataSlot
privateDataSlot
                         "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 vkDestroyPrivateDataSlotPtr :: FunPtr
  (Ptr Device_T
   -> PrivateDataSlot
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyPrivateDataSlotPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> PrivateDataSlot
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyPrivateDataSlot (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 Device_T
   -> PrivateDataSlot
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyPrivateDataSlotPtr FunPtr
  (Ptr Device_T
   -> PrivateDataSlot
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> PrivateDataSlot
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> PrivateDataSlot
   -> ("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 String
"" String
"The function pointer for vkDestroyPrivateDataSlot is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyPrivateDataSlot' :: Ptr Device_T
-> PrivateDataSlot
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyPrivateDataSlot' = FunPtr
  (Ptr Device_T
   -> PrivateDataSlot
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> PrivateDataSlot
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyPrivateDataSlot FunPtr
  (Ptr Device_T
   -> PrivateDataSlot
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyPrivateDataSlotPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
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 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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyPrivateDataSlot" (Ptr Device_T
-> PrivateDataSlot
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyPrivateDataSlot'
                                                        (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                        (PrivateDataSlot
privateDataSlot)
                                                        "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" mkVkSetPrivateData
  :: FunPtr (Ptr Device_T -> ObjectType -> Word64 -> PrivateDataSlot -> Word64 -> IO Result) -> Ptr Device_T -> ObjectType -> Word64 -> PrivateDataSlot -> Word64 -> IO Result

-- | vkSetPrivateData - Associate data with a Vulkan object
--
-- == 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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core10.Enums.ObjectType.ObjectType',
-- 'Vulkan.Core13.Handles.PrivateDataSlot'
setPrivateData :: forall io
                . (MonadIO io)
               => -- | @device@ is the device that created the object.
                  --
                  -- #VUID-vkSetPrivateData-device-parameter# @device@ /must/ be a valid
                  -- 'Vulkan.Core10.Handles.Device' handle
                  Device
               -> -- | @objectType@ is a 'Vulkan.Core10.Enums.ObjectType.ObjectType' specifying
                  -- the type of object to associate data with.
                  --
                  -- #VUID-vkSetPrivateData-objectType-parameter# @objectType@ /must/ be a
                  -- valid 'Vulkan.Core10.Enums.ObjectType.ObjectType' value
                  ObjectType
               -> -- | @objectHandle@ is a handle to the object to associate data with.
                  --
                  -- #VUID-vkSetPrivateData-objectHandle-04016# @objectHandle@ /must/ be
                  -- @device@ or a child of @device@
                  --
                  -- #VUID-vkSetPrivateData-objectHandle-04017# @objectHandle@ /must/ be a
                  -- valid handle to an object of type @objectType@
                  ("objectHandle" ::: Word64)
               -> -- | @privateDataSlot@ is a handle to a
                  -- 'Vulkan.Core13.Handles.PrivateDataSlot' specifying location of private
                  -- data storage.
                  --
                  -- #VUID-vkSetPrivateData-privateDataSlot-parameter# @privateDataSlot@
                  -- /must/ be a valid 'Vulkan.Core13.Handles.PrivateDataSlot' handle
                  --
                  -- #VUID-vkSetPrivateData-privateDataSlot-parent# @privateDataSlot@ /must/
                  -- have been created, allocated, or retrieved from @device@
                  PrivateDataSlot
               -> -- | @data@ is user defined data to associate the object with. This data will
                  -- be stored at @privateDataSlot@.
                  ("data" ::: Word64)
               -> io ()
setPrivateData :: forall (io :: * -> *).
MonadIO io =>
Device
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("objectHandle" ::: Word64)
-> io ()
setPrivateData Device
device
                 ObjectType
objectType
                 "objectHandle" ::: Word64
objectHandle
                 PrivateDataSlot
privateDataSlot
                 "objectHandle" ::: Word64
data' = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkSetPrivateDataPtr :: FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> IO Result)
vkSetPrivateDataPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ObjectType
      -> ("objectHandle" ::: Word64)
      -> PrivateDataSlot
      -> ("objectHandle" ::: Word64)
      -> IO Result)
pVkSetPrivateData (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> IO Result)
vkSetPrivateDataPtr FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ObjectType
      -> ("objectHandle" ::: Word64)
      -> PrivateDataSlot
      -> ("objectHandle" ::: Word64)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> 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 String
"" String
"The function pointer for vkSetPrivateData is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkSetPrivateData' :: Ptr Device_T
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("objectHandle" ::: Word64)
-> IO Result
vkSetPrivateData' = FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> IO Result)
-> Ptr Device_T
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("objectHandle" ::: Word64)
-> IO Result
mkVkSetPrivateData FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> IO Result)
vkSetPrivateDataPtr
  Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkSetPrivateData" (Ptr Device_T
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("objectHandle" ::: Word64)
-> IO Result
vkSetPrivateData'
                                              (Device -> Ptr Device_T
deviceHandle (Device
device))
                                              (ObjectType
objectType)
                                              ("objectHandle" ::: Word64
objectHandle)
                                              (PrivateDataSlot
privateDataSlot)
                                              ("objectHandle" ::: Word64
data'))
  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))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPrivateData
  :: FunPtr (Ptr Device_T -> ObjectType -> Word64 -> PrivateDataSlot -> Ptr Word64 -> IO ()) -> Ptr Device_T -> ObjectType -> Word64 -> PrivateDataSlot -> Ptr Word64 -> IO ()

-- | vkGetPrivateData - Retrieve data associated with a Vulkan object
--
-- = Description
--
-- Note
--
-- Due to platform details on Android, implementations might not be able to
-- reliably return @0@ from calls to 'getPrivateData' for
-- 'Vulkan.Extensions.Handles.SwapchainKHR' objects on which
-- 'setPrivateData' has not previously been called. This erratum is
-- exclusive to the Android platform and objects of type
-- 'Vulkan.Extensions.Handles.SwapchainKHR'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core10.Enums.ObjectType.ObjectType',
-- 'Vulkan.Core13.Handles.PrivateDataSlot'
getPrivateData :: forall io
                . (MonadIO io)
               => -- | @device@ is the device that created the object
                  --
                  -- #VUID-vkGetPrivateData-device-parameter# @device@ /must/ be a valid
                  -- 'Vulkan.Core10.Handles.Device' handle
                  Device
               -> -- | @objectType@ is a 'Vulkan.Core10.Enums.ObjectType.ObjectType' specifying
                  -- the type of object data is associated with.
                  --
                  -- #VUID-vkGetPrivateData-objectType-04018# @objectType@ /must/ be
                  -- 'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_DEVICE', or an object type
                  -- whose parent is 'Vulkan.Core10.Handles.Device'
                  --
                  -- #VUID-vkGetPrivateData-objectType-parameter# @objectType@ /must/ be a
                  -- valid 'Vulkan.Core10.Enums.ObjectType.ObjectType' value
                  ObjectType
               -> -- | @objectHandle@ is a handle to the object data is associated with.
                  ("objectHandle" ::: Word64)
               -> -- | @privateDataSlot@ is a handle to a
                  -- 'Vulkan.Core13.Handles.PrivateDataSlot' specifying location of private
                  -- data pointer storage.
                  --
                  -- #VUID-vkGetPrivateData-privateDataSlot-parameter# @privateDataSlot@
                  -- /must/ be a valid 'Vulkan.Core13.Handles.PrivateDataSlot' handle
                  --
                  -- #VUID-vkGetPrivateData-privateDataSlot-parent# @privateDataSlot@ /must/
                  -- have been created, allocated, or retrieved from @device@
                  PrivateDataSlot
               -> io (("data" ::: Word64))
getPrivateData :: forall (io :: * -> *).
MonadIO io =>
Device
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> io ("objectHandle" ::: Word64)
getPrivateData Device
device
                 ObjectType
objectType
                 "objectHandle" ::: Word64
objectHandle
                 PrivateDataSlot
privateDataSlot = IO ("objectHandle" ::: Word64) -> io ("objectHandle" ::: Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("objectHandle" ::: Word64) -> io ("objectHandle" ::: Word64))
-> (ContT
      ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
    -> IO ("objectHandle" ::: Word64))
-> ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
-> io ("objectHandle" ::: Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
-> IO ("objectHandle" ::: Word64)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
 -> io ("objectHandle" ::: Word64))
-> ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
-> io ("objectHandle" ::: Word64)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPrivateDataPtr :: FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ())
vkGetPrivateDataPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ObjectType
      -> ("objectHandle" ::: Word64)
      -> PrivateDataSlot
      -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
      -> IO ())
pVkGetPrivateData (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT ("objectHandle" ::: Word64) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("objectHandle" ::: Word64) IO ())
-> IO () -> ContT ("objectHandle" ::: Word64) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ())
vkGetPrivateDataPtr FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> ObjectType
      -> ("objectHandle" ::: Word64)
      -> PrivateDataSlot
      -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> 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 String
"" String
"The function pointer for vkGetPrivateData is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPrivateData' :: Ptr Device_T
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("pData" ::: Ptr ("objectHandle" ::: Word64))
-> IO ()
vkGetPrivateData' = FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ())
-> Ptr Device_T
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("pData" ::: Ptr ("objectHandle" ::: Word64))
-> IO ()
mkVkGetPrivateData FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ())
vkGetPrivateDataPtr
  "pData" ::: Ptr ("objectHandle" ::: Word64)
pPData <- ((("pData" ::: Ptr ("objectHandle" ::: Word64))
  -> IO ("objectHandle" ::: Word64))
 -> IO ("objectHandle" ::: Word64))
-> ContT
     ("objectHandle" ::: Word64)
     IO
     ("pData" ::: Ptr ("objectHandle" ::: Word64))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ("objectHandle" ::: Word64))
  -> IO ("objectHandle" ::: Word64))
 -> ContT
      ("objectHandle" ::: Word64)
      IO
      ("pData" ::: Ptr ("objectHandle" ::: Word64)))
-> ((("pData" ::: Ptr ("objectHandle" ::: Word64))
     -> IO ("objectHandle" ::: Word64))
    -> IO ("objectHandle" ::: Word64))
-> ContT
     ("objectHandle" ::: Word64)
     IO
     ("pData" ::: Ptr ("objectHandle" ::: Word64))
forall a b. (a -> b) -> a -> b
$ IO ("pData" ::: Ptr ("objectHandle" ::: Word64))
-> (("pData" ::: Ptr ("objectHandle" ::: Word64)) -> IO ())
-> (("pData" ::: Ptr ("objectHandle" ::: Word64))
    -> IO ("objectHandle" ::: Word64))
-> IO ("objectHandle" ::: Word64)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word64 Int
8) ("pData" ::: Ptr ("objectHandle" ::: Word64)) -> IO ()
forall a. Ptr a -> IO ()
free
  IO () -> ContT ("objectHandle" ::: Word64) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("objectHandle" ::: Word64) IO ())
-> IO () -> ContT ("objectHandle" ::: Word64) IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPrivateData" (Ptr Device_T
-> ObjectType
-> ("objectHandle" ::: Word64)
-> PrivateDataSlot
-> ("pData" ::: Ptr ("objectHandle" ::: Word64))
-> IO ()
vkGetPrivateData'
                                                (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                (ObjectType
objectType)
                                                ("objectHandle" ::: Word64
objectHandle)
                                                (PrivateDataSlot
privateDataSlot)
                                                ("pData" ::: Ptr ("objectHandle" ::: Word64)
pPData))
  "objectHandle" ::: Word64
pData <- IO ("objectHandle" ::: Word64)
-> ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("objectHandle" ::: Word64)
 -> ContT
      ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64))
-> IO ("objectHandle" ::: Word64)
-> ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word64 "pData" ::: Ptr ("objectHandle" ::: Word64)
pPData
  ("objectHandle" ::: Word64)
-> ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("objectHandle" ::: Word64)
 -> ContT
      ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64))
-> ("objectHandle" ::: Word64)
-> ContT ("objectHandle" ::: Word64) IO ("objectHandle" ::: Word64)
forall a b. (a -> b) -> a -> b
$ ("objectHandle" ::: Word64
pData)


-- | VkDevicePrivateDataCreateInfo - Reserve private data slots
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DevicePrivateDataCreateInfo = DevicePrivateDataCreateInfo
  { -- | @privateDataSlotRequestCount@ is the amount of slots to reserve.
    DevicePrivateDataCreateInfo -> Word32
privateDataSlotRequestCount :: Word32 }
  deriving (Typeable, DevicePrivateDataCreateInfo -> DevicePrivateDataCreateInfo -> Bool
(DevicePrivateDataCreateInfo
 -> DevicePrivateDataCreateInfo -> Bool)
-> (DevicePrivateDataCreateInfo
    -> DevicePrivateDataCreateInfo -> Bool)
-> Eq DevicePrivateDataCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DevicePrivateDataCreateInfo -> DevicePrivateDataCreateInfo -> Bool
$c/= :: DevicePrivateDataCreateInfo -> DevicePrivateDataCreateInfo -> Bool
== :: DevicePrivateDataCreateInfo -> DevicePrivateDataCreateInfo -> Bool
$c== :: DevicePrivateDataCreateInfo -> DevicePrivateDataCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DevicePrivateDataCreateInfo)
#endif
deriving instance Show DevicePrivateDataCreateInfo

instance ToCStruct DevicePrivateDataCreateInfo where
  withCStruct :: forall b.
DevicePrivateDataCreateInfo
-> (Ptr DevicePrivateDataCreateInfo -> IO b) -> IO b
withCStruct DevicePrivateDataCreateInfo
x Ptr DevicePrivateDataCreateInfo -> IO b
f = Int -> (Ptr DevicePrivateDataCreateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr DevicePrivateDataCreateInfo -> IO b) -> IO b)
-> (Ptr DevicePrivateDataCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr DevicePrivateDataCreateInfo
p -> Ptr DevicePrivateDataCreateInfo
-> DevicePrivateDataCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DevicePrivateDataCreateInfo
p DevicePrivateDataCreateInfo
x (Ptr DevicePrivateDataCreateInfo -> IO b
f Ptr DevicePrivateDataCreateInfo
p)
  pokeCStruct :: forall b.
Ptr DevicePrivateDataCreateInfo
-> DevicePrivateDataCreateInfo -> IO b -> IO b
pokeCStruct Ptr DevicePrivateDataCreateInfo
p DevicePrivateDataCreateInfo{Word32
privateDataSlotRequestCount :: Word32
$sel:privateDataSlotRequestCount:DevicePrivateDataCreateInfo :: DevicePrivateDataCreateInfo -> Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_PRIVATE_DATA_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
privateDataSlotRequestCount)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr DevicePrivateDataCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr DevicePrivateDataCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_PRIVATE_DATA_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DevicePrivateDataCreateInfo where
  peekCStruct :: Ptr DevicePrivateDataCreateInfo -> IO DevicePrivateDataCreateInfo
peekCStruct Ptr DevicePrivateDataCreateInfo
p = do
    Word32
privateDataSlotRequestCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DevicePrivateDataCreateInfo
p Ptr DevicePrivateDataCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    DevicePrivateDataCreateInfo -> IO DevicePrivateDataCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DevicePrivateDataCreateInfo -> IO DevicePrivateDataCreateInfo)
-> DevicePrivateDataCreateInfo -> IO DevicePrivateDataCreateInfo
forall a b. (a -> b) -> a -> b
$ Word32 -> DevicePrivateDataCreateInfo
DevicePrivateDataCreateInfo
             Word32
privateDataSlotRequestCount

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

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


-- | VkPrivateDataSlotCreateInfo - Structure specifying the parameters of
-- private data slot construction
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core13.Enums.PrivateDataSlotCreateFlags.PrivateDataSlotCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'createPrivateDataSlot',
-- 'Vulkan.Extensions.VK_EXT_private_data.createPrivateDataSlotEXT'
data PrivateDataSlotCreateInfo = PrivateDataSlotCreateInfo
  { -- | @flags@ is reserved for future use.
    --
    -- #VUID-VkPrivateDataSlotCreateInfo-flags-zerobitmask# @flags@ /must/ be
    -- @0@
    PrivateDataSlotCreateInfo -> PrivateDataSlotCreateFlags
flags :: PrivateDataSlotCreateFlags }
  deriving (Typeable, PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool
(PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool)
-> (PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool)
-> Eq PrivateDataSlotCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool
$c/= :: PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool
== :: PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool
$c== :: PrivateDataSlotCreateInfo -> PrivateDataSlotCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PrivateDataSlotCreateInfo)
#endif
deriving instance Show PrivateDataSlotCreateInfo

instance ToCStruct PrivateDataSlotCreateInfo where
  withCStruct :: forall b.
PrivateDataSlotCreateInfo
-> (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b)
-> IO b
withCStruct PrivateDataSlotCreateInfo
x ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b
f = Int
-> (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b)
 -> IO b)
-> (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> PrivateDataSlotCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p PrivateDataSlotCreateInfo
x (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b
f "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p)
  pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> PrivateDataSlotCreateInfo -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p PrivateDataSlotCreateInfo{PrivateDataSlotCreateFlags
flags :: PrivateDataSlotCreateFlags
$sel:flags:PrivateDataSlotCreateInfo :: PrivateDataSlotCreateInfo -> PrivateDataSlotCreateFlags
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRIVATE_DATA_SLOT_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr PrivateDataSlotCreateFlags
-> PrivateDataSlotCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr PrivateDataSlotCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PrivateDataSlotCreateFlags)) (PrivateDataSlotCreateFlags
flags)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRIVATE_DATA_SLOT_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr PrivateDataSlotCreateFlags
-> PrivateDataSlotCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr PrivateDataSlotCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PrivateDataSlotCreateFlags)) (PrivateDataSlotCreateFlags
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PrivateDataSlotCreateInfo where
  peekCStruct :: ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> IO PrivateDataSlotCreateInfo
peekCStruct "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p = do
    PrivateDataSlotCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @PrivateDataSlotCreateFlags (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> Int -> Ptr PrivateDataSlotCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PrivateDataSlotCreateFlags))
    PrivateDataSlotCreateInfo -> IO PrivateDataSlotCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateDataSlotCreateInfo -> IO PrivateDataSlotCreateInfo)
-> PrivateDataSlotCreateInfo -> IO PrivateDataSlotCreateInfo
forall a b. (a -> b) -> a -> b
$ PrivateDataSlotCreateFlags -> PrivateDataSlotCreateInfo
PrivateDataSlotCreateInfo
             PrivateDataSlotCreateFlags
flags

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

instance Zero PrivateDataSlotCreateInfo where
  zero :: PrivateDataSlotCreateInfo
zero = PrivateDataSlotCreateFlags -> PrivateDataSlotCreateInfo
PrivateDataSlotCreateInfo
           PrivateDataSlotCreateFlags
forall a. Zero a => a
zero


-- | VkPhysicalDevicePrivateDataFeatures - Structure specifying physical
-- device support
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDevicePrivateDataFeatures' structure is included in the
-- @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDevicePrivateDataFeatures' /can/ also be used in the
-- @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively
-- enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_private_data VK_EXT_private_data>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePrivateDataFeatures = PhysicalDevicePrivateDataFeatures
  { -- | #extension-features-privateData# @privateData@ indicates whether the
    -- implementation supports private data. See
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#private-data Private Data>.
    PhysicalDevicePrivateDataFeatures -> Bool
privateData :: Bool }
  deriving (Typeable, PhysicalDevicePrivateDataFeatures
-> PhysicalDevicePrivateDataFeatures -> Bool
(PhysicalDevicePrivateDataFeatures
 -> PhysicalDevicePrivateDataFeatures -> Bool)
-> (PhysicalDevicePrivateDataFeatures
    -> PhysicalDevicePrivateDataFeatures -> Bool)
-> Eq PhysicalDevicePrivateDataFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePrivateDataFeatures
-> PhysicalDevicePrivateDataFeatures -> Bool
$c/= :: PhysicalDevicePrivateDataFeatures
-> PhysicalDevicePrivateDataFeatures -> Bool
== :: PhysicalDevicePrivateDataFeatures
-> PhysicalDevicePrivateDataFeatures -> Bool
$c== :: PhysicalDevicePrivateDataFeatures
-> PhysicalDevicePrivateDataFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePrivateDataFeatures)
#endif
deriving instance Show PhysicalDevicePrivateDataFeatures

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

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

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

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