{-# language CPP #-}
-- No documentation found for Chapter "QueueSemaphore"
module Vulkan.Core10.QueueSemaphore  ( createSemaphore
                                     , withSemaphore
                                     , destroySemaphore
                                     , SemaphoreCreateInfo(..)
                                     , Semaphore(..)
                                     , SemaphoreCreateFlags(..)
                                     ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
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 (castPtr)
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.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateSemaphore))
import Vulkan.Dynamic (DeviceCmds(pVkDestroySemaphore))
import Vulkan.Core10.Handles (Device_T)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ExportMetalObjectCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_external_semaphore (ExportSemaphoreCreateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_semaphore_win32 (ExportSemaphoreWin32HandleInfoKHR)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ImportMetalSharedEventInfoEXT)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_low_latency (QueryLowLatencySupportNV)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (Semaphore)
import Vulkan.Core10.Handles (Semaphore(..))
import Vulkan.Core10.Enums.SemaphoreCreateFlags (SemaphoreCreateFlags)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (SemaphoreTypeCreateInfo)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Semaphore(..))
import Vulkan.Core10.Enums.SemaphoreCreateFlags (SemaphoreCreateFlags(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateSemaphore
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct SemaphoreCreateInfo) -> Ptr AllocationCallbacks -> Ptr Semaphore -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct SemaphoreCreateInfo) -> Ptr AllocationCallbacks -> Ptr Semaphore -> IO Result

-- | vkCreateSemaphore - Create a new queue semaphore object
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateSemaphore-device-parameter# @device@ /must/ be a valid
--     'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateSemaphore-pCreateInfo-parameter# @pCreateInfo@ /must/
--     be a valid pointer to a valid 'SemaphoreCreateInfo' structure
--
-- -   #VUID-vkCreateSemaphore-pAllocator-parameter# If @pAllocator@ is not
--     @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateSemaphore-pSemaphore-parameter# @pSemaphore@ /must/ be
--     a valid pointer to a 'Vulkan.Core10.Handles.Semaphore' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Semaphore',
-- 'SemaphoreCreateInfo'
createSemaphore :: forall a io
                 . (Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io)
                => -- | @device@ is the logical device that creates the semaphore.
                   Device
                -> -- | @pCreateInfo@ is a pointer to a 'SemaphoreCreateInfo' structure
                   -- containing information about how the semaphore is to be created.
                   (SemaphoreCreateInfo a)
                -> -- | @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 (Semaphore)
createSemaphore :: forall (a :: [*]) (io :: * -> *).
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore Device
device SemaphoreCreateInfo a
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 vkCreateSemaphorePtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
vkCreateSemaphorePtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pSemaphore" ::: Ptr Semaphore)
      -> IO Result)
pVkCreateSemaphore (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 (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
vkCreateSemaphorePtr 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 vkCreateSemaphore is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateSemaphore' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
mkVkCreateSemaphore FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
vkCreateSemaphorePtr
  Ptr (SemaphoreCreateInfo a)
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 (SemaphoreCreateInfo a
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)
  "pSemaphore" ::: Ptr Semaphore
pPSemaphore <- 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 @Semaphore 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
"vkCreateSemaphore" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore'
                                                      (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                      (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SemaphoreCreateInfo a)
pCreateInfo)
                                                      "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                      ("pSemaphore" ::: Ptr Semaphore
pPSemaphore))
  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))
  Semaphore
pSemaphore <- 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 @Semaphore "pSemaphore" ::: Ptr Semaphore
pPSemaphore
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Semaphore
pSemaphore)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createSemaphore' and 'destroySemaphore'
--
-- To ensure that 'destroySemaphore' 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.
--
withSemaphore :: forall a io r . (Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) => Device -> SemaphoreCreateInfo a -> Maybe AllocationCallbacks -> (io Semaphore -> (Semaphore -> io ()) -> r) -> r
withSemaphore :: forall (a :: [*]) (io :: * -> *) r.
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Semaphore -> (Semaphore -> io ()) -> r)
-> r
withSemaphore Device
device SemaphoreCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io Semaphore -> (Semaphore -> io ()) -> r
b =
  io Semaphore -> (Semaphore -> io ()) -> r
b (forall (a :: [*]) (io :: * -> *).
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore Device
device SemaphoreCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(Semaphore
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore Device
device Semaphore
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkDestroySemaphore - Destroy a semaphore object
--
-- == Valid Usage
--
-- -   #VUID-vkDestroySemaphore-semaphore-01137# All submitted batches that
--     refer to @semaphore@ /must/ have completed execution
--
-- -   #VUID-vkDestroySemaphore-semaphore-01138# If
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @semaphore@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   #VUID-vkDestroySemaphore-semaphore-01139# If no
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @semaphore@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroySemaphore-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroySemaphore-semaphore-parameter# If @semaphore@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @semaphore@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Semaphore' handle
--
-- -   #VUID-vkDestroySemaphore-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroySemaphore-semaphore-parent# If @semaphore@ is a valid
--     handle, it /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Host Synchronization
--
-- -   Host access to @semaphore@ /must/ be externally synchronized
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Semaphore'
destroySemaphore :: forall io
                  . (MonadIO io)
                 => -- | @device@ is the logical device that destroys the semaphore.
                    Device
                 -> -- | @semaphore@ is the handle of the semaphore to destroy.
                    Semaphore
                 -> -- | @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 ()
destroySemaphore :: forall (io :: * -> *).
MonadIO io =>
Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore Device
device Semaphore
semaphore "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 vkDestroySemaphorePtr :: FunPtr
  (Ptr Device_T
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroySemaphorePtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Semaphore
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroySemaphore (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
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroySemaphorePtr 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 vkDestroySemaphore is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroySemaphore' :: Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore' = FunPtr
  (Ptr Device_T
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroySemaphore FunPtr
  (Ptr Device_T
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroySemaphorePtr
  "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
"vkDestroySemaphore" (Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore'
                                                  (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                  (Semaphore
semaphore)
                                                  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


-- | VkSemaphoreCreateInfo - Structure specifying parameters of a newly
-- created semaphore
--
-- == Valid Usage
--
-- -   #VUID-VkSemaphoreCreateInfo-pNext-06789# If the @pNext@ chain
--     includes a
--     'Vulkan.Extensions.VK_EXT_metal_objects.ExportMetalObjectCreateInfoEXT'
--     structure, its @exportObjectType@ member /must/ be
--     'Vulkan.Extensions.VK_EXT_metal_objects.EXPORT_METAL_OBJECT_TYPE_METAL_SHARED_EVENT_BIT_EXT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSemaphoreCreateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO'
--
-- -   #VUID-VkSemaphoreCreateInfo-pNext-pNext# Each @pNext@ member of any
--     structure (including this one) in the @pNext@ chain /must/ be either
--     @NULL@ or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_metal_objects.ExportMetalObjectCreateInfoEXT',
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_semaphore.ExportSemaphoreCreateInfo',
--     'Vulkan.Extensions.VK_KHR_external_semaphore_win32.ExportSemaphoreWin32HandleInfoKHR',
--     'Vulkan.Extensions.VK_EXT_metal_objects.ImportMetalSharedEventInfoEXT',
--     'Vulkan.Extensions.VK_NV_low_latency.QueryLowLatencySupportNV', or
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.SemaphoreTypeCreateInfo'
--
-- -   #VUID-VkSemaphoreCreateInfo-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique, with the exception of
--     structures of type
--     'Vulkan.Extensions.VK_EXT_metal_objects.ExportMetalObjectCreateInfoEXT'
--
-- -   #VUID-VkSemaphoreCreateInfo-flags-zerobitmask# @flags@ /must/ be @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.SemaphoreCreateFlags.SemaphoreCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createSemaphore'
data SemaphoreCreateInfo (es :: [Type]) = SemaphoreCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SemaphoreCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SemaphoreCreateInfo es)

instance Extensible SemaphoreCreateInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"SemaphoreCreateInfo"
  setNext :: forall (ds :: [*]) (es :: [*]).
SemaphoreCreateInfo ds -> Chain es -> SemaphoreCreateInfo es
setNext SemaphoreCreateInfo{Chain ds
SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
next :: Chain ds
$sel:flags:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
$sel:next:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
..} Chain es
next' = SemaphoreCreateInfo{$sel:next:SemaphoreCreateInfo :: Chain es
next = Chain es
next', SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
$sel:flags:SemaphoreCreateInfo :: SemaphoreCreateFlags
..}
  getNext :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
getNext SemaphoreCreateInfo{Chain es
SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
next :: Chain es
$sel:flags:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
$sel:next:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends SemaphoreCreateInfo e => b
f
    | Just e :~: QueryLowLatencySupportNV
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @QueryLowLatencySupportNV = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
    | Just e :~: ImportMetalSharedEventInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportMetalSharedEventInfoEXT = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
    | Just e :~: ExportMetalObjectCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMetalObjectCreateInfoEXT = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
    | Just e :~: SemaphoreTypeCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SemaphoreTypeCreateInfo = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
    | Just e :~: ExportSemaphoreWin32HandleInfoKHR
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreWin32HandleInfoKHR = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
    | Just e :~: ExportSemaphoreCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreCreateInfo = forall a. a -> Maybe a
Just Extends SemaphoreCreateInfo e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss SemaphoreCreateInfo es
         , PokeChain es ) => ToCStruct (SemaphoreCreateInfo es) where
  withCStruct :: forall b.
SemaphoreCreateInfo es
-> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
withCStruct SemaphoreCreateInfo es
x Ptr (SemaphoreCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr (SemaphoreCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SemaphoreCreateInfo es)
p SemaphoreCreateInfo es
x (Ptr (SemaphoreCreateInfo es) -> IO b
f Ptr (SemaphoreCreateInfo es)
p)
  pokeCStruct :: forall b.
Ptr (SemaphoreCreateInfo es)
-> SemaphoreCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (SemaphoreCreateInfo es)
p SemaphoreCreateInfo{Chain es
SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
next :: Chain es
$sel:flags:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> SemaphoreCreateFlags
$sel:next:SemaphoreCreateInfo :: forall (es :: [*]). SemaphoreCreateInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    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 -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    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 -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreCreateFlags)) (SemaphoreCreateFlags
flags)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (SemaphoreCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (SemaphoreCreateInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    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 -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance ( Extendss SemaphoreCreateInfo es
         , PeekChain es ) => FromCStruct (SemaphoreCreateInfo es) where
  peekCStruct :: Ptr (SemaphoreCreateInfo es) -> IO (SemaphoreCreateInfo es)
peekCStruct Ptr (SemaphoreCreateInfo es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    SemaphoreCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @SemaphoreCreateFlags ((Ptr (SemaphoreCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreCreateFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
             Chain es
next SemaphoreCreateFlags
flags

instance es ~ '[] => Zero (SemaphoreCreateInfo es) where
  zero :: SemaphoreCreateInfo es
zero = forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
           ()
           forall a. Zero a => a
zero