{-# language CPP #-}
-- No documentation found for Chapter "Event"
module Vulkan.Core10.Event  ( createEvent
                            , withEvent
                            , destroyEvent
                            , getEventStatus
                            , setEvent
                            , resetEvent
                            , EventCreateInfo(..)
                            , Event(..)
                            , EventCreateFlagBits(..)
                            , EventCreateFlags
                            ) 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(pVkCreateEvent))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyEvent))
import Vulkan.Dynamic (DeviceCmds(pVkGetEventStatus))
import Vulkan.Dynamic (DeviceCmds(pVkResetEvent))
import Vulkan.Dynamic (DeviceCmds(pVkSetEvent))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Handles (Event)
import Vulkan.Core10.Handles (Event(..))
import Vulkan.Core10.Enums.EventCreateFlagBits (EventCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ExportMetalObjectCreateInfoEXT)
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 Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EVENT_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Event(..))
import Vulkan.Core10.Enums.EventCreateFlagBits (EventCreateFlagBits(..))
import Vulkan.Core10.Enums.EventCreateFlagBits (EventCreateFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateEvent
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct EventCreateInfo) -> Ptr AllocationCallbacks -> Ptr Event -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct EventCreateInfo) -> Ptr AllocationCallbacks -> Ptr Event -> IO Result

-- | vkCreateEvent - Create a new event object
--
-- = Description
--
-- When created, the event object is in the unsignaled state.
--
-- == Valid Usage
--
-- -   #VUID-vkCreateEvent-events-04468# If the @VK_KHR_portability_subset@
--     extension is enabled, and
--     'Vulkan.Extensions.VK_KHR_portability_subset.PhysicalDevicePortabilitySubsetFeaturesKHR'::@events@
--     is 'Vulkan.Core10.FundamentalTypes.FALSE', then the implementation
--     does not support
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-events events>,
--     and 'createEvent' /must/ not be used
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateEvent-device-parameter# @device@ /must/ be a valid
--     'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateEvent-pCreateInfo-parameter# @pCreateInfo@ /must/ be a
--     valid pointer to a valid 'EventCreateInfo' structure
--
-- -   #VUID-vkCreateEvent-pAllocator-parameter# If @pAllocator@ is not
--     @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateEvent-pEvent-parameter# @pEvent@ /must/ be a valid
--     pointer to a 'Vulkan.Core10.Handles.Event' 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.Event',
-- 'EventCreateInfo'
createEvent :: forall a io
             . (Extendss EventCreateInfo a, PokeChain a, MonadIO io)
            => -- | @device@ is the logical device that creates the event.
               Device
            -> -- | @pCreateInfo@ is a pointer to a 'EventCreateInfo' structure containing
               -- information about how the event is to be created.
               (EventCreateInfo 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 (Event)
createEvent :: forall (a :: [*]) (io :: * -> *).
(Extendss EventCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> EventCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Event
createEvent Device
device EventCreateInfo 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 vkCreateEventPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pEvent" ::: Ptr Event)
   -> IO Result)
vkCreateEventPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pEvent" ::: Ptr Event)
      -> IO Result)
pVkCreateEvent (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 EventCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pEvent" ::: Ptr Event)
   -> IO Result)
vkCreateEventPtr 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 vkCreateEvent is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateEvent' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result
vkCreateEvent' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pEvent" ::: Ptr Event)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result
mkVkCreateEvent FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pEvent" ::: Ptr Event)
   -> IO Result)
vkCreateEventPtr
  Ptr (EventCreateInfo 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 (EventCreateInfo 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)
  "pEvent" ::: Ptr Event
pPEvent <- 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 @Event 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
"vkCreateEvent" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result
vkCreateEvent'
                                                  (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                  (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (EventCreateInfo a)
pCreateInfo)
                                                  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                  ("pEvent" ::: Ptr Event
pPEvent))
  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))
  Event
pEvent <- 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 @Event "pEvent" ::: Ptr Event
pPEvent
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Event
pEvent)

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


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

-- | vkDestroyEvent - Destroy an event object
--
-- == Valid Usage
--
-- -   #VUID-vkDestroyEvent-event-01145# All submitted commands that refer
--     to @event@ /must/ have completed execution
--
-- -   #VUID-vkDestroyEvent-event-01146# If
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @event@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   #VUID-vkDestroyEvent-event-01147# If no
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @event@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyEvent-device-parameter# @device@ /must/ be a valid
--     'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyEvent-event-parameter# If @event@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @event@ /must/ be a valid
--     'Vulkan.Core10.Handles.Event' handle
--
-- -   #VUID-vkDestroyEvent-pAllocator-parameter# If @pAllocator@ is not
--     @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyEvent-event-parent# If @event@ is a valid handle, it
--     /must/ have been created, allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @event@ /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.Event'
destroyEvent :: forall io
              . (MonadIO io)
             => -- | @device@ is the logical device that destroys the event.
                Device
             -> -- | @event@ is the handle of the event to destroy.
                Event
             -> -- | @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 ()
destroyEvent :: forall (io :: * -> *).
MonadIO io =>
Device
-> Event -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyEvent Device
device Event
event "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 vkDestroyEventPtr :: FunPtr
  (Ptr Device_T
   -> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyEventPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyEvent (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
   -> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyEventPtr 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 vkDestroyEvent is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroyEvent' :: Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyEvent' = FunPtr
  (Ptr Device_T
   -> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> Event
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyEvent FunPtr
  (Ptr Device_T
   -> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyEventPtr
  "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
"vkDestroyEvent" (Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyEvent'
                                              (Device -> Ptr Device_T
deviceHandle (Device
device))
                                              (Event
event)
                                              "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" mkVkGetEventStatus
  :: FunPtr (Ptr Device_T -> Event -> IO Result) -> Ptr Device_T -> Event -> IO Result

-- | vkGetEventStatus - Retrieve the status of an event object
--
-- = Description
--
-- Upon success, 'getEventStatus' returns the state of the event object
-- with the following return codes:
--
-- +------------------------------------------+---------------------------+
-- | Status                                   | Meaning                   |
-- +==========================================+===========================+
-- | 'Vulkan.Core10.Enums.Result.EVENT_SET'   | The event specified by    |
-- |                                          | @event@ is signaled.      |
-- +------------------------------------------+---------------------------+
-- | 'Vulkan.Core10.Enums.Result.EVENT_RESET' | The event specified by    |
-- |                                          | @event@ is unsignaled.    |
-- +------------------------------------------+---------------------------+
--
-- Event Object Status Codes
--
-- If a 'Vulkan.Core10.CommandBufferBuilding.cmdSetEvent' or
-- 'Vulkan.Core10.CommandBufferBuilding.cmdResetEvent' command is in a
-- command buffer that is in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#commandbuffers-lifecycle pending state>,
-- then the value returned by this command /may/ immediately be out of
-- date.
--
-- The state of an event /can/ be updated by the host. The state of the
-- event is immediately changed, and subsequent calls to 'getEventStatus'
-- will return the new state. If an event is already in the requested
-- state, then updating it to the same state has no effect.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.EVENT_SET'
--
--     -   'Vulkan.Core10.Enums.Result.EVENT_RESET'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_DEVICE_LOST'
--
-- = 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.Handles.Device', 'Vulkan.Core10.Handles.Event'
getEventStatus :: forall io
                . (MonadIO io)
               => -- | @device@ is the logical device that owns the event.
                  --
                  -- #VUID-vkGetEventStatus-device-parameter# @device@ /must/ be a valid
                  -- 'Vulkan.Core10.Handles.Device' handle
                  Device
               -> -- | @event@ is the handle of the event to query.
                  --
                  -- #VUID-vkGetEventStatus-event-03940# @event@ /must/ not have been created
                  -- with
                  -- 'Vulkan.Core10.Enums.EventCreateFlagBits.EVENT_CREATE_DEVICE_ONLY_BIT'
                  --
                  -- #VUID-vkGetEventStatus-event-parameter# @event@ /must/ be a valid
                  -- 'Vulkan.Core10.Handles.Event' handle
                  --
                  -- #VUID-vkGetEventStatus-event-parent# @event@ /must/ have been created,
                  -- allocated, or retrieved from @device@
                  Event
               -> io (Result)
getEventStatus :: forall (io :: * -> *). MonadIO io => Device -> Event -> io Result
getEventStatus Device
device Event
event = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkGetEventStatusPtr :: FunPtr (Ptr Device_T -> Event -> IO Result)
vkGetEventStatusPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Event -> IO Result)
pVkGetEventStatus (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 -> Event -> IO Result)
vkGetEventStatusPtr 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 vkGetEventStatus is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetEventStatus' :: Ptr Device_T -> Event -> IO Result
vkGetEventStatus' = FunPtr (Ptr Device_T -> Event -> IO Result)
-> Ptr Device_T -> Event -> IO Result
mkVkGetEventStatus FunPtr (Ptr Device_T -> Event -> IO Result)
vkGetEventStatusPtr
  Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetEventStatus" (Ptr Device_T -> Event -> IO Result
vkGetEventStatus'
                                              (Device -> Ptr Device_T
deviceHandle (Device
device))
                                              (Event
event))
  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))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Result
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkSetEvent
  :: FunPtr (Ptr Device_T -> Event -> IO Result) -> Ptr Device_T -> Event -> IO Result

-- | vkSetEvent - Set an event to signaled state
--
-- = Description
--
-- When 'setEvent' is executed on the host, it defines an /event signal
-- operation/ which sets the event to the signaled state.
--
-- If @event@ is already in the signaled state when 'setEvent' is executed,
-- then 'setEvent' has no effect, and no event signal operation occurs.
--
-- Note
--
-- If a command buffer is waiting for an event to be signaled from the
-- host, the application must signal the event before submitting the
-- command buffer, as described in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#commandbuffers-submission-progress queue forward progress>
-- section.
--
-- == Valid Usage
--
-- -   #VUID-vkSetEvent-event-03941# @event@ /must/ not have been created
--     with
--     'Vulkan.Core10.Enums.EventCreateFlagBits.EVENT_CREATE_DEVICE_ONLY_BIT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkSetEvent-device-parameter# @device@ /must/ be a valid
--     'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkSetEvent-event-parameter# @event@ /must/ be a valid
--     'Vulkan.Core10.Handles.Event' handle
--
-- -   #VUID-vkSetEvent-event-parent# @event@ /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @event@ /must/ be externally synchronized
--
-- == 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.Handles.Device', 'Vulkan.Core10.Handles.Event'
setEvent :: forall io
          . (MonadIO io)
         => -- | @device@ is the logical device that owns the event.
            Device
         -> -- | @event@ is the event to set.
            Event
         -> io ()
setEvent :: forall (io :: * -> *). MonadIO io => Device -> Event -> io ()
setEvent Device
device Event
event = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkSetEventPtr :: FunPtr (Ptr Device_T -> Event -> IO Result)
vkSetEventPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Event -> IO Result)
pVkSetEvent (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 -> Event -> IO Result)
vkSetEventPtr 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 vkSetEvent is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkSetEvent' :: Ptr Device_T -> Event -> IO Result
vkSetEvent' = FunPtr (Ptr Device_T -> Event -> IO Result)
-> Ptr Device_T -> Event -> IO Result
mkVkSetEvent FunPtr (Ptr Device_T -> Event -> IO Result)
vkSetEventPtr
  Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkSetEvent" (Ptr Device_T -> Event -> IO Result
vkSetEvent'
                                        (Device -> Ptr Device_T
deviceHandle (Device
device))
                                        (Event
event))
  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" mkVkResetEvent
  :: FunPtr (Ptr Device_T -> Event -> IO Result) -> Ptr Device_T -> Event -> IO Result

-- | vkResetEvent - Reset an event to non-signaled state
--
-- = Description
--
-- When 'resetEvent' is executed on the host, it defines an /event unsignal
-- operation/ which resets the event to the unsignaled state.
--
-- If @event@ is already in the unsignaled state when 'resetEvent' is
-- executed, then 'resetEvent' has no effect, and no event unsignal
-- operation occurs.
--
-- == Valid Usage
--
-- -   #VUID-vkResetEvent-event-03821# There /must/ be an execution
--     dependency between 'resetEvent' and the execution of any
--     'Vulkan.Core10.CommandBufferBuilding.cmdWaitEvents' that includes
--     @event@ in its @pEvents@ parameter
--
-- -   #VUID-vkResetEvent-event-03822# There /must/ be an execution
--     dependency between 'resetEvent' and the execution of any
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.cmdWaitEvents2'
--     that includes @event@ in its @pEvents@ parameter
--
-- -   #VUID-vkResetEvent-event-03823# @event@ /must/ not have been created
--     with
--     'Vulkan.Core10.Enums.EventCreateFlagBits.EVENT_CREATE_DEVICE_ONLY_BIT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkResetEvent-device-parameter# @device@ /must/ be a valid
--     'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkResetEvent-event-parameter# @event@ /must/ be a valid
--     'Vulkan.Core10.Handles.Event' handle
--
-- -   #VUID-vkResetEvent-event-parent# @event@ /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @event@ /must/ be externally synchronized
--
-- == 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_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.Handles.Device', 'Vulkan.Core10.Handles.Event'
resetEvent :: forall io
            . (MonadIO io)
           => -- | @device@ is the logical device that owns the event.
              Device
           -> -- | @event@ is the event to reset.
              Event
           -> io ()
resetEvent :: forall (io :: * -> *). MonadIO io => Device -> Event -> io ()
resetEvent Device
device Event
event = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkResetEventPtr :: FunPtr (Ptr Device_T -> Event -> IO Result)
vkResetEventPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Event -> IO Result)
pVkResetEvent (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 -> Event -> IO Result)
vkResetEventPtr 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 vkResetEvent is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkResetEvent' :: Ptr Device_T -> Event -> IO Result
vkResetEvent' = FunPtr (Ptr Device_T -> Event -> IO Result)
-> Ptr Device_T -> Event -> IO Result
mkVkResetEvent FunPtr (Ptr Device_T -> Event -> IO Result)
vkResetEventPtr
  Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkResetEvent" (Ptr Device_T -> Event -> IO Result
vkResetEvent'
                                          (Device -> Ptr Device_T
deviceHandle (Device
device))
                                          (Event
event))
  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))


-- | VkEventCreateInfo - Structure specifying parameters of a newly created
-- event
--
-- == Valid Usage
--
-- -   #VUID-VkEventCreateInfo-pNext-06790# 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-VkEventCreateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EVENT_CREATE_INFO'
--
-- -   #VUID-VkEventCreateInfo-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'
--     or
--     'Vulkan.Extensions.VK_EXT_metal_objects.ImportMetalSharedEventInfoEXT'
--
-- -   #VUID-VkEventCreateInfo-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-VkEventCreateInfo-flags-parameter# @flags@ /must/ be a valid
--     combination of
--     'Vulkan.Core10.Enums.EventCreateFlagBits.EventCreateFlagBits' values
--
-- = 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.EventCreateFlagBits.EventCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createEvent'
data EventCreateInfo (es :: [Type]) = EventCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). EventCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.EventCreateFlagBits.EventCreateFlagBits' defining
    -- additional creation parameters.
    forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
flags :: EventCreateFlags
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (EventCreateInfo es)

instance Extensible EventCreateInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"EventCreateInfo"
  setNext :: forall (ds :: [*]) (es :: [*]).
EventCreateInfo ds -> Chain es -> EventCreateInfo es
setNext EventCreateInfo{Chain ds
EventCreateFlags
flags :: EventCreateFlags
next :: Chain ds
$sel:flags:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
$sel:next:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> Chain es
..} Chain es
next' = EventCreateInfo{$sel:next:EventCreateInfo :: Chain es
next = Chain es
next', EventCreateFlags
flags :: EventCreateFlags
$sel:flags:EventCreateInfo :: EventCreateFlags
..}
  getNext :: forall (es :: [*]). EventCreateInfo es -> Chain es
getNext EventCreateInfo{Chain es
EventCreateFlags
flags :: EventCreateFlags
next :: Chain es
$sel:flags:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
$sel:next:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends EventCreateInfo e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends EventCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends EventCreateInfo 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 EventCreateInfo 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 EventCreateInfo e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss EventCreateInfo es
         , PokeChain es ) => ToCStruct (EventCreateInfo es) where
  withCStruct :: forall b.
EventCreateInfo es -> (Ptr (EventCreateInfo es) -> IO b) -> IO b
withCStruct EventCreateInfo es
x Ptr (EventCreateInfo 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 (EventCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (EventCreateInfo es)
p EventCreateInfo es
x (Ptr (EventCreateInfo es) -> IO b
f Ptr (EventCreateInfo es)
p)
  pokeCStruct :: forall b.
Ptr (EventCreateInfo es) -> EventCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (EventCreateInfo es)
p EventCreateInfo{Chain es
EventCreateFlags
flags :: EventCreateFlags
next :: Chain es
$sel:flags:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
$sel:next:EventCreateInfo :: forall (es :: [*]). EventCreateInfo 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 (EventCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EVENT_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 (EventCreateInfo 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 (EventCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr EventCreateFlags)) (EventCreateFlags
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 (EventCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (EventCreateInfo 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 (EventCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EVENT_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 (EventCreateInfo 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 EventCreateInfo es
         , PeekChain es ) => FromCStruct (EventCreateInfo es) where
  peekCStruct :: Ptr (EventCreateInfo es) -> IO (EventCreateInfo es)
peekCStruct Ptr (EventCreateInfo es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (EventCreateInfo 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)
    EventCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @EventCreateFlags ((Ptr (EventCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr EventCreateFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es -> EventCreateFlags -> EventCreateInfo es
EventCreateInfo
             Chain es
next EventCreateFlags
flags

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