{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_debug_report  ( createDebugReportCallbackEXT
                                              , withDebugReportCallbackEXT
                                              , destroyDebugReportCallbackEXT
                                              , debugReportMessageEXT
                                              , pattern STRUCTURE_TYPE_DEBUG_REPORT_CREATE_INFO_EXT
                                              , DebugReportCallbackCreateInfoEXT(..)
                                              , DebugReportFlagBitsEXT( DEBUG_REPORT_INFORMATION_BIT_EXT
                                                                      , DEBUG_REPORT_WARNING_BIT_EXT
                                                                      , DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT
                                                                      , DEBUG_REPORT_ERROR_BIT_EXT
                                                                      , DEBUG_REPORT_DEBUG_BIT_EXT
                                                                      , ..
                                                                      )
                                              , DebugReportFlagsEXT
                                              , DebugReportObjectTypeEXT( DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT
                                                                        , DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT
                                                                        , ..
                                                                        )
                                              , PFN_vkDebugReportCallbackEXT
                                              , FN_vkDebugReportCallbackEXT
                                              , EXT_DEBUG_REPORT_SPEC_VERSION
                                              , pattern EXT_DEBUG_REPORT_SPEC_VERSION
                                              , EXT_DEBUG_REPORT_EXTENSION_NAME
                                              , pattern EXT_DEBUG_REPORT_EXTENSION_NAME
                                              , DebugReportCallbackEXT(..)
                                              ) where

import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.ByteString (useAsCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Foreign.C.Types (CChar(..))
import Foreign.C.Types (CSize(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
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 Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import Data.Word (Word64)
import Text.Read.Lex (Lexeme(Ident))
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Extensions.Handles (DebugReportCallbackEXT)
import Vulkan.Extensions.Handles (DebugReportCallbackEXT(..))
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Handles (Instance)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Dynamic (InstanceCmds(pVkCreateDebugReportCallbackEXT))
import Vulkan.Dynamic (InstanceCmds(pVkDebugReportMessageEXT))
import Vulkan.Dynamic (InstanceCmds(pVkDestroyDebugReportCallbackEXT))
import Vulkan.Core10.Handles (Instance_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEBUG_REPORT_CALLBACK_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (DebugReportCallbackEXT(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateDebugReportCallbackEXT
  :: FunPtr (Ptr Instance_T -> Ptr DebugReportCallbackCreateInfoEXT -> Ptr AllocationCallbacks -> Ptr DebugReportCallbackEXT -> IO Result) -> Ptr Instance_T -> Ptr DebugReportCallbackCreateInfoEXT -> Ptr AllocationCallbacks -> Ptr DebugReportCallbackEXT -> IO Result

-- | vkCreateDebugReportCallbackEXT - Create a debug report callback object
--
-- == Valid Usage (Implicit)
--
-- -   @instance@ /must/ be a valid 'Vulkan.Core10.Handles.Instance' handle
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'DebugReportCallbackCreateInfoEXT' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pCallback@ /must/ be a valid pointer to a
--     'Vulkan.Extensions.Handles.DebugReportCallbackEXT' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'DebugReportCallbackCreateInfoEXT',
-- 'Vulkan.Extensions.Handles.DebugReportCallbackEXT',
-- 'Vulkan.Core10.Handles.Instance'
createDebugReportCallbackEXT :: forall io
                              . (MonadIO io)
                             => -- | @instance@ is the instance the callback will be logged on.
                                Instance
                             -> -- | @pCreateInfo@ is a pointer to a 'DebugReportCallbackCreateInfoEXT'
                                -- structure defining the conditions under which this callback will be
                                -- called.
                                DebugReportCallbackCreateInfoEXT
                             -> -- | @pAllocator@ controls host memory allocation as described in the
                                -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                                -- chapter.
                                ("allocator" ::: Maybe AllocationCallbacks)
                             -> io (DebugReportCallbackEXT)
createDebugReportCallbackEXT :: Instance
-> DebugReportCallbackCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DebugReportCallbackEXT
createDebugReportCallbackEXT instance' :: Instance
instance' createInfo :: DebugReportCallbackCreateInfoEXT
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO DebugReportCallbackEXT -> io DebugReportCallbackEXT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DebugReportCallbackEXT -> io DebugReportCallbackEXT)
-> (ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
    -> IO DebugReportCallbackEXT)
-> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
-> io DebugReportCallbackEXT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
-> IO DebugReportCallbackEXT
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
 -> io DebugReportCallbackEXT)
-> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
-> io DebugReportCallbackEXT
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateDebugReportCallbackEXTPtr :: FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO Result)
vkCreateDebugReportCallbackEXTPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
      -> IO Result)
pVkCreateDebugReportCallbackEXT (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT DebugReportCallbackEXT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DebugReportCallbackEXT IO ())
-> IO () -> ContT DebugReportCallbackEXT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO Result)
vkCreateDebugReportCallbackEXTPtr FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateDebugReportCallbackEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateDebugReportCallbackEXT' :: Ptr Instance_T
-> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCallback" ::: Ptr DebugReportCallbackEXT)
-> IO Result
vkCreateDebugReportCallbackEXT' = FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO Result)
-> Ptr Instance_T
-> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCallback" ::: Ptr DebugReportCallbackEXT)
-> IO Result
mkVkCreateDebugReportCallbackEXT FunPtr
  (Ptr Instance_T
   -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO Result)
vkCreateDebugReportCallbackEXTPtr
  "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
pCreateInfo <- ((("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
  -> IO DebugReportCallbackEXT)
 -> IO DebugReportCallbackEXT)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
   -> IO DebugReportCallbackEXT)
  -> IO DebugReportCallbackEXT)
 -> ContT
      DebugReportCallbackEXT
      IO
      ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT))
-> ((("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
     -> IO DebugReportCallbackEXT)
    -> IO DebugReportCallbackEXT)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
forall a b. (a -> b) -> a -> b
$ DebugReportCallbackCreateInfoEXT
-> (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
    -> IO DebugReportCallbackEXT)
-> IO DebugReportCallbackEXT
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DebugReportCallbackCreateInfoEXT
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks)
  -> IO DebugReportCallbackEXT)
 -> IO DebugReportCallbackEXT)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO DebugReportCallbackEXT)
  -> IO DebugReportCallbackEXT)
 -> ContT
      DebugReportCallbackEXT
      IO
      ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
     -> IO DebugReportCallbackEXT)
    -> IO DebugReportCallbackEXT)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
    -> IO DebugReportCallbackEXT)
-> IO DebugReportCallbackEXT
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pCallback" ::: Ptr DebugReportCallbackEXT
pPCallback <- ((("pCallback" ::: Ptr DebugReportCallbackEXT)
  -> IO DebugReportCallbackEXT)
 -> IO DebugReportCallbackEXT)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pCallback" ::: Ptr DebugReportCallbackEXT)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCallback" ::: Ptr DebugReportCallbackEXT)
   -> IO DebugReportCallbackEXT)
  -> IO DebugReportCallbackEXT)
 -> ContT
      DebugReportCallbackEXT
      IO
      ("pCallback" ::: Ptr DebugReportCallbackEXT))
-> ((("pCallback" ::: Ptr DebugReportCallbackEXT)
     -> IO DebugReportCallbackEXT)
    -> IO DebugReportCallbackEXT)
-> ContT
     DebugReportCallbackEXT
     IO
     ("pCallback" ::: Ptr DebugReportCallbackEXT)
forall a b. (a -> b) -> a -> b
$ IO ("pCallback" ::: Ptr DebugReportCallbackEXT)
-> (("pCallback" ::: Ptr DebugReportCallbackEXT) -> IO ())
-> (("pCallback" ::: Ptr DebugReportCallbackEXT)
    -> IO DebugReportCallbackEXT)
-> IO DebugReportCallbackEXT
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pCallback" ::: Ptr DebugReportCallbackEXT)
forall a. Int -> IO (Ptr a)
callocBytes @DebugReportCallbackEXT 8) ("pCallback" ::: Ptr DebugReportCallbackEXT) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT DebugReportCallbackEXT IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT DebugReportCallbackEXT IO Result)
-> IO Result -> ContT DebugReportCallbackEXT IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCallback" ::: Ptr DebugReportCallbackEXT)
-> IO Result
vkCreateDebugReportCallbackEXT' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pCallback" ::: Ptr DebugReportCallbackEXT
pPCallback)
  IO () -> ContT DebugReportCallbackEXT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DebugReportCallbackEXT IO ())
-> IO () -> ContT DebugReportCallbackEXT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  DebugReportCallbackEXT
pCallback <- IO DebugReportCallbackEXT
-> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DebugReportCallbackEXT
 -> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT)
-> IO DebugReportCallbackEXT
-> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
forall a b. (a -> b) -> a -> b
$ ("pCallback" ::: Ptr DebugReportCallbackEXT)
-> IO DebugReportCallbackEXT
forall a. Storable a => Ptr a -> IO a
peek @DebugReportCallbackEXT "pCallback" ::: Ptr DebugReportCallbackEXT
pPCallback
  DebugReportCallbackEXT
-> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DebugReportCallbackEXT
 -> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT)
-> DebugReportCallbackEXT
-> ContT DebugReportCallbackEXT IO DebugReportCallbackEXT
forall a b. (a -> b) -> a -> b
$ (DebugReportCallbackEXT
pCallback)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createDebugReportCallbackEXT' and 'destroyDebugReportCallbackEXT'
--
-- To ensure that 'destroyDebugReportCallbackEXT' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withDebugReportCallbackEXT :: forall io r . MonadIO io => Instance -> DebugReportCallbackCreateInfoEXT -> Maybe AllocationCallbacks -> (io (DebugReportCallbackEXT) -> ((DebugReportCallbackEXT) -> io ()) -> r) -> r
withDebugReportCallbackEXT :: Instance
-> DebugReportCallbackCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io DebugReportCallbackEXT
    -> (DebugReportCallbackEXT -> io ()) -> r)
-> r
withDebugReportCallbackEXT instance' :: Instance
instance' pCreateInfo :: DebugReportCallbackCreateInfoEXT
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io DebugReportCallbackEXT -> (DebugReportCallbackEXT -> io ()) -> r
b =
  io DebugReportCallbackEXT -> (DebugReportCallbackEXT -> io ()) -> r
b (Instance
-> DebugReportCallbackCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DebugReportCallbackEXT
forall (io :: * -> *).
MonadIO io =>
Instance
-> DebugReportCallbackCreateInfoEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DebugReportCallbackEXT
createDebugReportCallbackEXT Instance
instance' DebugReportCallbackCreateInfoEXT
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(DebugReportCallbackEXT
o0) -> Instance
-> DebugReportCallbackEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Instance
-> DebugReportCallbackEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyDebugReportCallbackEXT Instance
instance' DebugReportCallbackEXT
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkDestroyDebugReportCallbackEXT
  :: FunPtr (Ptr Instance_T -> DebugReportCallbackEXT -> Ptr AllocationCallbacks -> IO ()) -> Ptr Instance_T -> DebugReportCallbackEXT -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyDebugReportCallbackEXT - Destroy a debug report callback object
--
-- == Valid Usage
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @callback@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @callback@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   @instance@ /must/ be a valid 'Vulkan.Core10.Handles.Instance' handle
--
-- -   If @callback@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @callback@ /must/ be a valid
--     'Vulkan.Extensions.Handles.DebugReportCallbackEXT' handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   If @callback@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @instance@
--
-- == Host Synchronization
--
-- -   Host access to @callback@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Extensions.Handles.DebugReportCallbackEXT',
-- 'Vulkan.Core10.Handles.Instance'
destroyDebugReportCallbackEXT :: forall io
                               . (MonadIO io)
                              => -- | @instance@ is the instance where the callback was created.
                                 Instance
                              -> -- | @callback@ is the 'Vulkan.Extensions.Handles.DebugReportCallbackEXT'
                                 -- object to destroy. @callback@ is an externally synchronized object and
                                 -- /must/ not be used on more than one thread at a time. This means that
                                 -- 'destroyDebugReportCallbackEXT' /must/ not be called when a callback is
                                 -- active.
                                 DebugReportCallbackEXT
                              -> -- | @pAllocator@ controls host memory allocation as described in the
                                 -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                                 -- chapter.
                                 ("allocator" ::: Maybe AllocationCallbacks)
                              -> io ()
destroyDebugReportCallbackEXT :: Instance
-> DebugReportCallbackEXT
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyDebugReportCallbackEXT instance' :: Instance
instance' callback :: DebugReportCallbackEXT
callback allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyDebugReportCallbackEXTPtr :: FunPtr
  (Ptr Instance_T
   -> DebugReportCallbackEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyDebugReportCallbackEXTPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> DebugReportCallbackEXT
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyDebugReportCallbackEXT (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> DebugReportCallbackEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyDebugReportCallbackEXTPtr FunPtr
  (Ptr Instance_T
   -> DebugReportCallbackEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Instance_T
      -> DebugReportCallbackEXT
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> DebugReportCallbackEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroyDebugReportCallbackEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyDebugReportCallbackEXT' :: Ptr Instance_T
-> DebugReportCallbackEXT
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyDebugReportCallbackEXT' = FunPtr
  (Ptr Instance_T
   -> DebugReportCallbackEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Instance_T
-> DebugReportCallbackEXT
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyDebugReportCallbackEXT FunPtr
  (Ptr Instance_T
   -> DebugReportCallbackEXT
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyDebugReportCallbackEXTPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> DebugReportCallbackEXT
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyDebugReportCallbackEXT' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (DebugReportCallbackEXT
callback) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkDebugReportMessageEXT
  :: FunPtr (Ptr Instance_T -> DebugReportFlagsEXT -> DebugReportObjectTypeEXT -> Word64 -> CSize -> Int32 -> Ptr CChar -> Ptr CChar -> IO ()) -> Ptr Instance_T -> DebugReportFlagsEXT -> DebugReportObjectTypeEXT -> Word64 -> CSize -> Int32 -> Ptr CChar -> Ptr CChar -> IO ()

-- | vkDebugReportMessageEXT - Inject a message into a debug stream
--
-- = Description
--
-- The call will propagate through the layers and generate callback(s) as
-- indicated by the message’s flags. The parameters are passed on to the
-- callback in addition to the @pUserData@ value that was defined at the
-- time the callback was registered.
--
-- == Valid Usage
--
-- -   @object@ /must/ be a Vulkan object or
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If @objectType@ is not 'DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT' and
--     @object@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @object@
--     /must/ be a Vulkan object of the corresponding type associated with
--     @objectType@ as defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#debug-report-object-types>
--
-- == Valid Usage (Implicit)
--
-- -   @instance@ /must/ be a valid 'Vulkan.Core10.Handles.Instance' handle
--
-- -   @flags@ /must/ be a valid combination of 'DebugReportFlagBitsEXT'
--     values
--
-- -   @flags@ /must/ not be @0@
--
-- -   @objectType@ /must/ be a valid 'DebugReportObjectTypeEXT' value
--
-- -   @pLayerPrefix@ /must/ be a null-terminated UTF-8 string
--
-- -   @pMessage@ /must/ be a null-terminated UTF-8 string
--
-- = See Also
--
-- 'DebugReportFlagsEXT', 'DebugReportObjectTypeEXT',
-- 'Vulkan.Core10.Handles.Instance'
debugReportMessageEXT :: forall io
                       . (MonadIO io)
                      => -- | @instance@ is the debug stream’s 'Vulkan.Core10.Handles.Instance'.
                         Instance
                      -> -- | @flags@ specifies the 'DebugReportFlagBitsEXT' classification of this
                         -- event\/message.
                         DebugReportFlagsEXT
                      -> -- | @objectType@ is a 'DebugReportObjectTypeEXT' specifying the type of
                         -- object being used or created at the time the event was triggered.
                         DebugReportObjectTypeEXT
                      -> -- | @object@ is the object where the issue was detected. @object@ /can/ be
                         -- 'Vulkan.Core10.APIConstants.NULL_HANDLE' if there is no object
                         -- associated with the event.
                         ("object" ::: Word64)
                      -> -- | @location@ is an application defined value.
                         ("location" ::: Word64)
                      -> -- | @messageCode@ is an application defined value.
                         ("messageCode" ::: Int32)
                      -> -- | @pLayerPrefix@ is the abbreviation of the component making this
                         -- event\/message.
                         ("layerPrefix" ::: ByteString)
                      -> -- | @pMessage@ is a null-terminated string detailing the trigger conditions.
                         ("message" ::: ByteString)
                      -> io ()
debugReportMessageEXT :: Instance
-> DebugReportFlagsEXT
-> DebugReportObjectTypeEXT
-> ("object" ::: Word64)
-> ("object" ::: Word64)
-> ("messageCode" ::: Int32)
-> ("layerPrefix" ::: ByteString)
-> ("layerPrefix" ::: ByteString)
-> io ()
debugReportMessageEXT instance' :: Instance
instance' flags :: DebugReportFlagsEXT
flags objectType :: DebugReportObjectTypeEXT
objectType object :: "object" ::: Word64
object location :: "object" ::: Word64
location messageCode :: "messageCode" ::: Int32
messageCode layerPrefix :: "layerPrefix" ::: ByteString
layerPrefix message :: "layerPrefix" ::: ByteString
message = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDebugReportMessageEXTPtr :: FunPtr
  (Ptr Instance_T
   -> DebugReportFlagsEXT
   -> DebugReportObjectTypeEXT
   -> ("object" ::: Word64)
   -> ("location" ::: CSize)
   -> ("messageCode" ::: Int32)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> IO ())
vkDebugReportMessageEXTPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> DebugReportFlagsEXT
      -> DebugReportObjectTypeEXT
      -> ("object" ::: Word64)
      -> ("location" ::: CSize)
      -> ("messageCode" ::: Int32)
      -> ("pLayerPrefix" ::: Ptr CChar)
      -> ("pLayerPrefix" ::: Ptr CChar)
      -> IO ())
pVkDebugReportMessageEXT (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> DebugReportFlagsEXT
   -> DebugReportObjectTypeEXT
   -> ("object" ::: Word64)
   -> ("location" ::: CSize)
   -> ("messageCode" ::: Int32)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> IO ())
vkDebugReportMessageEXTPtr FunPtr
  (Ptr Instance_T
   -> DebugReportFlagsEXT
   -> DebugReportObjectTypeEXT
   -> ("object" ::: Word64)
   -> ("location" ::: CSize)
   -> ("messageCode" ::: Int32)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> IO ())
-> FunPtr
     (Ptr Instance_T
      -> DebugReportFlagsEXT
      -> DebugReportObjectTypeEXT
      -> ("object" ::: Word64)
      -> ("location" ::: CSize)
      -> ("messageCode" ::: Int32)
      -> ("pLayerPrefix" ::: Ptr CChar)
      -> ("pLayerPrefix" ::: Ptr CChar)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> DebugReportFlagsEXT
   -> DebugReportObjectTypeEXT
   -> ("object" ::: Word64)
   -> ("location" ::: CSize)
   -> ("messageCode" ::: Int32)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDebugReportMessageEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDebugReportMessageEXT' :: Ptr Instance_T
-> DebugReportFlagsEXT
-> DebugReportObjectTypeEXT
-> ("object" ::: Word64)
-> ("location" ::: CSize)
-> ("messageCode" ::: Int32)
-> ("pLayerPrefix" ::: Ptr CChar)
-> ("pLayerPrefix" ::: Ptr CChar)
-> IO ()
vkDebugReportMessageEXT' = FunPtr
  (Ptr Instance_T
   -> DebugReportFlagsEXT
   -> DebugReportObjectTypeEXT
   -> ("object" ::: Word64)
   -> ("location" ::: CSize)
   -> ("messageCode" ::: Int32)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> IO ())
-> Ptr Instance_T
-> DebugReportFlagsEXT
-> DebugReportObjectTypeEXT
-> ("object" ::: Word64)
-> ("location" ::: CSize)
-> ("messageCode" ::: Int32)
-> ("pLayerPrefix" ::: Ptr CChar)
-> ("pLayerPrefix" ::: Ptr CChar)
-> IO ()
mkVkDebugReportMessageEXT FunPtr
  (Ptr Instance_T
   -> DebugReportFlagsEXT
   -> DebugReportObjectTypeEXT
   -> ("object" ::: Word64)
   -> ("location" ::: CSize)
   -> ("messageCode" ::: Int32)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> ("pLayerPrefix" ::: Ptr CChar)
   -> IO ())
vkDebugReportMessageEXTPtr
  "pLayerPrefix" ::: Ptr CChar
pLayerPrefix <- ((("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("pLayerPrefix" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ())
 -> ContT () IO ("pLayerPrefix" ::: Ptr CChar))
-> ((("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("pLayerPrefix" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("layerPrefix" ::: ByteString)
-> (("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ()
forall a.
("layerPrefix" ::: ByteString)
-> (("pLayerPrefix" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("layerPrefix" ::: ByteString
layerPrefix)
  "pLayerPrefix" ::: Ptr CChar
pMessage <- ((("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("pLayerPrefix" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ())
 -> ContT () IO ("pLayerPrefix" ::: Ptr CChar))
-> ((("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("pLayerPrefix" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("layerPrefix" ::: ByteString)
-> (("pLayerPrefix" ::: Ptr CChar) -> IO ()) -> IO ()
forall a.
("layerPrefix" ::: ByteString)
-> (("pLayerPrefix" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("layerPrefix" ::: ByteString
message)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> DebugReportFlagsEXT
-> DebugReportObjectTypeEXT
-> ("object" ::: Word64)
-> ("location" ::: CSize)
-> ("messageCode" ::: Int32)
-> ("pLayerPrefix" ::: Ptr CChar)
-> ("pLayerPrefix" ::: Ptr CChar)
-> IO ()
vkDebugReportMessageEXT' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (DebugReportFlagsEXT
flags) (DebugReportObjectTypeEXT
objectType) ("object" ::: Word64
object) (("object" ::: Word64) -> "location" ::: CSize
CSize ("object" ::: Word64
location)) ("messageCode" ::: Int32
messageCode) "pLayerPrefix" ::: Ptr CChar
pLayerPrefix "pLayerPrefix" ::: Ptr CChar
pMessage
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- No documentation found for TopLevel "VK_STRUCTURE_TYPE_DEBUG_REPORT_CREATE_INFO_EXT"
pattern $bSTRUCTURE_TYPE_DEBUG_REPORT_CREATE_INFO_EXT :: StructureType
$mSTRUCTURE_TYPE_DEBUG_REPORT_CREATE_INFO_EXT :: forall r. StructureType -> (Void# -> r) -> (Void# -> r) -> r
STRUCTURE_TYPE_DEBUG_REPORT_CREATE_INFO_EXT = STRUCTURE_TYPE_DEBUG_REPORT_CALLBACK_CREATE_INFO_EXT


-- | VkDebugReportCallbackCreateInfoEXT - Structure specifying parameters of
-- a newly created debug report callback
--
-- = Description
--
-- For each 'Vulkan.Extensions.Handles.DebugReportCallbackEXT' that is
-- created the 'DebugReportCallbackCreateInfoEXT'::@flags@ determine when
-- that 'DebugReportCallbackCreateInfoEXT'::@pfnCallback@ is called. When
-- an event happens, the implementation will do a bitwise AND of the
-- event’s 'DebugReportFlagBitsEXT' flags to each
-- 'Vulkan.Extensions.Handles.DebugReportCallbackEXT' object’s flags. For
-- each non-zero result the corresponding callback will be called. The
-- callback will come directly from the component that detected the event,
-- unless some other layer intercepts the calls for its own purposes
-- (filter them in a different way, log to a system error log, etc.).
--
-- An application /may/ receive multiple callbacks if multiple
-- 'Vulkan.Extensions.Handles.DebugReportCallbackEXT' objects were created.
-- A callback will always be executed in the same thread as the originating
-- Vulkan call.
--
-- A callback may be called from multiple threads simultaneously (if the
-- application is making Vulkan calls from multiple threads).
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'PFN_vkDebugReportCallbackEXT', 'DebugReportFlagsEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'createDebugReportCallbackEXT'
data DebugReportCallbackCreateInfoEXT = DebugReportCallbackCreateInfoEXT
  { -- | @flags@ is a bitmask of 'DebugReportFlagBitsEXT' specifying which
    -- event(s) will cause this callback to be called.
    --
    -- @flags@ /must/ be a valid combination of 'DebugReportFlagBitsEXT' values
    DebugReportCallbackCreateInfoEXT -> DebugReportFlagsEXT
flags :: DebugReportFlagsEXT
  , -- | @pfnCallback@ is the application callback function to call.
    --
    -- @pfnCallback@ /must/ be a valid 'PFN_vkDebugReportCallbackEXT' value
    DebugReportCallbackCreateInfoEXT -> PFN_vkDebugReportCallbackEXT
pfnCallback :: PFN_vkDebugReportCallbackEXT
  , -- | @pUserData@ is user data to be passed to the callback.
    DebugReportCallbackCreateInfoEXT -> Ptr ()
userData :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DebugReportCallbackCreateInfoEXT)
#endif
deriving instance Show DebugReportCallbackCreateInfoEXT

instance ToCStruct DebugReportCallbackCreateInfoEXT where
  withCStruct :: DebugReportCallbackCreateInfoEXT
-> (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
    -> IO b)
-> IO b
withCStruct x :: DebugReportCallbackCreateInfoEXT
x f :: ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT) -> IO b
f = Int
-> Int
-> (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
    -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT) -> IO b)
 -> IO b)
-> (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p -> ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> DebugReportCallbackCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p DebugReportCallbackCreateInfoEXT
x (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT) -> IO b
f "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p)
  pokeCStruct :: ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> DebugReportCallbackCreateInfoEXT -> IO b -> IO b
pokeCStruct p :: "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p DebugReportCallbackCreateInfoEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEBUG_REPORT_CALLBACK_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DebugReportFlagsEXT -> DebugReportFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr DebugReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DebugReportFlagsEXT)) (DebugReportFlagsEXT
flags)
    Ptr PFN_vkDebugReportCallbackEXT
-> PFN_vkDebugReportCallbackEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr PFN_vkDebugReportCallbackEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr PFN_vkDebugReportCallbackEXT)) (PFN_vkDebugReportCallbackEXT
pfnCallback)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ()))) (Ptr ()
userData)
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> IO b -> IO b
pokeZeroCStruct p :: "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEBUG_REPORT_CALLBACK_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr PFN_vkDebugReportCallbackEXT
-> PFN_vkDebugReportCallbackEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr PFN_vkDebugReportCallbackEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr PFN_vkDebugReportCallbackEXT)) (PFN_vkDebugReportCallbackEXT
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DebugReportCallbackCreateInfoEXT where
  peekCStruct :: ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> IO DebugReportCallbackCreateInfoEXT
peekCStruct p :: "pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p = do
    DebugReportFlagsEXT
flags <- Ptr DebugReportFlagsEXT -> IO DebugReportFlagsEXT
forall a. Storable a => Ptr a -> IO a
peek @DebugReportFlagsEXT (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr DebugReportFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DebugReportFlagsEXT))
    PFN_vkDebugReportCallbackEXT
pfnCallback <- Ptr PFN_vkDebugReportCallbackEXT -> IO PFN_vkDebugReportCallbackEXT
forall a. Storable a => Ptr a -> IO a
peek @PFN_vkDebugReportCallbackEXT (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr PFN_vkDebugReportCallbackEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr PFN_vkDebugReportCallbackEXT))
    Ptr ()
pUserData <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT
p ("pCreateInfo" ::: Ptr DebugReportCallbackCreateInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ())))
    DebugReportCallbackCreateInfoEXT
-> IO DebugReportCallbackCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DebugReportCallbackCreateInfoEXT
 -> IO DebugReportCallbackCreateInfoEXT)
-> DebugReportCallbackCreateInfoEXT
-> IO DebugReportCallbackCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ DebugReportFlagsEXT
-> PFN_vkDebugReportCallbackEXT
-> Ptr ()
-> DebugReportCallbackCreateInfoEXT
DebugReportCallbackCreateInfoEXT
             DebugReportFlagsEXT
flags PFN_vkDebugReportCallbackEXT
pfnCallback Ptr ()
pUserData

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

instance Zero DebugReportCallbackCreateInfoEXT where
  zero :: DebugReportCallbackCreateInfoEXT
zero = DebugReportFlagsEXT
-> PFN_vkDebugReportCallbackEXT
-> Ptr ()
-> DebugReportCallbackCreateInfoEXT
DebugReportCallbackCreateInfoEXT
           DebugReportFlagsEXT
forall a. Zero a => a
zero
           PFN_vkDebugReportCallbackEXT
forall a. Zero a => a
zero
           Ptr ()
forall a. Zero a => a
zero


-- | VkDebugReportFlagBitsEXT - Bitmask specifying events which cause a debug
-- report callback
--
-- = See Also
--
-- 'DebugReportFlagsEXT'
newtype DebugReportFlagBitsEXT = DebugReportFlagBitsEXT Flags
  deriving newtype (DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
(DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool)
-> (DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool)
-> Eq DebugReportFlagsEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
$c/= :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
== :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
$c== :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
Eq, Eq DebugReportFlagsEXT
Eq DebugReportFlagsEXT =>
(DebugReportFlagsEXT -> DebugReportFlagsEXT -> Ordering)
-> (DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool)
-> (DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool)
-> (DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool)
-> (DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool)
-> (DebugReportFlagsEXT
    -> DebugReportFlagsEXT -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT
    -> DebugReportFlagsEXT -> DebugReportFlagsEXT)
-> Ord DebugReportFlagsEXT
DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
DebugReportFlagsEXT -> DebugReportFlagsEXT -> Ordering
DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
$cmin :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
max :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
$cmax :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
>= :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
$c>= :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
> :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
$c> :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
<= :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
$c<= :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
< :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
$c< :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Bool
compare :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Ordering
$ccompare :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> Ordering
$cp1Ord :: Eq DebugReportFlagsEXT
Ord, Ptr b -> Int -> IO DebugReportFlagsEXT
Ptr b -> Int -> DebugReportFlagsEXT -> IO ()
Ptr DebugReportFlagsEXT -> IO DebugReportFlagsEXT
Ptr DebugReportFlagsEXT -> Int -> IO DebugReportFlagsEXT
Ptr DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT -> IO ()
Ptr DebugReportFlagsEXT -> DebugReportFlagsEXT -> IO ()
DebugReportFlagsEXT -> Int
(DebugReportFlagsEXT -> Int)
-> (DebugReportFlagsEXT -> Int)
-> (Ptr DebugReportFlagsEXT -> Int -> IO DebugReportFlagsEXT)
-> (Ptr DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO DebugReportFlagsEXT)
-> (forall b. Ptr b -> Int -> DebugReportFlagsEXT -> IO ())
-> (Ptr DebugReportFlagsEXT -> IO DebugReportFlagsEXT)
-> (Ptr DebugReportFlagsEXT -> DebugReportFlagsEXT -> IO ())
-> Storable DebugReportFlagsEXT
forall b. Ptr b -> Int -> IO DebugReportFlagsEXT
forall b. Ptr b -> Int -> DebugReportFlagsEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DebugReportFlagsEXT -> DebugReportFlagsEXT -> IO ()
$cpoke :: Ptr DebugReportFlagsEXT -> DebugReportFlagsEXT -> IO ()
peek :: Ptr DebugReportFlagsEXT -> IO DebugReportFlagsEXT
$cpeek :: Ptr DebugReportFlagsEXT -> IO DebugReportFlagsEXT
pokeByteOff :: Ptr b -> Int -> DebugReportFlagsEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DebugReportFlagsEXT -> IO ()
peekByteOff :: Ptr b -> Int -> IO DebugReportFlagsEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DebugReportFlagsEXT
pokeElemOff :: Ptr DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT -> IO ()
$cpokeElemOff :: Ptr DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT -> IO ()
peekElemOff :: Ptr DebugReportFlagsEXT -> Int -> IO DebugReportFlagsEXT
$cpeekElemOff :: Ptr DebugReportFlagsEXT -> Int -> IO DebugReportFlagsEXT
alignment :: DebugReportFlagsEXT -> Int
$calignment :: DebugReportFlagsEXT -> Int
sizeOf :: DebugReportFlagsEXT -> Int
$csizeOf :: DebugReportFlagsEXT -> Int
Storable, DebugReportFlagsEXT
DebugReportFlagsEXT -> Zero DebugReportFlagsEXT
forall a. a -> Zero a
zero :: DebugReportFlagsEXT
$czero :: DebugReportFlagsEXT
Zero, Eq DebugReportFlagsEXT
DebugReportFlagsEXT
Eq DebugReportFlagsEXT =>
(DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT
    -> DebugReportFlagsEXT -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT
    -> DebugReportFlagsEXT -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> DebugReportFlagsEXT
-> (Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> Bool)
-> (DebugReportFlagsEXT -> Maybe Int)
-> (DebugReportFlagsEXT -> Int)
-> (DebugReportFlagsEXT -> Bool)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT)
-> (DebugReportFlagsEXT -> Int)
-> Bits DebugReportFlagsEXT
Int -> DebugReportFlagsEXT
DebugReportFlagsEXT -> Bool
DebugReportFlagsEXT -> Int
DebugReportFlagsEXT -> Maybe Int
DebugReportFlagsEXT -> DebugReportFlagsEXT
DebugReportFlagsEXT -> Int -> Bool
DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: DebugReportFlagsEXT -> Int
$cpopCount :: DebugReportFlagsEXT -> Int
rotateR :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$crotateR :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
rotateL :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$crotateL :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
unsafeShiftR :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$cunsafeShiftR :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
shiftR :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$cshiftR :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
unsafeShiftL :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$cunsafeShiftL :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
shiftL :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$cshiftL :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
isSigned :: DebugReportFlagsEXT -> Bool
$cisSigned :: DebugReportFlagsEXT -> Bool
bitSize :: DebugReportFlagsEXT -> Int
$cbitSize :: DebugReportFlagsEXT -> Int
bitSizeMaybe :: DebugReportFlagsEXT -> Maybe Int
$cbitSizeMaybe :: DebugReportFlagsEXT -> Maybe Int
testBit :: DebugReportFlagsEXT -> Int -> Bool
$ctestBit :: DebugReportFlagsEXT -> Int -> Bool
complementBit :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$ccomplementBit :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
clearBit :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$cclearBit :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
setBit :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$csetBit :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
bit :: Int -> DebugReportFlagsEXT
$cbit :: Int -> DebugReportFlagsEXT
zeroBits :: DebugReportFlagsEXT
$czeroBits :: DebugReportFlagsEXT
rotate :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$crotate :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
shift :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
$cshift :: DebugReportFlagsEXT -> Int -> DebugReportFlagsEXT
complement :: DebugReportFlagsEXT -> DebugReportFlagsEXT
$ccomplement :: DebugReportFlagsEXT -> DebugReportFlagsEXT
xor :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
$cxor :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
.|. :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
$c.|. :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
.&. :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
$c.&. :: DebugReportFlagsEXT -> DebugReportFlagsEXT -> DebugReportFlagsEXT
$cp1Bits :: Eq DebugReportFlagsEXT
Bits)

-- | 'DEBUG_REPORT_INFORMATION_BIT_EXT' specifies an informational message
-- such as resource details that may be handy when debugging an
-- application.
pattern $bDEBUG_REPORT_INFORMATION_BIT_EXT :: DebugReportFlagsEXT
$mDEBUG_REPORT_INFORMATION_BIT_EXT :: forall r. DebugReportFlagsEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_INFORMATION_BIT_EXT = DebugReportFlagBitsEXT 0x00000001
-- | 'DEBUG_REPORT_WARNING_BIT_EXT' specifies use of Vulkan that /may/ expose
-- an app bug. Such cases may not be immediately harmful, such as a
-- fragment shader outputting to a location with no attachment. Other cases
-- /may/ point to behavior that is almost certainly bad when unintended
-- such as using an image whose memory has not been filled. In general if
-- you see a warning but you know that the behavior is intended\/desired,
-- then simply ignore the warning.
pattern $bDEBUG_REPORT_WARNING_BIT_EXT :: DebugReportFlagsEXT
$mDEBUG_REPORT_WARNING_BIT_EXT :: forall r. DebugReportFlagsEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_WARNING_BIT_EXT = DebugReportFlagBitsEXT 0x00000002
-- | 'DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT' specifies a potentially
-- non-optimal use of Vulkan, e.g. using
-- 'Vulkan.Core10.CommandBufferBuilding.cmdClearColorImage' when setting
-- 'Vulkan.Core10.Pass.AttachmentDescription'::@loadOp@ to
-- 'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_CLEAR' would
-- have worked.
pattern $bDEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT :: DebugReportFlagsEXT
$mDEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT :: forall r. DebugReportFlagsEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT = DebugReportFlagBitsEXT 0x00000004
-- | 'DEBUG_REPORT_ERROR_BIT_EXT' specifies that the application has violated
-- a valid usage condition of the specification.
pattern $bDEBUG_REPORT_ERROR_BIT_EXT :: DebugReportFlagsEXT
$mDEBUG_REPORT_ERROR_BIT_EXT :: forall r. DebugReportFlagsEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_ERROR_BIT_EXT = DebugReportFlagBitsEXT 0x00000008
-- | 'DEBUG_REPORT_DEBUG_BIT_EXT' specifies diagnostic information from the
-- implementation and layers.
pattern $bDEBUG_REPORT_DEBUG_BIT_EXT :: DebugReportFlagsEXT
$mDEBUG_REPORT_DEBUG_BIT_EXT :: forall r. DebugReportFlagsEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_DEBUG_BIT_EXT = DebugReportFlagBitsEXT 0x00000010

type DebugReportFlagsEXT = DebugReportFlagBitsEXT

instance Show DebugReportFlagBitsEXT where
  showsPrec :: Int -> DebugReportFlagsEXT -> ShowS
showsPrec p :: Int
p = \case
    DEBUG_REPORT_INFORMATION_BIT_EXT -> String -> ShowS
showString "DEBUG_REPORT_INFORMATION_BIT_EXT"
    DEBUG_REPORT_WARNING_BIT_EXT -> String -> ShowS
showString "DEBUG_REPORT_WARNING_BIT_EXT"
    DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT -> String -> ShowS
showString "DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT"
    DEBUG_REPORT_ERROR_BIT_EXT -> String -> ShowS
showString "DEBUG_REPORT_ERROR_BIT_EXT"
    DEBUG_REPORT_DEBUG_BIT_EXT -> String -> ShowS
showString "DEBUG_REPORT_DEBUG_BIT_EXT"
    DebugReportFlagBitsEXT x :: Flags
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "DebugReportFlagBitsEXT 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read DebugReportFlagBitsEXT where
  readPrec :: ReadPrec DebugReportFlagsEXT
readPrec = ReadPrec DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec DebugReportFlagsEXT)]
-> ReadPrec DebugReportFlagsEXT
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("DEBUG_REPORT_INFORMATION_BIT_EXT", DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportFlagsEXT
DEBUG_REPORT_INFORMATION_BIT_EXT)
                            , ("DEBUG_REPORT_WARNING_BIT_EXT", DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportFlagsEXT
DEBUG_REPORT_WARNING_BIT_EXT)
                            , ("DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT", DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportFlagsEXT
DEBUG_REPORT_PERFORMANCE_WARNING_BIT_EXT)
                            , ("DEBUG_REPORT_ERROR_BIT_EXT", DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportFlagsEXT
DEBUG_REPORT_ERROR_BIT_EXT)
                            , ("DEBUG_REPORT_DEBUG_BIT_EXT", DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportFlagsEXT
DEBUG_REPORT_DEBUG_BIT_EXT)]
                     ReadPrec DebugReportFlagsEXT
-> ReadPrec DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int -> ReadPrec DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "DebugReportFlagBitsEXT")
                       Flags
v <- ReadPrec Flags -> ReadPrec Flags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Flags
forall a. Read a => ReadPrec a
readPrec
                       DebugReportFlagsEXT -> ReadPrec DebugReportFlagsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flags -> DebugReportFlagsEXT
DebugReportFlagBitsEXT Flags
v)))


-- | VkDebugReportObjectTypeEXT - Specify the type of an object handle
--
-- = Description
--
-- \'
--
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DebugReportObjectTypeEXT'                                | Vulkan Handle Type                                 |
-- +===========================================================+====================================================+
-- | 'DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT'                    | Unknown\/Undefined Handle                          |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT'                   | 'Vulkan.Core10.Handles.Instance'                   |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT'            | 'Vulkan.Core10.Handles.PhysicalDevice'             |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT'                     | 'Vulkan.Core10.Handles.Device'                     |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT'                      | 'Vulkan.Core10.Handles.Queue'                      |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT'                  | 'Vulkan.Core10.Handles.Semaphore'                  |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT'             | 'Vulkan.Core10.Handles.CommandBuffer'              |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT'                      | 'Vulkan.Core10.Handles.Fence'                      |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT'              | 'Vulkan.Core10.Handles.DeviceMemory'               |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT'                     | 'Vulkan.Core10.Handles.Buffer'                     |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT'                      | 'Vulkan.Core10.Handles.Image'                      |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT'                      | 'Vulkan.Core10.Handles.Event'                      |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT'                 | 'Vulkan.Core10.Handles.QueryPool'                  |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT'                | 'Vulkan.Core10.Handles.BufferView'                 |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT'                 | 'Vulkan.Core10.Handles.ImageView'                  |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT'              | 'Vulkan.Core10.Handles.ShaderModule'               |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT'             | 'Vulkan.Core10.Handles.PipelineCache'              |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT'            | 'Vulkan.Core10.Handles.PipelineLayout'             |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT'                | 'Vulkan.Core10.Handles.RenderPass'                 |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT'                   | 'Vulkan.Core10.Handles.Pipeline'                   |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT'      | 'Vulkan.Core10.Handles.DescriptorSetLayout'        |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT'                    | 'Vulkan.Core10.Handles.Sampler'                    |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT'            | 'Vulkan.Core10.Handles.DescriptorPool'             |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT'             | 'Vulkan.Core10.Handles.DescriptorSet'              |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT'                | 'Vulkan.Core10.Handles.Framebuffer'                |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT'               | 'Vulkan.Core10.Handles.CommandPool'                |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT'                | 'Vulkan.Extensions.Handles.SurfaceKHR'             |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT'              | 'Vulkan.Extensions.Handles.SwapchainKHR'           |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT'  | 'Vulkan.Extensions.Handles.DebugReportCallbackEXT' |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT'                | 'Vulkan.Extensions.Handles.DisplayKHR'             |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT'           | 'Vulkan.Extensions.Handles.DisplayModeKHR'         |
-- +-----------------------------------------------------------+----------------------------------------------------+
-- | 'DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT' | 'Vulkan.Core11.Handles.DescriptorUpdateTemplate'   |
-- +-----------------------------------------------------------+----------------------------------------------------+
--
-- 'DebugReportObjectTypeEXT' and Vulkan Handle Relationship
--
-- Note
--
-- The primary expected use of
-- 'Vulkan.Core10.Enums.Result.ERROR_VALIDATION_FAILED_EXT' is for
-- validation layer testing. It is not expected that an application would
-- see this error code during normal use of the validation layers.
--
-- = See Also
--
-- 'Vulkan.Extensions.VK_EXT_debug_marker.DebugMarkerObjectNameInfoEXT',
-- 'Vulkan.Extensions.VK_EXT_debug_marker.DebugMarkerObjectTagInfoEXT',
-- 'debugReportMessageEXT'
newtype DebugReportObjectTypeEXT = DebugReportObjectTypeEXT Int32
  deriving newtype (DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
(DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool)
-> (DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool)
-> Eq DebugReportObjectTypeEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
$c/= :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
== :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
$c== :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
Eq, Eq DebugReportObjectTypeEXT
Eq DebugReportObjectTypeEXT =>
(DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Ordering)
-> (DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool)
-> (DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool)
-> (DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool)
-> (DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool)
-> (DebugReportObjectTypeEXT
    -> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT)
-> (DebugReportObjectTypeEXT
    -> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT)
-> Ord DebugReportObjectTypeEXT
DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Ordering
DebugReportObjectTypeEXT
-> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebugReportObjectTypeEXT
-> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT
$cmin :: DebugReportObjectTypeEXT
-> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT
max :: DebugReportObjectTypeEXT
-> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT
$cmax :: DebugReportObjectTypeEXT
-> DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT
>= :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
$c>= :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
> :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
$c> :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
<= :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
$c<= :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
< :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
$c< :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Bool
compare :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Ordering
$ccompare :: DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> Ordering
$cp1Ord :: Eq DebugReportObjectTypeEXT
Ord, Ptr b -> Int -> IO DebugReportObjectTypeEXT
Ptr b -> Int -> DebugReportObjectTypeEXT -> IO ()
Ptr DebugReportObjectTypeEXT -> IO DebugReportObjectTypeEXT
Ptr DebugReportObjectTypeEXT -> Int -> IO DebugReportObjectTypeEXT
Ptr DebugReportObjectTypeEXT
-> Int -> DebugReportObjectTypeEXT -> IO ()
Ptr DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> IO ()
DebugReportObjectTypeEXT -> Int
(DebugReportObjectTypeEXT -> Int)
-> (DebugReportObjectTypeEXT -> Int)
-> (Ptr DebugReportObjectTypeEXT
    -> Int -> IO DebugReportObjectTypeEXT)
-> (Ptr DebugReportObjectTypeEXT
    -> Int -> DebugReportObjectTypeEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO DebugReportObjectTypeEXT)
-> (forall b. Ptr b -> Int -> DebugReportObjectTypeEXT -> IO ())
-> (Ptr DebugReportObjectTypeEXT -> IO DebugReportObjectTypeEXT)
-> (Ptr DebugReportObjectTypeEXT
    -> DebugReportObjectTypeEXT -> IO ())
-> Storable DebugReportObjectTypeEXT
forall b. Ptr b -> Int -> IO DebugReportObjectTypeEXT
forall b. Ptr b -> Int -> DebugReportObjectTypeEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> IO ()
$cpoke :: Ptr DebugReportObjectTypeEXT -> DebugReportObjectTypeEXT -> IO ()
peek :: Ptr DebugReportObjectTypeEXT -> IO DebugReportObjectTypeEXT
$cpeek :: Ptr DebugReportObjectTypeEXT -> IO DebugReportObjectTypeEXT
pokeByteOff :: Ptr b -> Int -> DebugReportObjectTypeEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DebugReportObjectTypeEXT -> IO ()
peekByteOff :: Ptr b -> Int -> IO DebugReportObjectTypeEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DebugReportObjectTypeEXT
pokeElemOff :: Ptr DebugReportObjectTypeEXT
-> Int -> DebugReportObjectTypeEXT -> IO ()
$cpokeElemOff :: Ptr DebugReportObjectTypeEXT
-> Int -> DebugReportObjectTypeEXT -> IO ()
peekElemOff :: Ptr DebugReportObjectTypeEXT -> Int -> IO DebugReportObjectTypeEXT
$cpeekElemOff :: Ptr DebugReportObjectTypeEXT -> Int -> IO DebugReportObjectTypeEXT
alignment :: DebugReportObjectTypeEXT -> Int
$calignment :: DebugReportObjectTypeEXT -> Int
sizeOf :: DebugReportObjectTypeEXT -> Int
$csizeOf :: DebugReportObjectTypeEXT -> Int
Storable, DebugReportObjectTypeEXT
DebugReportObjectTypeEXT -> Zero DebugReportObjectTypeEXT
forall a. a -> Zero a
zero :: DebugReportObjectTypeEXT
$czero :: DebugReportObjectTypeEXT
Zero)

-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT = DebugReportObjectTypeEXT 0
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT = DebugReportObjectTypeEXT 1
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT = DebugReportObjectTypeEXT 2
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT = DebugReportObjectTypeEXT 3
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT = DebugReportObjectTypeEXT 4
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT = DebugReportObjectTypeEXT 5
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT = DebugReportObjectTypeEXT 6
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_FENCE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_FENCE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT = DebugReportObjectTypeEXT 7
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT = DebugReportObjectTypeEXT 8
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT = DebugReportObjectTypeEXT 9
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT = DebugReportObjectTypeEXT 10
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_EVENT_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_EVENT_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT = DebugReportObjectTypeEXT 11
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT = DebugReportObjectTypeEXT 12
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT = DebugReportObjectTypeEXT 13
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT = DebugReportObjectTypeEXT 14
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT = DebugReportObjectTypeEXT 15
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT = DebugReportObjectTypeEXT 16
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT = DebugReportObjectTypeEXT 17
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT = DebugReportObjectTypeEXT 18
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT = DebugReportObjectTypeEXT 19
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT = DebugReportObjectTypeEXT 20
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT = DebugReportObjectTypeEXT 21
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT = DebugReportObjectTypeEXT 22
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT = DebugReportObjectTypeEXT 23
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT = DebugReportObjectTypeEXT 24
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT = DebugReportObjectTypeEXT 25
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT = DebugReportObjectTypeEXT 26
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT = DebugReportObjectTypeEXT 27
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT = DebugReportObjectTypeEXT 28
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT = DebugReportObjectTypeEXT 29
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT = DebugReportObjectTypeEXT 30
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT = DebugReportObjectTypeEXT 33
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT = DebugReportObjectTypeEXT 1000156000
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT = DebugReportObjectTypeEXT 1000165000
-- No documentation found for Nested "VkDebugReportObjectTypeEXT" "VK_DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT"
pattern $bDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT :: DebugReportObjectTypeEXT
$mDEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT :: forall r.
DebugReportObjectTypeEXT -> (Void# -> r) -> (Void# -> r) -> r
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT = DebugReportObjectTypeEXT 1000085000
{-# complete DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT,
             DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT,
             DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT,
             DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT,
             DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT,
             DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT,
             DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT,
             DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT,
             DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT,
             DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT,
             DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT,
             DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT,
             DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT,
             DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT,
             DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT,
             DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT,
             DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT,
             DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT,
             DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT,
             DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT :: DebugReportObjectTypeEXT #-}

instance Show DebugReportObjectTypeEXT where
  showsPrec :: Int -> DebugReportObjectTypeEXT -> ShowS
showsPrec p :: Int
p = \case
    DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT"
    DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT"
    DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT"
    DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT"
    DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT"
    DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT"
    DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT"
    DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT"
    DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT"
    DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT"
    DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT"
    DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT"
    DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT"
    DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT"
    DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT"
    DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT"
    DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT"
    DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT"
    DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT"
    DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT -> String -> ShowS
showString "DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT"
    DebugReportObjectTypeEXT x :: "messageCode" ::: Int32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "DebugReportObjectTypeEXT " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ("messageCode" ::: Int32) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 "messageCode" ::: Int32
x)

instance Read DebugReportObjectTypeEXT where
  readPrec :: ReadPrec DebugReportObjectTypeEXT
readPrec = ReadPrec DebugReportObjectTypeEXT
-> ReadPrec DebugReportObjectTypeEXT
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec DebugReportObjectTypeEXT)]
-> ReadPrec DebugReportObjectTypeEXT
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_INSTANCE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_PHYSICAL_DEVICE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_QUEUE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_SEMAPHORE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_COMMAND_BUFFER_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_FENCE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DEVICE_MEMORY_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_BUFFER_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_IMAGE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_EVENT_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_QUERY_POOL_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_BUFFER_VIEW_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_IMAGE_VIEW_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_PIPELINE_CACHE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_PIPELINE_LAYOUT_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_RENDER_PASS_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_PIPELINE_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_LAYOUT_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_SAMPLER_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_POOL_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_SET_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_FRAMEBUFFER_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_COMMAND_POOL_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_SURFACE_KHR_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_SWAPCHAIN_KHR_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DEBUG_REPORT_CALLBACK_EXT_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DISPLAY_KHR_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DISPLAY_MODE_KHR_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_VALIDATION_CACHE_EXT_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_SAMPLER_YCBCR_CONVERSION_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_ACCELERATION_STRUCTURE_KHR_EXT)
                            , ("DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT", DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure DebugReportObjectTypeEXT
DEBUG_REPORT_OBJECT_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_EXT)]
                     ReadPrec DebugReportObjectTypeEXT
-> ReadPrec DebugReportObjectTypeEXT
-> ReadPrec DebugReportObjectTypeEXT
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int
-> ReadPrec DebugReportObjectTypeEXT
-> ReadPrec DebugReportObjectTypeEXT
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "DebugReportObjectTypeEXT")
                       "messageCode" ::: Int32
v <- ReadPrec ("messageCode" ::: Int32)
-> ReadPrec ("messageCode" ::: Int32)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec ("messageCode" ::: Int32)
forall a. Read a => ReadPrec a
readPrec
                       DebugReportObjectTypeEXT -> ReadPrec DebugReportObjectTypeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("messageCode" ::: Int32) -> DebugReportObjectTypeEXT
DebugReportObjectTypeEXT "messageCode" ::: Int32
v)))


type FN_vkDebugReportCallbackEXT = DebugReportFlagsEXT -> DebugReportObjectTypeEXT -> ("object" ::: Word64) -> ("location" ::: CSize) -> ("messageCode" ::: Int32) -> ("pLayerPrefix" ::: Ptr CChar) -> ("pMessage" ::: Ptr CChar) -> ("pUserData" ::: Ptr ()) -> IO Bool32
-- | PFN_vkDebugReportCallbackEXT - Application-defined debug report callback
-- function
--
-- = Description
--
-- The callback /must/ not call 'destroyDebugReportCallbackEXT'.
--
-- The callback returns a 'Vulkan.Core10.FundamentalTypes.Bool32', which is
-- interpreted in a layer-specified manner. The application /should/ always
-- return 'Vulkan.Core10.FundamentalTypes.FALSE'. The
-- 'Vulkan.Core10.FundamentalTypes.TRUE' value is reserved for use in layer
-- development.
--
-- @object@ /must/ be a Vulkan object or
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE'. If @objectType@ is not
-- 'DEBUG_REPORT_OBJECT_TYPE_UNKNOWN_EXT' and @object@ is not
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE', @object@ /must/ be a Vulkan
-- object of the corresponding type associated with @objectType@ as defined
-- in
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#debug-report-object-types>.
--
-- = See Also
--
-- 'DebugReportCallbackCreateInfoEXT'
type PFN_vkDebugReportCallbackEXT = FunPtr FN_vkDebugReportCallbackEXT


type EXT_DEBUG_REPORT_SPEC_VERSION = 9

-- No documentation found for TopLevel "VK_EXT_DEBUG_REPORT_SPEC_VERSION"
pattern EXT_DEBUG_REPORT_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_DEBUG_REPORT_SPEC_VERSION :: a
$mEXT_DEBUG_REPORT_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_DEBUG_REPORT_SPEC_VERSION = 9


type EXT_DEBUG_REPORT_EXTENSION_NAME = "VK_EXT_debug_report"

-- No documentation found for TopLevel "VK_EXT_DEBUG_REPORT_EXTENSION_NAME"
pattern EXT_DEBUG_REPORT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_DEBUG_REPORT_EXTENSION_NAME :: a
$mEXT_DEBUG_REPORT_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_DEBUG_REPORT_EXTENSION_NAME = "VK_EXT_debug_report"