{-# language CPP #-}
-- No documentation found for Chapter "LayerDiscovery"
module Vulkan.Core10.LayerDiscovery  ( enumerateInstanceLayerProperties
                                     , enumerateDeviceLayerProperties
                                     , LayerProperties(..)
                                     ) where

import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import Foreign.Ptr (castFunPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
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.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Ptr (Ptr(Ptr))
import Data.Word (Word32)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Dynamic (getInstanceProcAddr')
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Dynamic (InstanceCmds(pVkEnumerateDeviceLayerProperties))
import Vulkan.Core10.APIConstants (MAX_DESCRIPTION_SIZE)
import Vulkan.Core10.APIConstants (MAX_EXTENSION_NAME_SIZE)
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkEnumerateInstanceLayerProperties
  :: FunPtr (Ptr Word32 -> Ptr LayerProperties -> IO Result) -> Ptr Word32 -> Ptr LayerProperties -> IO Result

-- | vkEnumerateInstanceLayerProperties - Returns up to requested number of
-- global layer properties
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of layer properties
-- available is returned in @pPropertyCount@. Otherwise, @pPropertyCount@
-- /must/ point to a variable set by the user to the number of elements in
-- the @pProperties@ array, and on return the variable is overwritten with
-- the number of structures actually written to @pProperties@. If
-- @pPropertyCount@ is less than the number of layer properties available,
-- at most @pPropertyCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available properties were returned.
--
-- The list of available layers may change at any time due to actions
-- outside of the Vulkan implementation, so two calls to
-- 'enumerateInstanceLayerProperties' with the same parameters /may/ return
-- different results, or retrieve different @pPropertyCount@ values or
-- @pProperties@ contents. Once an instance has been created, the layers
-- enabled for that instance will continue to be enabled and valid for the
-- lifetime of that instance, even if some of them become unavailable for
-- future instances.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkEnumerateInstanceLayerProperties-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkEnumerateInstanceLayerProperties-pProperties-parameter# If
--     the value referenced by @pPropertyCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pPropertyCount@ 'LayerProperties' structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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>,
-- 'LayerProperties'
enumerateInstanceLayerProperties :: forall io
                                  . (MonadIO io)
                                 => io (Result, ("properties" ::: Vector LayerProperties))
enumerateInstanceLayerProperties :: forall (io :: * -> *).
MonadIO io =>
io (Result, "properties" ::: Vector LayerProperties)
enumerateInstanceLayerProperties  = 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
  FunPtr
  (("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties) -> IO Result)
vkEnumerateInstanceLayerPropertiesPtr <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. FunPtr a -> FunPtr b
castFunPtr @_ @(("pPropertyCount" ::: Ptr Word32) -> ("pProperties" ::: Ptr LayerProperties) -> IO Result) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Instance_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
getInstanceProcAddr' forall a. Ptr a
nullPtr (forall a. Addr# -> Ptr a
Ptr Addr#
"vkEnumerateInstanceLayerProperties"#)
  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
  (("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties) -> IO Result)
vkEnumerateInstanceLayerPropertiesPtr 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 vkEnumerateInstanceLayerProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkEnumerateInstanceLayerProperties' :: ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties) -> IO Result
vkEnumerateInstanceLayerProperties' = FunPtr
  (("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties) -> IO Result)
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties)
-> IO Result
mkVkEnumerateInstanceLayerProperties FunPtr
  (("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties) -> IO Result)
vkEnumerateInstanceLayerPropertiesPtr
  "pPropertyCount" ::: Ptr Word32
pPPropertyCount <- 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 @Word32 Int
4) 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
"vkEnumerateInstanceLayerProperties" (("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties) -> IO Result
vkEnumerateInstanceLayerProperties'
                                                                       ("pPropertyCount" ::: Ptr Word32
pPPropertyCount)
                                                                       (forall a. Ptr a
nullPtr))
  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))
  Word32
pPropertyCount <- 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 @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "pProperties" ::: Ptr LayerProperties
pPProperties <- 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 @LayerProperties ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
* Int
520)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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 => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr LayerProperties
pPProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
520) :: Ptr LayerProperties) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
- Int
1]
  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
"vkEnumerateInstanceLayerProperties" (("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties) -> IO Result
vkEnumerateInstanceLayerProperties'
                                                                        ("pPropertyCount" ::: Ptr Word32
pPPropertyCount)
                                                                        (("pProperties" ::: Ptr LayerProperties
pPProperties)))
  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'))
  Word32
pPropertyCount' <- 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 @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "properties" ::: Vector LayerProperties
pProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @LayerProperties ((("pProperties" ::: Ptr LayerProperties
pPProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
520 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr LayerProperties)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector LayerProperties
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkEnumerateDeviceLayerProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr LayerProperties -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr LayerProperties -> IO Result

-- | vkEnumerateDeviceLayerProperties - Returns properties of available
-- physical device layers
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of layer properties
-- available is returned in @pPropertyCount@. Otherwise, @pPropertyCount@
-- /must/ point to a variable set by the user to the number of elements in
-- the @pProperties@ array, and on return the variable is overwritten with
-- the number of structures actually written to @pProperties@. If
-- @pPropertyCount@ is less than the number of layer properties available,
-- at most @pPropertyCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available properties were returned.
--
-- The list of layers enumerated by 'enumerateDeviceLayerProperties' /must/
-- be exactly the sequence of layers enabled for the instance. The members
-- of 'LayerProperties' for each enumerated layer /must/ be the same as the
-- properties when the layer was enumerated by
-- 'enumerateInstanceLayerProperties'.
--
-- Note
--
-- Due to platform details on Android, 'enumerateDeviceLayerProperties' may
-- be called with @physicalDevice@ equal to @NULL@ during layer discovery.
-- This behaviour will only be observed by layer implementations, and not
-- the underlying Vulkan driver.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkEnumerateDeviceLayerProperties-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkEnumerateDeviceLayerProperties-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkEnumerateDeviceLayerProperties-pProperties-parameter# If the
--     value referenced by @pPropertyCount@ is not @0@, and @pProperties@
--     is not @NULL@, @pProperties@ /must/ be a valid pointer to an array
--     of @pPropertyCount@ 'LayerProperties' structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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>,
-- 'LayerProperties', 'Vulkan.Core10.Handles.PhysicalDevice'
enumerateDeviceLayerProperties :: forall io
                                . (MonadIO io)
                               => -- | @physicalDevice@ is the physical device that will be queried.
                                  PhysicalDevice
                               -> io (Result, ("properties" ::: Vector LayerProperties))
enumerateDeviceLayerProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io (Result, "properties" ::: Vector LayerProperties)
enumerateDeviceLayerProperties PhysicalDevice
physicalDevice = 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 vkEnumerateDeviceLayerPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties)
   -> IO Result)
vkEnumerateDeviceLayerPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pPropertyCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr LayerProperties)
      -> IO Result)
pVkEnumerateDeviceLayerProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  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 PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties)
   -> IO Result)
vkEnumerateDeviceLayerPropertiesPtr 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 vkEnumerateDeviceLayerProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkEnumerateDeviceLayerProperties' :: Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties)
-> IO Result
vkEnumerateDeviceLayerProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties)
-> IO Result
mkVkEnumerateDeviceLayerProperties FunPtr
  (Ptr PhysicalDevice_T
   -> ("pPropertyCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr LayerProperties)
   -> IO Result)
vkEnumerateDeviceLayerPropertiesPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pPropertyCount" ::: Ptr Word32
pPPropertyCount <- 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 @Word32 Int
4) 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
"vkEnumerateDeviceLayerProperties" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties)
-> IO Result
vkEnumerateDeviceLayerProperties'
                                                                     Ptr PhysicalDevice_T
physicalDevice'
                                                                     ("pPropertyCount" ::: Ptr Word32
pPPropertyCount)
                                                                     (forall a. Ptr a
nullPtr))
  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))
  Word32
pPropertyCount <- 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 @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "pProperties" ::: Ptr LayerProperties
pPProperties <- 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 @LayerProperties ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
* Int
520)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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 => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr LayerProperties
pPProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
520) :: Ptr LayerProperties) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
- Int
1]
  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
"vkEnumerateDeviceLayerProperties" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr LayerProperties)
-> IO Result
vkEnumerateDeviceLayerProperties'
                                                                      Ptr PhysicalDevice_T
physicalDevice'
                                                                      ("pPropertyCount" ::: Ptr Word32
pPPropertyCount)
                                                                      (("pProperties" ::: Ptr LayerProperties
pPProperties)))
  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'))
  Word32
pPropertyCount' <- 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 @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
  "properties" ::: Vector LayerProperties
pProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @LayerProperties ((("pProperties" ::: Ptr LayerProperties
pPProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
520 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr LayerProperties)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector LayerProperties
pProperties')


-- | VkLayerProperties - Structure specifying layer properties
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'enumerateDeviceLayerProperties', 'enumerateInstanceLayerProperties'
data LayerProperties = LayerProperties
  { -- | @layerName@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_EXTENSION_NAME_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which is the name of the layer. Use this
    -- name in the @ppEnabledLayerNames@ array passed in the
    -- 'Vulkan.Core10.DeviceInitialization.InstanceCreateInfo' structure to
    -- enable this layer for an instance.
    LayerProperties -> ByteString
layerName :: ByteString
  , -- | @specVersion@ is the Vulkan version the layer was written to, encoded as
    -- described in
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#extendingvulkan-coreversions-versionnumbers>.
    LayerProperties -> Word32
specVersion :: Word32
  , -- | @implementationVersion@ is the version of this layer. It is an integer,
    -- increasing with backward compatible changes.
    LayerProperties -> Word32
implementationVersion :: Word32
  , -- | @description@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which provides additional details that
    -- /can/ be used by the application to identify the layer.
    LayerProperties -> ByteString
description :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (LayerProperties)
#endif
deriving instance Show LayerProperties

instance ToCStruct LayerProperties where
  withCStruct :: forall b.
LayerProperties
-> (("pProperties" ::: Ptr LayerProperties) -> IO b) -> IO b
withCStruct LayerProperties
x ("pProperties" ::: Ptr LayerProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
520 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr LayerProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr LayerProperties
p LayerProperties
x (("pProperties" ::: Ptr LayerProperties) -> IO b
f "pProperties" ::: Ptr LayerProperties
p)
  pokeCStruct :: forall b.
("pProperties" ::: Ptr LayerProperties)
-> LayerProperties -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr LayerProperties
p LayerProperties{Word32
ByteString
description :: ByteString
implementationVersion :: Word32
specVersion :: Word32
layerName :: ByteString
$sel:description:LayerProperties :: LayerProperties -> ByteString
$sel:implementationVersion:LayerProperties :: LayerProperties -> Word32
$sel:specVersion:LayerProperties :: LayerProperties -> Word32
$sel:layerName:LayerProperties :: LayerProperties -> ByteString
..} IO b
f = do
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (ByteString
layerName)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word32)) (Word32
specVersion)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32)) (Word32
implementationVersion)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    IO b
f
  cStructSize :: Int
cStructSize = Int
520
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. ("pProperties" ::: Ptr LayerProperties) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr LayerProperties
p IO b
f = do
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct LayerProperties where
  peekCStruct :: ("pProperties" ::: Ptr LayerProperties) -> IO LayerProperties
peekCStruct "pProperties" ::: Ptr LayerProperties
p = do
    ByteString
layerName <- ("pName" ::: Ptr CChar) -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))))
    Word32
specVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word32))
    Word32
implementationVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32))
    ByteString
description <- ("pName" ::: Ptr CChar) -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr LayerProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Word32 -> Word32 -> ByteString -> LayerProperties
LayerProperties
             ByteString
layerName Word32
specVersion Word32
implementationVersion ByteString
description

instance Storable LayerProperties where
  sizeOf :: LayerProperties -> Int
sizeOf ~LayerProperties
_ = Int
520
  alignment :: LayerProperties -> Int
alignment ~LayerProperties
_ = Int
4
  peek :: ("pProperties" ::: Ptr LayerProperties) -> IO LayerProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pProperties" ::: Ptr LayerProperties) -> LayerProperties -> IO ()
poke "pProperties" ::: Ptr LayerProperties
ptr LayerProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr LayerProperties
ptr LayerProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero LayerProperties where
  zero :: LayerProperties
zero = ByteString -> Word32 -> Word32 -> ByteString -> LayerProperties
LayerProperties
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty