{-# language CPP #-}
module Vulkan.Extensions.VK_KHR_deferred_host_operations ( createDeferredOperationKHR
, withDeferredOperationKHR
, destroyDeferredOperationKHR
, getDeferredOperationMaxConcurrencyKHR
, getDeferredOperationResultKHR
, deferredOperationJoinKHR
, KHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION
, pattern KHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION
, KHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME
, pattern KHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME
, DeferredOperationKHR(..)
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (ToCStruct(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Foreign.Storable (Storable(peek))
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Extensions.Handles (DeferredOperationKHR)
import Vulkan.Extensions.Handles (DeferredOperationKHR(..))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateDeferredOperationKHR))
import Vulkan.Dynamic (DeviceCmds(pVkDeferredOperationJoinKHR))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyDeferredOperationKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeferredOperationMaxConcurrencyKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeferredOperationResultKHR))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (DeferredOperationKHR(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateDeferredOperationKHR
:: FunPtr (Ptr Device_T -> Ptr AllocationCallbacks -> Ptr DeferredOperationKHR -> IO Result) -> Ptr Device_T -> Ptr AllocationCallbacks -> Ptr DeferredOperationKHR -> IO Result
createDeferredOperationKHR :: forall io
. (MonadIO io)
=>
Device
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (DeferredOperationKHR)
createDeferredOperationKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DeferredOperationKHR
createDeferredOperationKHR Device
device "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 vkCreateDeferredOperationKHRPtr :: FunPtr
(Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result)
vkCreateDeferredOperationKHRPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result)
pVkCreateDeferredOperationKHR (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
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result)
vkCreateDeferredOperationKHRPtr 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 vkCreateDeferredOperationKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateDeferredOperationKHR' :: Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result
vkCreateDeferredOperationKHR' = FunPtr
(Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result)
-> Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result
mkVkCreateDeferredOperationKHR FunPtr
(Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result)
vkCreateDeferredOperationKHRPtr
"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)
"pDeferredOperation" ::: Ptr DeferredOperationKHR
pPDeferredOperation <- 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 @DeferredOperationKHR 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
"vkCreateDeferredOperationKHR" (Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDeferredOperation" ::: Ptr DeferredOperationKHR)
-> IO Result
vkCreateDeferredOperationKHR'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pDeferredOperation" ::: Ptr DeferredOperationKHR
pPDeferredOperation))
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))
DeferredOperationKHR
pDeferredOperation <- 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 @DeferredOperationKHR "pDeferredOperation" ::: Ptr DeferredOperationKHR
pPDeferredOperation
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (DeferredOperationKHR
pDeferredOperation)
withDeferredOperationKHR :: forall io r . MonadIO io => Device -> Maybe AllocationCallbacks -> (io DeferredOperationKHR -> (DeferredOperationKHR -> io ()) -> r) -> r
withDeferredOperationKHR :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io DeferredOperationKHR
-> (DeferredOperationKHR -> io ()) -> r)
-> r
withDeferredOperationKHR Device
device "allocator" ::: Maybe AllocationCallbacks
pAllocator io DeferredOperationKHR -> (DeferredOperationKHR -> io ()) -> r
b =
io DeferredOperationKHR -> (DeferredOperationKHR -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DeferredOperationKHR
createDeferredOperationKHR Device
device "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(DeferredOperationKHR
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> DeferredOperationKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyDeferredOperationKHR Device
device DeferredOperationKHR
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyDeferredOperationKHR
:: FunPtr (Ptr Device_T -> DeferredOperationKHR -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> DeferredOperationKHR -> Ptr AllocationCallbacks -> IO ()
destroyDeferredOperationKHR :: forall io
. (MonadIO io)
=>
Device
->
DeferredOperationKHR
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyDeferredOperationKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> DeferredOperationKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyDeferredOperationKHR Device
device DeferredOperationKHR
operation "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 vkDestroyDeferredOperationKHRPtr :: FunPtr
(Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyDeferredOperationKHRPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyDeferredOperationKHR (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
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyDeferredOperationKHRPtr 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 vkDestroyDeferredOperationKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyDeferredOperationKHR' :: Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyDeferredOperationKHR' = FunPtr
(Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyDeferredOperationKHR FunPtr
(Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyDeferredOperationKHRPtr
"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
"vkDestroyDeferredOperationKHR" (Ptr Device_T
-> DeferredOperationKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyDeferredOperationKHR'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(DeferredOperationKHR
operation)
"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" mkVkGetDeferredOperationMaxConcurrencyKHR
:: FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Word32) -> Ptr Device_T -> DeferredOperationKHR -> IO Word32
getDeferredOperationMaxConcurrencyKHR :: forall io
. (MonadIO io)
=>
Device
->
DeferredOperationKHR
-> io (Word32)
getDeferredOperationMaxConcurrencyKHR :: forall (io :: * -> *).
MonadIO io =>
Device -> DeferredOperationKHR -> io Word32
getDeferredOperationMaxConcurrencyKHR Device
device DeferredOperationKHR
operation = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkGetDeferredOperationMaxConcurrencyKHRPtr :: FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Word32)
vkGetDeferredOperationMaxConcurrencyKHRPtr = DeviceCmds
-> FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Word32)
pVkGetDeferredOperationMaxConcurrencyKHR (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 -> DeferredOperationKHR -> IO Word32)
vkGetDeferredOperationMaxConcurrencyKHRPtr 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 vkGetDeferredOperationMaxConcurrencyKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetDeferredOperationMaxConcurrencyKHR' :: Ptr Device_T -> DeferredOperationKHR -> IO Word32
vkGetDeferredOperationMaxConcurrencyKHR' = FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Word32)
-> Ptr Device_T -> DeferredOperationKHR -> IO Word32
mkVkGetDeferredOperationMaxConcurrencyKHR FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Word32)
vkGetDeferredOperationMaxConcurrencyKHRPtr
Word32
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDeferredOperationMaxConcurrencyKHR" (Ptr Device_T -> DeferredOperationKHR -> IO Word32
vkGetDeferredOperationMaxConcurrencyKHR'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(DeferredOperationKHR
operation))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Word32
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetDeferredOperationResultKHR
:: FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result) -> Ptr Device_T -> DeferredOperationKHR -> IO Result
getDeferredOperationResultKHR :: forall io
. (MonadIO io)
=>
Device
->
DeferredOperationKHR
-> io (Result)
getDeferredOperationResultKHR :: forall (io :: * -> *).
MonadIO io =>
Device -> DeferredOperationKHR -> io Result
getDeferredOperationResultKHR Device
device DeferredOperationKHR
operation = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkGetDeferredOperationResultKHRPtr :: FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
vkGetDeferredOperationResultKHRPtr = DeviceCmds
-> FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
pVkGetDeferredOperationResultKHR (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 -> DeferredOperationKHR -> IO Result)
vkGetDeferredOperationResultKHRPtr 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 vkGetDeferredOperationResultKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetDeferredOperationResultKHR' :: Ptr Device_T -> DeferredOperationKHR -> IO Result
vkGetDeferredOperationResultKHR' = FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
-> Ptr Device_T -> DeferredOperationKHR -> IO Result
mkVkGetDeferredOperationResultKHR FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
vkGetDeferredOperationResultKHRPtr
Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDeferredOperationResultKHR" (Ptr Device_T -> DeferredOperationKHR -> IO Result
vkGetDeferredOperationResultKHR'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(DeferredOperationKHR
operation))
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" mkVkDeferredOperationJoinKHR
:: FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result) -> Ptr Device_T -> DeferredOperationKHR -> IO Result
deferredOperationJoinKHR :: forall io
. (MonadIO io)
=>
Device
->
DeferredOperationKHR
-> io (Result)
deferredOperationJoinKHR :: forall (io :: * -> *).
MonadIO io =>
Device -> DeferredOperationKHR -> io Result
deferredOperationJoinKHR Device
device DeferredOperationKHR
operation = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkDeferredOperationJoinKHRPtr :: FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
vkDeferredOperationJoinKHRPtr = DeviceCmds
-> FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
pVkDeferredOperationJoinKHR (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 -> DeferredOperationKHR -> IO Result)
vkDeferredOperationJoinKHRPtr 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 vkDeferredOperationJoinKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDeferredOperationJoinKHR' :: Ptr Device_T -> DeferredOperationKHR -> IO Result
vkDeferredOperationJoinKHR' = FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
-> Ptr Device_T -> DeferredOperationKHR -> IO Result
mkVkDeferredOperationJoinKHR FunPtr (Ptr Device_T -> DeferredOperationKHR -> IO Result)
vkDeferredOperationJoinKHRPtr
Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDeferredOperationJoinKHR" (Ptr Device_T -> DeferredOperationKHR -> IO Result
vkDeferredOperationJoinKHR'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(DeferredOperationKHR
operation))
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)
type KHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION = 4
pattern KHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION :: forall a. Integral a => a
$mKHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_DEFERRED_HOST_OPERATIONS_SPEC_VERSION = 4
type KHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME = "VK_KHR_deferred_host_operations"
pattern KHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_DEFERRED_HOST_OPERATIONS_EXTENSION_NAME = "VK_KHR_deferred_host_operations"