{-# 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 (allocaBytesAligned)
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.Dynamic (DeviceCmds(pVkCreateSemaphore))
import Vulkan.Dynamic (DeviceCmds(pVkDestroySemaphore))
import Vulkan.Core10.Handles (Device_T)
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 Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
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
--
-- '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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                   -- chapter.
                   ("allocator" ::: Maybe AllocationCallbacks)
                -> io (Semaphore)
createSemaphore :: Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore device :: Device
device createInfo :: SemaphoreCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO Semaphore -> io Semaphore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Semaphore -> io Semaphore)
-> (ContT Semaphore IO Semaphore -> IO Semaphore)
-> ContT Semaphore IO Semaphore
-> io Semaphore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Semaphore IO Semaphore -> IO Semaphore
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Semaphore IO Semaphore -> io Semaphore)
-> ContT Semaphore IO Semaphore -> io Semaphore
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 (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT Semaphore IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Semaphore IO ()) -> IO () -> ContT Semaphore 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 (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
vkCreateSemaphorePtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pSemaphore" ::: Ptr Semaphore)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pSemaphore" ::: Ptr Semaphore)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateSemaphore is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr (SemaphoreCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore)
 -> ContT Semaphore IO (Ptr (SemaphoreCreateInfo a)))
-> ((Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore)
-> ContT Semaphore IO (Ptr (SemaphoreCreateInfo a))
forall a b. (a -> b) -> a -> b
$ SemaphoreCreateInfo a
-> (Ptr (SemaphoreCreateInfo a) -> IO Semaphore) -> IO Semaphore
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
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
 -> IO Semaphore)
-> ContT Semaphore 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 Semaphore)
  -> IO Semaphore)
 -> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
    -> IO Semaphore)
-> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
-> IO Semaphore
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pSemaphore" ::: Ptr Semaphore
pPSemaphore <- ((("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
 -> IO Semaphore)
-> ContT Semaphore IO ("pSemaphore" ::: Ptr Semaphore)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
  -> IO Semaphore)
 -> ContT Semaphore IO ("pSemaphore" ::: Ptr Semaphore))
-> ((("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
    -> IO Semaphore)
-> ContT Semaphore IO ("pSemaphore" ::: Ptr Semaphore)
forall a b. (a -> b) -> a -> b
$ IO ("pSemaphore" ::: Ptr Semaphore)
-> (("pSemaphore" ::: Ptr Semaphore) -> IO ())
-> (("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
-> IO Semaphore
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pSemaphore" ::: Ptr Semaphore)
forall a. Int -> IO (Ptr a)
callocBytes @Semaphore 8) ("pSemaphore" ::: Ptr Semaphore) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Semaphore IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Semaphore IO Result)
-> IO Result -> ContT Semaphore IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkCreateSemaphore" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (SemaphoreCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct SemaphoreCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SemaphoreCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pSemaphore" ::: Ptr Semaphore
pPSemaphore))
  IO () -> ContT Semaphore IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Semaphore IO ()) -> IO () -> ContT Semaphore 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))
  Semaphore
pSemaphore <- IO Semaphore -> ContT Semaphore IO Semaphore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Semaphore -> ContT Semaphore IO Semaphore)
-> IO Semaphore -> ContT Semaphore IO Semaphore
forall a b. (a -> b) -> a -> b
$ ("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore
forall a. Storable a => Ptr a -> IO a
peek @Semaphore "pSemaphore" ::: Ptr Semaphore
pPSemaphore
  Semaphore -> ContT Semaphore IO Semaphore
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Semaphore -> ContT Semaphore IO Semaphore)
-> Semaphore -> ContT Semaphore IO Semaphore
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 :: Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Semaphore -> (Semaphore -> io ()) -> r)
-> r
withSemaphore device :: Device
device pCreateInfo :: SemaphoreCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io Semaphore -> (Semaphore -> io ()) -> r
b =
  io Semaphore -> (Semaphore -> io ()) -> r
b (Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
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) -> Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
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
--
-- '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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                    -- chapter.
                    ("allocator" ::: Maybe AllocationCallbacks)
                 -> io ()
destroySemaphore :: Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore device :: Device
device semaphore :: Semaphore
semaphore allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroySemaphorePtr :: FunPtr
  (Ptr Device_T
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroySemaphorePtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Semaphore
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroySemaphore (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  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
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroySemaphorePtr FunPtr
  (Ptr Device_T
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> Semaphore
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Semaphore
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroySemaphore is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent "vkDestroySemaphore" (Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Semaphore
semaphore) "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
$ ()


-- | VkSemaphoreCreateInfo - Structure specifying parameters of a newly
-- created semaphore
--
-- == 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.Core11.Promoted_From_VK_KHR_external_semaphore.ExportSemaphoreCreateInfo',
--     'Vulkan.Extensions.VK_KHR_external_semaphore_win32.ExportSemaphoreWin32HandleInfoKHR',
--     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
--
-- -   #VUID-VkSemaphoreCreateInfo-flags-zerobitmask# @flags@ /must/ be @0@
--
-- = See Also
--
-- '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.
    SemaphoreCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    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 = "SemaphoreCreateInfo"
  setNext :: SemaphoreCreateInfo ds -> Chain es -> SemaphoreCreateInfo es
setNext x :: SemaphoreCreateInfo ds
x next :: Chain es
next = SemaphoreCreateInfo ds
x{$sel:next:SemaphoreCreateInfo :: Chain es
next = Chain es
next}
  getNext :: SemaphoreCreateInfo es -> Chain es
getNext SemaphoreCreateInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
extends _ f :: Extends SemaphoreCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable SemaphoreTypeCreateInfo) =>
Maybe (e :~: SemaphoreTypeCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SemaphoreTypeCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExportSemaphoreWin32HandleInfoKHR) =>
Maybe (e :~: ExportSemaphoreWin32HandleInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreWin32HandleInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExportSemaphoreCreateInfo) =>
Maybe (e :~: ExportSemaphoreCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

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

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

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