{-# language CPP #-}
module Vulkan.Core10.Query ( createQueryPool
, withQueryPool
, destroyQueryPool
, getQueryPoolResults
, QueryPoolCreateInfo(..)
, QueryPool(..)
, QueryPoolCreateFlags(..)
, QueryType(..)
, QueryResultFlagBits(..)
, QueryResultFlags
, QueryPipelineStatisticFlagBits(..)
, QueryPipelineStatisticFlags
) 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 Foreign.C.Types (CSize(..))
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.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
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.Word (Word32)
import Data.Word (Word64)
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(pVkCreateQueryPool))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyQueryPool))
import Vulkan.Dynamic (DeviceCmds(pVkGetQueryPoolResults))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
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.QueryPipelineStatisticFlagBits (QueryPipelineStatisticFlags)
import Vulkan.Core10.Handles (QueryPool)
import Vulkan.Core10.Handles (QueryPool(..))
import Vulkan.Core10.Enums.QueryPoolCreateFlags (QueryPoolCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_performance_query (QueryPoolPerformanceCreateInfoKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_INTEL_performance_query (QueryPoolPerformanceQueryCreateInfoINTEL)
import Vulkan.Core10.Enums.QueryResultFlagBits (QueryResultFlagBits(..))
import Vulkan.Core10.Enums.QueryResultFlagBits (QueryResultFlags)
import Vulkan.Core10.Enums.QueryType (QueryType)
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_QUERY_POOL_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.QueryPipelineStatisticFlagBits (QueryPipelineStatisticFlagBits(..))
import Vulkan.Core10.Enums.QueryPipelineStatisticFlagBits (QueryPipelineStatisticFlags)
import Vulkan.Core10.Handles (QueryPool(..))
import Vulkan.Core10.Enums.QueryPoolCreateFlags (QueryPoolCreateFlags(..))
import Vulkan.Core10.Enums.QueryResultFlagBits (QueryResultFlagBits(..))
import Vulkan.Core10.Enums.QueryResultFlagBits (QueryResultFlags)
import Vulkan.Core10.Enums.QueryType (QueryType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateQueryPool
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct QueryPoolCreateInfo) -> Ptr AllocationCallbacks -> Ptr QueryPool -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct QueryPoolCreateInfo) -> Ptr AllocationCallbacks -> Ptr QueryPool -> IO Result
createQueryPool :: forall a io
. (Extendss QueryPoolCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(QueryPoolCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (QueryPool)
createQueryPool :: forall (a :: [*]) (io :: * -> *).
(Extendss QueryPoolCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> QueryPoolCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io QueryPool
createQueryPool Device
device QueryPoolCreateInfo 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 vkCreateQueryPoolPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result)
vkCreateQueryPoolPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result)
pVkCreateQueryPool (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 QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result)
vkCreateQueryPoolPtr 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 vkCreateQueryPool is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateQueryPool' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result
vkCreateQueryPool' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result
mkVkCreateQueryPool FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result)
vkCreateQueryPoolPtr
Ptr (QueryPoolCreateInfo 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 (QueryPoolCreateInfo 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)
"pQueryPool" ::: Ptr QueryPool
pPQueryPool <- 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 @QueryPool 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
"vkCreateQueryPool" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct QueryPoolCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pQueryPool" ::: Ptr QueryPool)
-> IO Result
vkCreateQueryPool'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (QueryPoolCreateInfo a)
pCreateInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pQueryPool" ::: Ptr QueryPool
pPQueryPool))
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))
QueryPool
pQueryPool <- 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 @QueryPool "pQueryPool" ::: Ptr QueryPool
pPQueryPool
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (QueryPool
pQueryPool)
withQueryPool :: forall a io r . (Extendss QueryPoolCreateInfo a, PokeChain a, MonadIO io) => Device -> QueryPoolCreateInfo a -> Maybe AllocationCallbacks -> (io QueryPool -> (QueryPool -> io ()) -> r) -> r
withQueryPool :: forall (a :: [*]) (io :: * -> *) r.
(Extendss QueryPoolCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> QueryPoolCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io QueryPool -> (QueryPool -> io ()) -> r)
-> r
withQueryPool Device
device QueryPoolCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io QueryPool -> (QueryPool -> io ()) -> r
b =
io QueryPool -> (QueryPool -> io ()) -> r
b (forall (a :: [*]) (io :: * -> *).
(Extendss QueryPoolCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> QueryPoolCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io QueryPool
createQueryPool Device
device QueryPoolCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(QueryPool
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> QueryPool
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyQueryPool Device
device QueryPool
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyQueryPool
:: FunPtr (Ptr Device_T -> QueryPool -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> QueryPool -> Ptr AllocationCallbacks -> IO ()
destroyQueryPool :: forall io
. (MonadIO io)
=>
Device
->
QueryPool
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyQueryPool :: forall (io :: * -> *).
MonadIO io =>
Device
-> QueryPool
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyQueryPool Device
device QueryPool
queryPool "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 vkDestroyQueryPoolPtr :: FunPtr
(Ptr Device_T
-> QueryPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyQueryPoolPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> QueryPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyQueryPool (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
-> QueryPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyQueryPoolPtr 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 vkDestroyQueryPool is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyQueryPool' :: Ptr Device_T
-> QueryPool -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyQueryPool' = FunPtr
(Ptr Device_T
-> QueryPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> QueryPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyQueryPool FunPtr
(Ptr Device_T
-> QueryPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyQueryPoolPtr
"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
"vkDestroyQueryPool" (Ptr Device_T
-> QueryPool -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyQueryPool'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(QueryPool
queryPool)
"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" mkVkGetQueryPoolResults
:: FunPtr (Ptr Device_T -> QueryPool -> Word32 -> Word32 -> CSize -> Ptr () -> DeviceSize -> QueryResultFlags -> IO Result) -> Ptr Device_T -> QueryPool -> Word32 -> Word32 -> CSize -> Ptr () -> DeviceSize -> QueryResultFlags -> IO Result
getQueryPoolResults :: forall io
. (MonadIO io)
=>
Device
->
QueryPool
->
("firstQuery" ::: Word32)
->
("queryCount" ::: Word32)
->
("dataSize" ::: Word64)
->
("data" ::: Ptr ())
->
("stride" ::: DeviceSize)
->
QueryResultFlags
-> io (Result)
getQueryPoolResults :: forall (io :: * -> *).
MonadIO io =>
Device
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: Word64)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> io Result
getQueryPoolResults Device
device
QueryPool
queryPool
"firstQuery" ::: Word32
firstQuery
"firstQuery" ::: Word32
queryCount
"dataSize" ::: Word64
dataSize
"data" ::: Ptr ()
data'
"dataSize" ::: Word64
stride
QueryResultFlags
flags = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkGetQueryPoolResultsPtr :: FunPtr
(Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result)
vkGetQueryPoolResultsPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result)
pVkGetQueryPoolResults (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
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result)
vkGetQueryPoolResultsPtr 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 vkGetQueryPoolResults is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetQueryPoolResults' :: Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result
vkGetQueryPoolResults' = FunPtr
(Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result)
-> Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result
mkVkGetQueryPoolResults FunPtr
(Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result)
vkGetQueryPoolResultsPtr
Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetQueryPoolResults" (Ptr Device_T
-> QueryPool
-> ("firstQuery" ::: Word32)
-> ("firstQuery" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> QueryResultFlags
-> IO Result
vkGetQueryPoolResults'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(QueryPool
queryPool)
("firstQuery" ::: Word32
firstQuery)
("firstQuery" ::: Word32
queryCount)
(("dataSize" ::: Word64) -> "dataSize" ::: CSize
CSize ("dataSize" ::: Word64
dataSize))
("data" ::: Ptr ()
data')
("dataSize" ::: Word64
stride)
(QueryResultFlags
flags))
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)
data QueryPoolCreateInfo (es :: [Type]) = QueryPoolCreateInfo
{
forall (es :: [*]). QueryPoolCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]). QueryPoolCreateInfo es -> QueryPoolCreateFlags
flags :: QueryPoolCreateFlags
,
forall (es :: [*]). QueryPoolCreateInfo es -> QueryType
queryType :: QueryType
,
forall (es :: [*]).
QueryPoolCreateInfo es -> "firstQuery" ::: Word32
queryCount :: Word32
,
forall (es :: [*]).
QueryPoolCreateInfo es -> QueryPipelineStatisticFlags
pipelineStatistics :: QueryPipelineStatisticFlags
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (QueryPoolCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (QueryPoolCreateInfo es)
instance Extensible QueryPoolCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"QueryPoolCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
QueryPoolCreateInfo ds -> Chain es -> QueryPoolCreateInfo es
setNext QueryPoolCreateInfo{"firstQuery" ::: Word32
Chain ds
QueryType
QueryPoolCreateFlags
QueryPipelineStatisticFlags
pipelineStatistics :: QueryPipelineStatisticFlags
queryCount :: "firstQuery" ::: Word32
queryType :: QueryType
flags :: QueryPoolCreateFlags
next :: Chain ds
$sel:pipelineStatistics:QueryPoolCreateInfo :: forall (es :: [*]).
QueryPoolCreateInfo es -> QueryPipelineStatisticFlags
$sel:queryCount:QueryPoolCreateInfo :: forall (es :: [*]).
QueryPoolCreateInfo es -> "firstQuery" ::: Word32
$sel:queryType:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> QueryType
$sel:flags:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> QueryPoolCreateFlags
$sel:next:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> Chain es
..} Chain es
next' = QueryPoolCreateInfo{$sel:next:QueryPoolCreateInfo :: Chain es
next = Chain es
next', "firstQuery" ::: Word32
QueryType
QueryPoolCreateFlags
QueryPipelineStatisticFlags
pipelineStatistics :: QueryPipelineStatisticFlags
queryCount :: "firstQuery" ::: Word32
queryType :: QueryType
flags :: QueryPoolCreateFlags
$sel:pipelineStatistics:QueryPoolCreateInfo :: QueryPipelineStatisticFlags
$sel:queryCount:QueryPoolCreateInfo :: "firstQuery" ::: Word32
$sel:queryType:QueryPoolCreateInfo :: QueryType
$sel:flags:QueryPoolCreateInfo :: QueryPoolCreateFlags
..}
getNext :: forall (es :: [*]). QueryPoolCreateInfo es -> Chain es
getNext QueryPoolCreateInfo{"firstQuery" ::: Word32
Chain es
QueryType
QueryPoolCreateFlags
QueryPipelineStatisticFlags
pipelineStatistics :: QueryPipelineStatisticFlags
queryCount :: "firstQuery" ::: Word32
queryType :: QueryType
flags :: QueryPoolCreateFlags
next :: Chain es
$sel:pipelineStatistics:QueryPoolCreateInfo :: forall (es :: [*]).
QueryPoolCreateInfo es -> QueryPipelineStatisticFlags
$sel:queryCount:QueryPoolCreateInfo :: forall (es :: [*]).
QueryPoolCreateInfo es -> "firstQuery" ::: Word32
$sel:queryType:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> QueryType
$sel:flags:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> QueryPoolCreateFlags
$sel:next:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> Chain es
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends QueryPoolCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends QueryPoolCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends QueryPoolCreateInfo e => b
f
| Just e :~: QueryPoolPerformanceQueryCreateInfoINTEL
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @QueryPoolPerformanceQueryCreateInfoINTEL = forall a. a -> Maybe a
Just Extends QueryPoolCreateInfo e => b
f
| Just e :~: QueryPoolPerformanceCreateInfoKHR
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @QueryPoolPerformanceCreateInfoKHR = forall a. a -> Maybe a
Just Extends QueryPoolCreateInfo e => b
f
| Bool
otherwise = forall a. Maybe a
Nothing
instance ( Extendss QueryPoolCreateInfo es
, PokeChain es ) => ToCStruct (QueryPoolCreateInfo es) where
withCStruct :: forall b.
QueryPoolCreateInfo es
-> (Ptr (QueryPoolCreateInfo es) -> IO b) -> IO b
withCStruct QueryPoolCreateInfo es
x Ptr (QueryPoolCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr (QueryPoolCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (QueryPoolCreateInfo es)
p QueryPoolCreateInfo es
x (Ptr (QueryPoolCreateInfo es) -> IO b
f Ptr (QueryPoolCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (QueryPoolCreateInfo es)
-> QueryPoolCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (QueryPoolCreateInfo es)
p QueryPoolCreateInfo{"firstQuery" ::: Word32
Chain es
QueryType
QueryPoolCreateFlags
QueryPipelineStatisticFlags
pipelineStatistics :: QueryPipelineStatisticFlags
queryCount :: "firstQuery" ::: Word32
queryType :: QueryType
flags :: QueryPoolCreateFlags
next :: Chain es
$sel:pipelineStatistics:QueryPoolCreateInfo :: forall (es :: [*]).
QueryPoolCreateInfo es -> QueryPipelineStatisticFlags
$sel:queryCount:QueryPoolCreateInfo :: forall (es :: [*]).
QueryPoolCreateInfo es -> "firstQuery" ::: Word32
$sel:queryType:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> QueryType
$sel:flags:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo es -> QueryPoolCreateFlags
$sel:next:QueryPoolCreateInfo :: forall (es :: [*]). QueryPoolCreateInfo 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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_QUERY_POOL_CREATE_INFO)
"data" ::: 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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) "data" ::: 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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr QueryPoolCreateFlags)) (QueryPoolCreateFlags
flags)
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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr QueryType)) (QueryType
queryType)
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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ("firstQuery" ::: Word32
queryCount)
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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr QueryPipelineStatisticFlags)) (QueryPipelineStatisticFlags
pipelineStatistics)
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
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (QueryPoolCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (QueryPoolCreateInfo 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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_QUERY_POOL_CREATE_INFO)
"data" ::: 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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) "data" ::: 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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr QueryType)) (forall a. Zero a => a
zero)
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 (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
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 QueryPoolCreateInfo es
, PeekChain es ) => FromCStruct (QueryPoolCreateInfo es) where
peekCStruct :: Ptr (QueryPoolCreateInfo es) -> IO (QueryPoolCreateInfo es)
peekCStruct Ptr (QueryPoolCreateInfo es)
p = do
"data" ::: Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (QueryPoolCreateInfo 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 "data" ::: Ptr ()
pNext)
QueryPoolCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @QueryPoolCreateFlags ((Ptr (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr QueryPoolCreateFlags))
QueryType
queryType <- forall a. Storable a => Ptr a -> IO a
peek @QueryType ((Ptr (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr QueryType))
"firstQuery" ::: Word32
queryCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
QueryPipelineStatisticFlags
pipelineStatistics <- forall a. Storable a => Ptr a -> IO a
peek @QueryPipelineStatisticFlags ((Ptr (QueryPoolCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr QueryPipelineStatisticFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> QueryPoolCreateFlags
-> QueryType
-> ("firstQuery" ::: Word32)
-> QueryPipelineStatisticFlags
-> QueryPoolCreateInfo es
QueryPoolCreateInfo
Chain es
next QueryPoolCreateFlags
flags QueryType
queryType "firstQuery" ::: Word32
queryCount QueryPipelineStatisticFlags
pipelineStatistics
instance es ~ '[] => Zero (QueryPoolCreateInfo es) where
zero :: QueryPoolCreateInfo es
zero = forall (es :: [*]).
Chain es
-> QueryPoolCreateFlags
-> QueryType
-> ("firstQuery" ::: Word32)
-> QueryPipelineStatisticFlags
-> QueryPoolCreateInfo es
QueryPoolCreateInfo
()
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero