{-# language CPP #-}
-- No documentation found for Chapter "Exception"
module Vulkan.Exception  (VulkanException(..)) where

import GHC.Exception.Type (Exception(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
-- | This exception is thrown from calls to marshalled Vulkan commands
-- which return a negative VkResult.
newtype VulkanException = VulkanException { VulkanException -> Result
vulkanExceptionResult :: Result }
  deriving (VulkanException -> VulkanException -> Bool
(VulkanException -> VulkanException -> Bool)
-> (VulkanException -> VulkanException -> Bool)
-> Eq VulkanException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VulkanException -> VulkanException -> Bool
$c/= :: VulkanException -> VulkanException -> Bool
== :: VulkanException -> VulkanException -> Bool
$c== :: VulkanException -> VulkanException -> Bool
Eq, Eq VulkanException
Eq VulkanException
-> (VulkanException -> VulkanException -> Ordering)
-> (VulkanException -> VulkanException -> Bool)
-> (VulkanException -> VulkanException -> Bool)
-> (VulkanException -> VulkanException -> Bool)
-> (VulkanException -> VulkanException -> Bool)
-> (VulkanException -> VulkanException -> VulkanException)
-> (VulkanException -> VulkanException -> VulkanException)
-> Ord VulkanException
VulkanException -> VulkanException -> Bool
VulkanException -> VulkanException -> Ordering
VulkanException -> VulkanException -> VulkanException
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 :: VulkanException -> VulkanException -> VulkanException
$cmin :: VulkanException -> VulkanException -> VulkanException
max :: VulkanException -> VulkanException -> VulkanException
$cmax :: VulkanException -> VulkanException -> VulkanException
>= :: VulkanException -> VulkanException -> Bool
$c>= :: VulkanException -> VulkanException -> Bool
> :: VulkanException -> VulkanException -> Bool
$c> :: VulkanException -> VulkanException -> Bool
<= :: VulkanException -> VulkanException -> Bool
$c<= :: VulkanException -> VulkanException -> Bool
< :: VulkanException -> VulkanException -> Bool
$c< :: VulkanException -> VulkanException -> Bool
compare :: VulkanException -> VulkanException -> Ordering
$ccompare :: VulkanException -> VulkanException -> Ordering
$cp1Ord :: Eq VulkanException
Ord, ReadPrec [VulkanException]
ReadPrec VulkanException
Int -> ReadS VulkanException
ReadS [VulkanException]
(Int -> ReadS VulkanException)
-> ReadS [VulkanException]
-> ReadPrec VulkanException
-> ReadPrec [VulkanException]
-> Read VulkanException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VulkanException]
$creadListPrec :: ReadPrec [VulkanException]
readPrec :: ReadPrec VulkanException
$creadPrec :: ReadPrec VulkanException
readList :: ReadS [VulkanException]
$creadList :: ReadS [VulkanException]
readsPrec :: Int -> ReadS VulkanException
$creadsPrec :: Int -> ReadS VulkanException
Read, Int -> VulkanException -> ShowS
[VulkanException] -> ShowS
VulkanException -> String
(Int -> VulkanException -> ShowS)
-> (VulkanException -> String)
-> ([VulkanException] -> ShowS)
-> Show VulkanException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VulkanException] -> ShowS
$cshowList :: [VulkanException] -> ShowS
show :: VulkanException -> String
$cshow :: VulkanException -> String
showsPrec :: Int -> VulkanException -> ShowS
$cshowsPrec :: Int -> VulkanException -> ShowS
Show)

instance Exception VulkanException where
  displayException :: VulkanException -> String
displayException (VulkanException Result
r) = Result -> String
forall a. Show a => a -> String
show Result
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Result -> String
resultString Result
r

-- | A human understandable message for each VkResult
resultString :: Result -> String
resultString :: Result -> String
resultString = \case
  Result
SUCCESS -> String
"Command successfully completed"
  Result
NOT_READY -> String
"A fence or query has not yet completed"
  Result
TIMEOUT -> String
"A wait operation has not completed in the specified time"
  Result
EVENT_SET -> String
"An event is signaled"
  Result
EVENT_RESET -> String
"An event is unsignaled"
  Result
INCOMPLETE -> String
"A return array was too small for the result"
  Result
ERROR_OUT_OF_HOST_MEMORY -> String
"A host memory allocation has failed"
  Result
ERROR_OUT_OF_DEVICE_MEMORY -> String
"A device memory allocation has failed"
  Result
ERROR_INITIALIZATION_FAILED -> String
"Initialization of an object could not be completed for implementation-specific reasons"
  Result
ERROR_DEVICE_LOST -> String
"The logical or physical device has been lost"
  Result
ERROR_MEMORY_MAP_FAILED -> String
"Mapping of a memory object has failed"
  Result
ERROR_LAYER_NOT_PRESENT -> String
"A requested layer is not present or could not be loaded"
  Result
ERROR_EXTENSION_NOT_PRESENT -> String
"A requested extension is not supported"
  Result
ERROR_FEATURE_NOT_PRESENT -> String
"A requested feature is not supported"
  Result
ERROR_INCOMPATIBLE_DRIVER -> String
"The requested version of Vulkan is not supported by the driver or is otherwise incompatible for implementation-specific reasons"
  Result
ERROR_TOO_MANY_OBJECTS -> String
"Too many objects of the type have already been created"
  Result
ERROR_FORMAT_NOT_SUPPORTED -> String
"A requested format is not supported on this device"
  Result
ERROR_FRAGMENTED_POOL -> String
"A pool allocation has failed due to fragmentation of the pool's memory"
  Result
ERROR_UNKNOWN -> String
"An unknown error has occurred; either the application has provided invalid input, or an implementation failure has occurred"
  Result
PIPELINE_COMPILE_REQUIRED_EXT -> String
"A requested pipeline creation would have required compilation, but the application requested compilation to not be performed"
  Result
OPERATION_NOT_DEFERRED_KHR -> String
"A deferred operation was requested and no operations were deferred"
  Result
OPERATION_DEFERRED_KHR -> String
"A deferred operation was requested and at least some of the work was deferred"
  Result
THREAD_DONE_KHR -> String
"A deferred operation is not complete but there is no work remaining to assign to additional threads"
  Result
THREAD_IDLE_KHR -> String
"A deferred operation is not complete but there is currently no work for this thread to do at the time of this call"
  Result
ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT -> String
"An operation on a swapchain created with VK_FULL_SCREEN_EXCLUSIVE_APPLICATION_CONTROLLED_EXT failed as it did not have exlusive full-screen access"
  Result
ERROR_INVALID_SHADER_NV -> String
"One or more shaders failed to compile or link"
  Result
ERROR_INCOMPATIBLE_DISPLAY_KHR -> String
"The display used by a swapchain does not use the same presentable image layout, or is incompatible in a way that prevents sharing an image"
  Result
ERROR_OUT_OF_DATE_KHR -> String
"A surface has changed in such a way that it is no longer compatible with the swapchain, and further presentation requests using the swapchain will fail"
  Result
SUBOPTIMAL_KHR -> String
"A swapchain no longer matches the surface properties exactly, but can still be used to present to the surface successfully"
  Result
ERROR_NATIVE_WINDOW_IN_USE_KHR -> String
"The requested window is already in use by Vulkan or another API in a manner which prevents it from being used again"
  Result
ERROR_SURFACE_LOST_KHR -> String
"A surface is no longer available"
  Result
ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS -> String
"A buffer creation or memory allocation failed because the requested address is not available"
  Result
ERROR_FRAGMENTATION -> String
"A descriptor pool creation has failed due to fragmentation"
  Result
ERROR_INVALID_EXTERNAL_HANDLE -> String
"An external handle is not a valid handle of the specified type"
  Result
ERROR_OUT_OF_POOL_MEMORY -> String
"A pool memory allocation has failed"
  Result
r -> Result -> String
forall a. Show a => a -> String
show Result
r