{-# 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT 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)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPrivateDataSlot" ::: Ptr PrivateDataSlot)
   -> IO Result)
vkCreatePrivateDataSlotPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreatePrivateDataSlot is null" forall a. Maybe a
Nothing 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 <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pPrivateDataSlot" ::: Ptr PrivateDataSlot
pPPrivateDataSlot <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ 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) forall a. Ptr a -> IO ()
free
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  PrivateDataSlot
pPrivateDataSlot <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @PrivateDataSlot "pPrivateDataSlot" ::: Ptr PrivateDataSlot
pPPrivateDataSlot
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 (forall (io :: * -> *).
MonadIO io =>
Device
-> PrivateDataSlotCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io PrivateDataSlot
createPrivateDataSlot Device
device PrivateDataSlotCreateInfo
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(PrivateDataSlot
o0) -> 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT 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)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> PrivateDataSlot
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyPrivateDataSlotPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyPrivateDataSlot is null" forall a. Maybe a
Nothing 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("objectHandle" ::: Word64)
   -> IO Result)
vkSetPrivateDataPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkSetPrivateData is null" forall a. Maybe a
Nothing 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 <- 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'))
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT 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)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ObjectType
   -> ("objectHandle" ::: Word64)
   -> PrivateDataSlot
   -> ("pData" ::: Ptr ("objectHandle" ::: Word64))
   -> IO ())
vkGetPrivateDataPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPrivateData is null" forall a. Maybe a
Nothing 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 <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ 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) forall a. Ptr a -> IO ()
free
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word64 "pData" ::: Ptr ("objectHandle" ::: Word64)
pPData
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
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 = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr DevicePrivateDataCreateInfo
p -> 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_PRIVATE_DATA_CREATE_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_PRIVATE_DATA_CREATE_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DevicePrivateDataCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr DevicePrivateDataCreateInfo
-> DevicePrivateDataCreateInfo -> IO ()
poke Ptr DevicePrivateDataCreateInfo
ptr DevicePrivateDataCreateInfo
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DevicePrivateDataCreateInfo
ptr DevicePrivateDataCreateInfo
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero DevicePrivateDataCreateInfo where
  zero :: DevicePrivateDataCreateInfo
zero = Word32 -> DevicePrivateDataCreateInfo
DevicePrivateDataCreateInfo
           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
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 = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p -> 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRIVATE_DATA_SLOT_CREATE_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRIVATE_DATA_SLOT_CREATE_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PrivateDataSlotCreateFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo)
-> PrivateDataSlotCreateInfo -> IO ()
poke "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
ptr PrivateDataSlotCreateInfo
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr PrivateDataSlotCreateInfo
ptr PrivateDataSlotCreateInfo
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PrivateDataSlotCreateInfo where
  zero :: PrivateDataSlotCreateInfo
zero = PrivateDataSlotCreateFlags -> PrivateDataSlotCreateInfo
PrivateDataSlotCreateInfo
           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
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 = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePrivateDataFeatures
p -> 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePrivateDataFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PRIVATE_DATA_FEATURES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePrivateDataFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePrivateDataFeatures
p 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePrivateDataFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PRIVATE_DATA_FEATURES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePrivateDataFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePrivateDataFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDevicePrivateDataFeatures
-> PhysicalDevicePrivateDataFeatures -> IO ()
poke Ptr PhysicalDevicePrivateDataFeatures
ptr PhysicalDevicePrivateDataFeatures
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePrivateDataFeatures
ptr PhysicalDevicePrivateDataFeatures
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

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