{-# language CPP #-}
-- No documentation found for Chapter "Result"
module Vulkan.Core10.Enums.Result  (Result( SUCCESS
                                          , NOT_READY
                                          , TIMEOUT
                                          , EVENT_SET
                                          , EVENT_RESET
                                          , INCOMPLETE
                                          , ERROR_OUT_OF_HOST_MEMORY
                                          , ERROR_OUT_OF_DEVICE_MEMORY
                                          , ERROR_INITIALIZATION_FAILED
                                          , ERROR_DEVICE_LOST
                                          , ERROR_MEMORY_MAP_FAILED
                                          , ERROR_LAYER_NOT_PRESENT
                                          , ERROR_EXTENSION_NOT_PRESENT
                                          , ERROR_FEATURE_NOT_PRESENT
                                          , ERROR_INCOMPATIBLE_DRIVER
                                          , ERROR_TOO_MANY_OBJECTS
                                          , ERROR_FORMAT_NOT_SUPPORTED
                                          , ERROR_FRAGMENTED_POOL
                                          , ERROR_UNKNOWN
                                          , ERROR_COMPRESSION_EXHAUSTED_EXT
                                          , OPERATION_NOT_DEFERRED_KHR
                                          , OPERATION_DEFERRED_KHR
                                          , THREAD_DONE_KHR
                                          , THREAD_IDLE_KHR
                                          , ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT
                                          , ERROR_NOT_PERMITTED_KHR
                                          , ERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT
                                          , ERROR_INVALID_SHADER_NV
                                          , ERROR_VALIDATION_FAILED_EXT
                                          , ERROR_INCOMPATIBLE_DISPLAY_KHR
                                          , ERROR_OUT_OF_DATE_KHR
                                          , SUBOPTIMAL_KHR
                                          , ERROR_NATIVE_WINDOW_IN_USE_KHR
                                          , ERROR_SURFACE_LOST_KHR
                                          , PIPELINE_COMPILE_REQUIRED
                                          , ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS
                                          , ERROR_FRAGMENTATION
                                          , ERROR_INVALID_EXTERNAL_HANDLE
                                          , ERROR_OUT_OF_POOL_MEMORY
                                          , ..
                                          )) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import GHC.Show (showsPrec)
import Vulkan.Zero (Zero)
import Foreign.Storable (Storable)
import Data.Int (Int32)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))

-- | VkResult - Vulkan command return codes
--
-- = Description
--
-- If a command returns a runtime error, unless otherwise specified any
-- output parameters will have undefined contents, except that if the
-- output parameter is a structure with @sType@ and @pNext@ fields, those
-- fields will be unmodified. Any structures chained from @pNext@ will also
-- have undefined contents, except that @sType@ and @pNext@ will be
-- unmodified.
--
-- @VK_ERROR_OUT_OF_*_MEMORY@ errors do not modify any currently existing
-- Vulkan objects. Objects that have already been successfully created
-- /can/ still be used by the application.
--
-- Note
--
-- As a general rule, @Free@, @Release@, and @Reset@ commands do not return
-- 'ERROR_OUT_OF_HOST_MEMORY', while any other command with a return code
-- /may/ return it. Any exceptions from this rule are described for those
-- commands.
--
-- 'ERROR_UNKNOWN' will be returned by an implementation when an unexpected
-- error occurs that cannot be attributed to valid behavior of the
-- application and implementation. Under these conditions, it /may/ be
-- returned from any command returning a 'Result'.
--
-- Note
--
-- 'ERROR_UNKNOWN' is not expected to ever be returned if the application
-- behavior is valid, and if the implementation is bug-free. If
-- 'ERROR_UNKNOWN' is received, the application should be checked against
-- the latest validation layers to verify correct behavior as much as
-- possible. If no issues are identified it could be an implementation
-- issue, and the implementor should be contacted for support.
--
-- Performance-critical commands generally do not have return codes. If a
-- runtime error occurs in such commands, the implementation will defer
-- reporting the error until a specified point. For commands that record
-- into command buffers (@vkCmd*@) runtime errors are reported by
-- 'Vulkan.Core10.CommandBuffer.endCommandBuffer'.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'
newtype Result = Result Int32
  deriving newtype (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Eq Result
Eq Result
-> (Result -> Result -> Ordering)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Result)
-> (Result -> Result -> Result)
-> Ord Result
Result -> Result -> Bool
Result -> Result -> Ordering
Result -> Result -> Result
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 :: Result -> Result -> Result
$cmin :: Result -> Result -> Result
max :: Result -> Result -> Result
$cmax :: Result -> Result -> Result
>= :: Result -> Result -> Bool
$c>= :: Result -> Result -> Bool
> :: Result -> Result -> Bool
$c> :: Result -> Result -> Bool
<= :: Result -> Result -> Bool
$c<= :: Result -> Result -> Bool
< :: Result -> Result -> Bool
$c< :: Result -> Result -> Bool
compare :: Result -> Result -> Ordering
$ccompare :: Result -> Result -> Ordering
Ord, Ptr Result -> IO Result
Ptr Result -> Int -> IO Result
Ptr Result -> Int -> Result -> IO ()
Ptr Result -> Result -> IO ()
Result -> Int
(Result -> Int)
-> (Result -> Int)
-> (Ptr Result -> Int -> IO Result)
-> (Ptr Result -> Int -> Result -> IO ())
-> (forall b. Ptr b -> Int -> IO Result)
-> (forall b. Ptr b -> Int -> Result -> IO ())
-> (Ptr Result -> IO Result)
-> (Ptr Result -> Result -> IO ())
-> Storable Result
forall b. Ptr b -> Int -> IO Result
forall b. Ptr b -> Int -> Result -> 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 Result -> Result -> IO ()
$cpoke :: Ptr Result -> Result -> IO ()
peek :: Ptr Result -> IO Result
$cpeek :: Ptr Result -> IO Result
pokeByteOff :: forall b. Ptr b -> Int -> Result -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Result -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Result
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Result
pokeElemOff :: Ptr Result -> Int -> Result -> IO ()
$cpokeElemOff :: Ptr Result -> Int -> Result -> IO ()
peekElemOff :: Ptr Result -> Int -> IO Result
$cpeekElemOff :: Ptr Result -> Int -> IO Result
alignment :: Result -> Int
$calignment :: Result -> Int
sizeOf :: Result -> Int
$csizeOf :: Result -> Int
Storable, Result
Result -> Zero Result
forall a. a -> Zero a
zero :: Result
$czero :: Result
Zero)

-- | 'SUCCESS' Command successfully completed
pattern $bSUCCESS :: Result
$mSUCCESS :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
SUCCESS = Result 0

-- | 'NOT_READY' A fence or query has not yet completed
pattern $bNOT_READY :: Result
$mNOT_READY :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
NOT_READY = Result 1

-- | 'TIMEOUT' A wait operation has not completed in the specified time
pattern $bTIMEOUT :: Result
$mTIMEOUT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
TIMEOUT = Result 2

-- | 'EVENT_SET' An event is signaled
pattern $bEVENT_SET :: Result
$mEVENT_SET :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
EVENT_SET = Result 3

-- | 'EVENT_RESET' An event is unsignaled
pattern $bEVENT_RESET :: Result
$mEVENT_RESET :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
EVENT_RESET = Result 4

-- | 'INCOMPLETE' A return array was too small for the result
pattern $bINCOMPLETE :: Result
$mINCOMPLETE :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
INCOMPLETE = Result 5

-- | 'ERROR_OUT_OF_HOST_MEMORY' A host memory allocation has failed.
pattern $bERROR_OUT_OF_HOST_MEMORY :: Result
$mERROR_OUT_OF_HOST_MEMORY :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_OUT_OF_HOST_MEMORY = Result (-1)

-- | 'ERROR_OUT_OF_DEVICE_MEMORY' A device memory allocation has failed.
pattern $bERROR_OUT_OF_DEVICE_MEMORY :: Result
$mERROR_OUT_OF_DEVICE_MEMORY :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_OUT_OF_DEVICE_MEMORY = Result (-2)

-- | 'ERROR_INITIALIZATION_FAILED' Initialization of an object could not be
-- completed for implementation-specific reasons.
pattern $bERROR_INITIALIZATION_FAILED :: Result
$mERROR_INITIALIZATION_FAILED :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INITIALIZATION_FAILED = Result (-3)

-- | 'ERROR_DEVICE_LOST' The logical or physical device has been lost. See
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#devsandqueues-lost-device Lost Device>
pattern $bERROR_DEVICE_LOST :: Result
$mERROR_DEVICE_LOST :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_DEVICE_LOST = Result (-4)

-- | 'ERROR_MEMORY_MAP_FAILED' Mapping of a memory object has failed.
pattern $bERROR_MEMORY_MAP_FAILED :: Result
$mERROR_MEMORY_MAP_FAILED :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_MEMORY_MAP_FAILED = Result (-5)

-- | 'ERROR_LAYER_NOT_PRESENT' A requested layer is not present or could not
-- be loaded.
pattern $bERROR_LAYER_NOT_PRESENT :: Result
$mERROR_LAYER_NOT_PRESENT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_LAYER_NOT_PRESENT = Result (-6)

-- | 'ERROR_EXTENSION_NOT_PRESENT' A requested extension is not supported.
pattern $bERROR_EXTENSION_NOT_PRESENT :: Result
$mERROR_EXTENSION_NOT_PRESENT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_EXTENSION_NOT_PRESENT = Result (-7)

-- | 'ERROR_FEATURE_NOT_PRESENT' A requested feature is not supported.
pattern $bERROR_FEATURE_NOT_PRESENT :: Result
$mERROR_FEATURE_NOT_PRESENT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_FEATURE_NOT_PRESENT = Result (-8)

-- | 'ERROR_INCOMPATIBLE_DRIVER' The requested version of Vulkan is not
-- supported by the driver or is otherwise incompatible for
-- implementation-specific reasons.
pattern $bERROR_INCOMPATIBLE_DRIVER :: Result
$mERROR_INCOMPATIBLE_DRIVER :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INCOMPATIBLE_DRIVER = Result (-9)

-- | 'ERROR_TOO_MANY_OBJECTS' Too many objects of the type have already been
-- created.
pattern $bERROR_TOO_MANY_OBJECTS :: Result
$mERROR_TOO_MANY_OBJECTS :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_TOO_MANY_OBJECTS = Result (-10)

-- | 'ERROR_FORMAT_NOT_SUPPORTED' A requested format is not supported on this
-- device.
pattern $bERROR_FORMAT_NOT_SUPPORTED :: Result
$mERROR_FORMAT_NOT_SUPPORTED :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_FORMAT_NOT_SUPPORTED = Result (-11)

-- | 'ERROR_FRAGMENTED_POOL' A pool allocation has failed due to
-- fragmentation of the pool’s memory. This /must/ only be returned if no
-- attempt to allocate host or device memory was made to accommodate the
-- new allocation. This /should/ be returned in preference to
-- 'ERROR_OUT_OF_POOL_MEMORY', but only if the implementation is certain
-- that the pool allocation failure was due to fragmentation.
pattern $bERROR_FRAGMENTED_POOL :: Result
$mERROR_FRAGMENTED_POOL :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_FRAGMENTED_POOL = Result (-12)

-- | 'ERROR_UNKNOWN' An unknown error has occurred; either the application
-- has provided invalid input, or an implementation failure has occurred.
pattern $bERROR_UNKNOWN :: Result
$mERROR_UNKNOWN :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_UNKNOWN = Result (-13)

-- | 'ERROR_COMPRESSION_EXHAUSTED_EXT' An image creation failed because
-- internal resources required for compression are exhausted. This /must/
-- only be returned when fixed-rate compression is requested.
pattern $bERROR_COMPRESSION_EXHAUSTED_EXT :: Result
$mERROR_COMPRESSION_EXHAUSTED_EXT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_COMPRESSION_EXHAUSTED_EXT = Result (-1000338000)

-- | 'OPERATION_NOT_DEFERRED_KHR' A deferred operation was requested and no
-- operations were deferred.
pattern $bOPERATION_NOT_DEFERRED_KHR :: Result
$mOPERATION_NOT_DEFERRED_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
OPERATION_NOT_DEFERRED_KHR = Result 1000268003

-- | 'OPERATION_DEFERRED_KHR' A deferred operation was requested and at least
-- some of the work was deferred.
pattern $bOPERATION_DEFERRED_KHR :: Result
$mOPERATION_DEFERRED_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
OPERATION_DEFERRED_KHR = Result 1000268002

-- | 'THREAD_DONE_KHR' A deferred operation is not complete but there is no
-- work remaining to assign to additional threads.
pattern $bTHREAD_DONE_KHR :: Result
$mTHREAD_DONE_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
THREAD_DONE_KHR = Result 1000268001

-- | 'THREAD_IDLE_KHR' A deferred operation is not complete but there is
-- currently no work for this thread to do at the time of this call.
pattern $bTHREAD_IDLE_KHR :: Result
$mTHREAD_IDLE_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
THREAD_IDLE_KHR = Result 1000268000

-- | 'ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT' An operation on a swapchain
-- created with
-- 'Vulkan.Extensions.VK_EXT_full_screen_exclusive.FULL_SCREEN_EXCLUSIVE_APPLICATION_CONTROLLED_EXT'
-- failed as it did not have exclusive full-screen access. This /may/ occur
-- due to implementation-dependent reasons, outside of the application’s
-- control.
pattern $bERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT :: Result
$mERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT = Result (-1000255000)

-- No documentation found for Nested "VkResult" "VK_ERROR_NOT_PERMITTED_KHR"
pattern $bERROR_NOT_PERMITTED_KHR :: Result
$mERROR_NOT_PERMITTED_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_NOT_PERMITTED_KHR = Result (-1000174001)

-- No documentation found for Nested "VkResult" "VK_ERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT"
pattern $bERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT :: Result
$mERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT = Result (-1000158000)

-- | 'ERROR_INVALID_SHADER_NV' One or more shaders failed to compile or link.
-- More details are reported back to the application via
-- @VK_EXT_debug_report@ if enabled.
pattern $bERROR_INVALID_SHADER_NV :: Result
$mERROR_INVALID_SHADER_NV :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INVALID_SHADER_NV = Result (-1000012000)

-- No documentation found for Nested "VkResult" "VK_ERROR_VALIDATION_FAILED_EXT"
pattern $bERROR_VALIDATION_FAILED_EXT :: Result
$mERROR_VALIDATION_FAILED_EXT :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_VALIDATION_FAILED_EXT = Result (-1000011001)

-- | 'ERROR_INCOMPATIBLE_DISPLAY_KHR' 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.
pattern $bERROR_INCOMPATIBLE_DISPLAY_KHR :: Result
$mERROR_INCOMPATIBLE_DISPLAY_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INCOMPATIBLE_DISPLAY_KHR = Result (-1000003001)

-- | 'ERROR_OUT_OF_DATE_KHR' 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. Applications /must/ query the
-- new surface properties and recreate their swapchain if they wish to
-- continue presenting to the surface.
pattern $bERROR_OUT_OF_DATE_KHR :: Result
$mERROR_OUT_OF_DATE_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_OUT_OF_DATE_KHR = Result (-1000001004)

-- | 'SUBOPTIMAL_KHR' A swapchain no longer matches the surface properties
-- exactly, but /can/ still be used to present to the surface successfully.
pattern $bSUBOPTIMAL_KHR :: Result
$mSUBOPTIMAL_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
SUBOPTIMAL_KHR = Result 1000001003

-- | 'ERROR_NATIVE_WINDOW_IN_USE_KHR' The requested window is already in use
-- by Vulkan or another API in a manner which prevents it from being used
-- again.
pattern $bERROR_NATIVE_WINDOW_IN_USE_KHR :: Result
$mERROR_NATIVE_WINDOW_IN_USE_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_NATIVE_WINDOW_IN_USE_KHR = Result (-1000000001)

-- | 'ERROR_SURFACE_LOST_KHR' A surface is no longer available.
pattern $bERROR_SURFACE_LOST_KHR :: Result
$mERROR_SURFACE_LOST_KHR :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_SURFACE_LOST_KHR = Result (-1000000000)

-- | 'PIPELINE_COMPILE_REQUIRED' A requested pipeline creation would have
-- required compilation, but the application requested compilation to not
-- be performed.
pattern $bPIPELINE_COMPILE_REQUIRED :: Result
$mPIPELINE_COMPILE_REQUIRED :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
PIPELINE_COMPILE_REQUIRED = Result 1000297000

-- | 'ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS' A buffer creation or memory
-- allocation failed because the requested address is not available. A
-- shader group handle assignment failed because the requested shader group
-- handle information is no longer valid.
pattern $bERROR_INVALID_OPAQUE_CAPTURE_ADDRESS :: Result
$mERROR_INVALID_OPAQUE_CAPTURE_ADDRESS :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS = Result (-1000257000)

-- | 'ERROR_FRAGMENTATION' A descriptor pool creation has failed due to
-- fragmentation.
pattern $bERROR_FRAGMENTATION :: Result
$mERROR_FRAGMENTATION :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_FRAGMENTATION = Result (-1000161000)

-- | 'ERROR_INVALID_EXTERNAL_HANDLE' An external handle is not a valid handle
-- of the specified type.
pattern $bERROR_INVALID_EXTERNAL_HANDLE :: Result
$mERROR_INVALID_EXTERNAL_HANDLE :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_INVALID_EXTERNAL_HANDLE = Result (-1000072003)

-- | 'ERROR_OUT_OF_POOL_MEMORY' A pool memory allocation has failed. This
-- /must/ only be returned if no attempt to allocate host or device memory
-- was made to accommodate the new allocation. If the failure was
-- definitely due to fragmentation of the pool, 'ERROR_FRAGMENTED_POOL'
-- /should/ be returned instead.
pattern $bERROR_OUT_OF_POOL_MEMORY :: Result
$mERROR_OUT_OF_POOL_MEMORY :: forall {r}. Result -> (Void# -> r) -> (Void# -> r) -> r
ERROR_OUT_OF_POOL_MEMORY = Result (-1000069000)

{-# COMPLETE
  SUCCESS
  , NOT_READY
  , TIMEOUT
  , EVENT_SET
  , EVENT_RESET
  , INCOMPLETE
  , ERROR_OUT_OF_HOST_MEMORY
  , ERROR_OUT_OF_DEVICE_MEMORY
  , ERROR_INITIALIZATION_FAILED
  , ERROR_DEVICE_LOST
  , ERROR_MEMORY_MAP_FAILED
  , ERROR_LAYER_NOT_PRESENT
  , ERROR_EXTENSION_NOT_PRESENT
  , ERROR_FEATURE_NOT_PRESENT
  , ERROR_INCOMPATIBLE_DRIVER
  , ERROR_TOO_MANY_OBJECTS
  , ERROR_FORMAT_NOT_SUPPORTED
  , ERROR_FRAGMENTED_POOL
  , ERROR_UNKNOWN
  , ERROR_COMPRESSION_EXHAUSTED_EXT
  , OPERATION_NOT_DEFERRED_KHR
  , OPERATION_DEFERRED_KHR
  , THREAD_DONE_KHR
  , THREAD_IDLE_KHR
  , ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT
  , ERROR_NOT_PERMITTED_KHR
  , ERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT
  , ERROR_INVALID_SHADER_NV
  , ERROR_VALIDATION_FAILED_EXT
  , ERROR_INCOMPATIBLE_DISPLAY_KHR
  , ERROR_OUT_OF_DATE_KHR
  , SUBOPTIMAL_KHR
  , ERROR_NATIVE_WINDOW_IN_USE_KHR
  , ERROR_SURFACE_LOST_KHR
  , PIPELINE_COMPILE_REQUIRED
  , ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS
  , ERROR_FRAGMENTATION
  , ERROR_INVALID_EXTERNAL_HANDLE
  , ERROR_OUT_OF_POOL_MEMORY ::
    Result
  #-}

conNameResult :: String
conNameResult :: String
conNameResult = String
"Result"

enumPrefixResult :: String
enumPrefixResult :: String
enumPrefixResult = String
""

showTableResult :: [(Result, String)]
showTableResult :: [(Result, String)]
showTableResult =
  [ (Result
SUCCESS, String
"SUCCESS")
  , (Result
NOT_READY, String
"NOT_READY")
  , (Result
TIMEOUT, String
"TIMEOUT")
  , (Result
EVENT_SET, String
"EVENT_SET")
  , (Result
EVENT_RESET, String
"EVENT_RESET")
  , (Result
INCOMPLETE, String
"INCOMPLETE")
  , (Result
ERROR_OUT_OF_HOST_MEMORY, String
"ERROR_OUT_OF_HOST_MEMORY")
  , (Result
ERROR_OUT_OF_DEVICE_MEMORY, String
"ERROR_OUT_OF_DEVICE_MEMORY")
  , (Result
ERROR_INITIALIZATION_FAILED, String
"ERROR_INITIALIZATION_FAILED")
  , (Result
ERROR_DEVICE_LOST, String
"ERROR_DEVICE_LOST")
  , (Result
ERROR_MEMORY_MAP_FAILED, String
"ERROR_MEMORY_MAP_FAILED")
  , (Result
ERROR_LAYER_NOT_PRESENT, String
"ERROR_LAYER_NOT_PRESENT")
  , (Result
ERROR_EXTENSION_NOT_PRESENT, String
"ERROR_EXTENSION_NOT_PRESENT")
  , (Result
ERROR_FEATURE_NOT_PRESENT, String
"ERROR_FEATURE_NOT_PRESENT")
  , (Result
ERROR_INCOMPATIBLE_DRIVER, String
"ERROR_INCOMPATIBLE_DRIVER")
  , (Result
ERROR_TOO_MANY_OBJECTS, String
"ERROR_TOO_MANY_OBJECTS")
  , (Result
ERROR_FORMAT_NOT_SUPPORTED, String
"ERROR_FORMAT_NOT_SUPPORTED")
  , (Result
ERROR_FRAGMENTED_POOL, String
"ERROR_FRAGMENTED_POOL")
  , (Result
ERROR_UNKNOWN, String
"ERROR_UNKNOWN")
  ,
    ( Result
ERROR_COMPRESSION_EXHAUSTED_EXT
    , String
"ERROR_COMPRESSION_EXHAUSTED_EXT"
    )
  , (Result
OPERATION_NOT_DEFERRED_KHR, String
"OPERATION_NOT_DEFERRED_KHR")
  , (Result
OPERATION_DEFERRED_KHR, String
"OPERATION_DEFERRED_KHR")
  , (Result
THREAD_DONE_KHR, String
"THREAD_DONE_KHR")
  , (Result
THREAD_IDLE_KHR, String
"THREAD_IDLE_KHR")
  ,
    ( Result
ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT
    , String
"ERROR_FULL_SCREEN_EXCLUSIVE_MODE_LOST_EXT"
    )
  , (Result
ERROR_NOT_PERMITTED_KHR, String
"ERROR_NOT_PERMITTED_KHR")
  ,
    ( Result
ERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT
    , String
"ERROR_INVALID_DRM_FORMAT_MODIFIER_PLANE_LAYOUT_EXT"
    )
  , (Result
ERROR_INVALID_SHADER_NV, String
"ERROR_INVALID_SHADER_NV")
  , (Result
ERROR_VALIDATION_FAILED_EXT, String
"ERROR_VALIDATION_FAILED_EXT")
  ,
    ( Result
ERROR_INCOMPATIBLE_DISPLAY_KHR
    , String
"ERROR_INCOMPATIBLE_DISPLAY_KHR"
    )
  , (Result
ERROR_OUT_OF_DATE_KHR, String
"ERROR_OUT_OF_DATE_KHR")
  , (Result
SUBOPTIMAL_KHR, String
"SUBOPTIMAL_KHR")
  ,
    ( Result
ERROR_NATIVE_WINDOW_IN_USE_KHR
    , String
"ERROR_NATIVE_WINDOW_IN_USE_KHR"
    )
  , (Result
ERROR_SURFACE_LOST_KHR, String
"ERROR_SURFACE_LOST_KHR")
  , (Result
PIPELINE_COMPILE_REQUIRED, String
"PIPELINE_COMPILE_REQUIRED")
  ,
    ( Result
ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS
    , String
"ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS"
    )
  , (Result
ERROR_FRAGMENTATION, String
"ERROR_FRAGMENTATION")
  ,
    ( Result
ERROR_INVALID_EXTERNAL_HANDLE
    , String
"ERROR_INVALID_EXTERNAL_HANDLE"
    )
  , (Result
ERROR_OUT_OF_POOL_MEMORY, String
"ERROR_OUT_OF_POOL_MEMORY")
  ]

instance Show Result where
  showsPrec :: Int -> Result -> ShowS
showsPrec =
    String
-> [(Result, String)]
-> String
-> (Result -> Int32)
-> (Int32 -> ShowS)
-> Int
-> Result
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixResult
      [(Result, String)]
showTableResult
      String
conNameResult
      (\(Result Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read Result where
  readPrec :: ReadPrec Result
readPrec =
    String
-> [(Result, String)]
-> String
-> (Int32 -> Result)
-> ReadPrec Result
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixResult
      [(Result, String)]
showTableResult
      String
conNameResult
      Int32 -> Result
Result