{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_EXT_tooling_info"
module Vulkan.Core13.Promoted_From_VK_EXT_tooling_info  ( getPhysicalDeviceToolProperties
                                                        , PhysicalDeviceToolProperties(..)
                                                        , StructureType(..)
                                                        , ToolPurposeFlagBits(..)
                                                        , ToolPurposeFlags
                                                        ) 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 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 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.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceToolProperties))
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.Core10.Enums.StructureType (StructureType)
import Vulkan.Core13.Enums.ToolPurposeFlagBits (ToolPurposeFlags)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_TOOL_PROPERTIES))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
import Vulkan.Core13.Enums.ToolPurposeFlagBits (ToolPurposeFlagBits(..))
import Vulkan.Core13.Enums.ToolPurposeFlagBits (ToolPurposeFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceToolProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr PhysicalDeviceToolProperties -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr PhysicalDeviceToolProperties -> IO Result

-- | vkGetPhysicalDeviceToolProperties - Reports properties of tools active
-- on the specified physical device
--
-- = Description
--
-- If @pToolProperties@ is @NULL@, then the number of tools currently
-- active on @physicalDevice@ is returned in @pToolCount@. Otherwise,
-- @pToolCount@ /must/ point to a variable set by the user to the number of
-- elements in the @pToolProperties@ array, and on return the variable is
-- overwritten with the number of structures actually written to
-- @pToolProperties@. If @pToolCount@ is less than the number of currently
-- active tools, at most @pToolCount@ structures will be written.
--
-- The count and properties of active tools /may/ change in response to
-- events outside the scope of the specification. An application /should/
-- assume these properties might change at any given time.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPhysicalDeviceToolProperties-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetPhysicalDeviceToolProperties-pToolCount-parameter#
--     @pToolCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPhysicalDeviceToolProperties-pToolProperties-parameter#
--     If the value referenced by @pToolCount@ is not @0@, and
--     @pToolProperties@ is not @NULL@, @pToolProperties@ /must/ be a valid
--     pointer to an array of @pToolCount@ 'PhysicalDeviceToolProperties'
--     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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_tooling_info VK_EXT_tooling_info>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.PhysicalDevice', 'PhysicalDeviceToolProperties'
getPhysicalDeviceToolProperties :: forall io
                                 . (MonadIO io)
                                => -- | @physicalDevice@ is the handle to the physical device to query for
                                   -- active tools.
                                   PhysicalDevice
                                -> io (Result, ("toolProperties" ::: Vector PhysicalDeviceToolProperties))
getPhysicalDeviceToolProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io
     (Result, "toolProperties" ::: Vector PhysicalDeviceToolProperties)
getPhysicalDeviceToolProperties 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 vkGetPhysicalDeviceToolPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pToolCount" ::: Ptr Word32)
   -> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
   -> IO Result)
vkGetPhysicalDeviceToolPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pToolCount" ::: Ptr Word32)
      -> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
      -> IO Result)
pVkGetPhysicalDeviceToolProperties (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
   -> ("pToolCount" ::: Ptr Word32)
   -> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
   -> IO Result)
vkGetPhysicalDeviceToolPropertiesPtr 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 vkGetPhysicalDeviceToolProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceToolProperties' :: Ptr PhysicalDevice_T
-> ("pToolCount" ::: Ptr Word32)
-> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> IO Result
vkGetPhysicalDeviceToolProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pToolCount" ::: Ptr Word32)
   -> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
   -> IO Result)
-> Ptr PhysicalDevice_T
-> ("pToolCount" ::: Ptr Word32)
-> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> IO Result
mkVkGetPhysicalDeviceToolProperties FunPtr
  (Ptr PhysicalDevice_T
   -> ("pToolCount" ::: Ptr Word32)
   -> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
   -> IO Result)
vkGetPhysicalDeviceToolPropertiesPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pToolCount" ::: Ptr Word32
pPToolCount <- 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
"vkGetPhysicalDeviceToolProperties" (Ptr PhysicalDevice_T
-> ("pToolCount" ::: Ptr Word32)
-> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> IO Result
vkGetPhysicalDeviceToolProperties'
                                                                      Ptr PhysicalDevice_T
physicalDevice'
                                                                      ("pToolCount" ::: Ptr Word32
pPToolCount)
                                                                      (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
pToolCount <- 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 "pToolCount" ::: Ptr Word32
pPToolCount
  "pToolProperties" ::: Ptr PhysicalDeviceToolProperties
pPToolProperties <- 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 @PhysicalDeviceToolProperties ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pToolCount)) forall a. Num a => a -> a -> a
* Int
1048)) 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 ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
pPToolProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
1048) :: Ptr PhysicalDeviceToolProperties) 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
pToolCount)) 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
"vkGetPhysicalDeviceToolProperties" (Ptr PhysicalDevice_T
-> ("pToolCount" ::: Ptr Word32)
-> ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> IO Result
vkGetPhysicalDeviceToolProperties'
                                                                       Ptr PhysicalDevice_T
physicalDevice'
                                                                       ("pToolCount" ::: Ptr Word32
pPToolCount)
                                                                       (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
pPToolProperties)))
  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
pToolCount' <- 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 "pToolCount" ::: Ptr Word32
pPToolCount
  "toolProperties" ::: Vector PhysicalDeviceToolProperties
pToolProperties' <- 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
pToolCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceToolProperties ((("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
pPToolProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
1048 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PhysicalDeviceToolProperties)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "toolProperties" ::: Vector PhysicalDeviceToolProperties
pToolProperties')


-- | VkPhysicalDeviceToolProperties - Structure providing information about
-- an active tool
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_tooling_info VK_EXT_tooling_info>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core13.Enums.ToolPurposeFlagBits.ToolPurposeFlags',
-- 'getPhysicalDeviceToolProperties',
-- 'Vulkan.Extensions.VK_EXT_tooling_info.getPhysicalDeviceToolPropertiesEXT'
data PhysicalDeviceToolProperties = PhysicalDeviceToolProperties
  { -- | @name@ is a null-terminated UTF-8 string containing the name of the
    -- tool.
    PhysicalDeviceToolProperties -> ByteString
name :: ByteString
  , -- | @version@ is a null-terminated UTF-8 string containing the version of
    -- the tool.
    PhysicalDeviceToolProperties -> ByteString
version :: ByteString
  , -- | @purposes@ is a bitmask of
    -- 'Vulkan.Core13.Enums.ToolPurposeFlagBits.ToolPurposeFlagBits' which is
    -- populated with purposes supported by the tool.
    PhysicalDeviceToolProperties -> ToolPurposeFlags
purposes :: ToolPurposeFlags
  , -- | @description@ is a null-terminated UTF-8 string containing a description
    -- of the tool.
    PhysicalDeviceToolProperties -> ByteString
description :: ByteString
  , -- | @layer@ is a null-terminated UTF-8 string containing the name of the
    -- layer implementing the tool, if the tool is implemented in a layer -
    -- otherwise it /may/ be an empty string.
    PhysicalDeviceToolProperties -> ByteString
layer :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceToolProperties)
#endif
deriving instance Show PhysicalDeviceToolProperties

instance ToCStruct PhysicalDeviceToolProperties where
  withCStruct :: forall b.
PhysicalDeviceToolProperties
-> (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
    -> IO b)
-> IO b
withCStruct PhysicalDeviceToolProperties
x ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
1048 forall a b. (a -> b) -> a -> b
$ \"pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p PhysicalDeviceToolProperties
x (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties) -> IO b
f "pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p)
  pokeCStruct :: forall b.
("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> PhysicalDeviceToolProperties -> IO b -> IO b
pokeCStruct "pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p PhysicalDeviceToolProperties{ByteString
ToolPurposeFlags
layer :: ByteString
description :: ByteString
purposes :: ToolPurposeFlags
version :: ByteString
name :: ByteString
$sel:layer:PhysicalDeviceToolProperties :: PhysicalDeviceToolProperties -> ByteString
$sel:description:PhysicalDeviceToolProperties :: PhysicalDeviceToolProperties -> ByteString
$sel:purposes:PhysicalDeviceToolProperties :: PhysicalDeviceToolProperties -> ToolPurposeFlags
$sel:version:PhysicalDeviceToolProperties :: PhysicalDeviceToolProperties -> ByteString
$sel:name:PhysicalDeviceToolProperties :: PhysicalDeviceToolProperties -> ByteString
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TOOL_PROPERTIES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (ByteString
name)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (ByteString
version)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr ToolPurposeFlags)) (ToolPurposeFlags
purposes)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
788 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (ByteString
layer)
    IO b
f
  cStructSize :: Int
cStructSize = Int
1048
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> IO b -> IO b
pokeZeroCStruct "pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TOOL_PROPERTIES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr ToolPurposeFlags)) (forall a. Zero a => a
zero)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
788 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct PhysicalDeviceToolProperties where
  peekCStruct :: ("pToolProperties" ::: Ptr PhysicalDeviceToolProperties)
-> IO PhysicalDeviceToolProperties
peekCStruct "pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p = do
    ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))))
    ByteString
version <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))))
    ToolPurposeFlags
purposes <- forall a. Storable a => Ptr a -> IO a
peek @ToolPurposeFlags (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr ToolPurposeFlags))
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    ByteString
layer <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pToolProperties" ::: Ptr PhysicalDeviceToolProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
788 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> ToolPurposeFlags
-> ByteString
-> ByteString
-> PhysicalDeviceToolProperties
PhysicalDeviceToolProperties
             ByteString
name ByteString
version ToolPurposeFlags
purposes ByteString
description ByteString
layer

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

instance Zero PhysicalDeviceToolProperties where
  zero :: PhysicalDeviceToolProperties
zero = ByteString
-> ByteString
-> ToolPurposeFlags
-> ByteString
-> ByteString
-> PhysicalDeviceToolProperties
PhysicalDeviceToolProperties
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty