{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE Strict                     #-}
module Graphics.Vulkan.Types.Enum.Result
       (VkResult(VkResult, VK_SUCCESS, VK_NOT_READY, VK_TIMEOUT,
                 VK_EVENT_SET, VK_EVENT_RESET, VK_INCOMPLETE,
                 VK_ERROR_OUT_OF_HOST_MEMORY, VK_ERROR_OUT_OF_DEVICE_MEMORY,
                 VK_ERROR_INITIALIZATION_FAILED, VK_ERROR_DEVICE_LOST,
                 VK_ERROR_MEMORY_MAP_FAILED, VK_ERROR_LAYER_NOT_PRESENT,
                 VK_ERROR_EXTENSION_NOT_PRESENT, VK_ERROR_FEATURE_NOT_PRESENT,
                 VK_ERROR_INCOMPATIBLE_DRIVER, VK_ERROR_TOO_MANY_OBJECTS,
                 VK_ERROR_FORMAT_NOT_SUPPORTED, VK_ERROR_FRAGMENTED_POOL,
                 VK_ERROR_UNKNOWN))
       where
import Foreign.Storable                (Storable)
import GHC.Read                        (choose, expectP)
import Graphics.Vulkan.Marshal         (Int32)
import Text.ParserCombinators.ReadPrec (prec, step, (+++))
import Text.Read                       (Read (..), parens)
import Text.Read.Lex                   (Lexeme (..))

-- | API result codes
--
--   type = @enum@
--
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkResult VkResult registry at www.khronos.org>
newtype VkResult = VkResult Int32
                   deriving (VkResult -> VkResult -> Bool
(VkResult -> VkResult -> Bool)
-> (VkResult -> VkResult -> Bool) -> Eq VkResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkResult -> VkResult -> Bool
$c/= :: VkResult -> VkResult -> Bool
== :: VkResult -> VkResult -> Bool
$c== :: VkResult -> VkResult -> Bool
Eq, Eq VkResult
Eq VkResult
-> (VkResult -> VkResult -> Ordering)
-> (VkResult -> VkResult -> Bool)
-> (VkResult -> VkResult -> Bool)
-> (VkResult -> VkResult -> Bool)
-> (VkResult -> VkResult -> Bool)
-> (VkResult -> VkResult -> VkResult)
-> (VkResult -> VkResult -> VkResult)
-> Ord VkResult
VkResult -> VkResult -> Bool
VkResult -> VkResult -> Ordering
VkResult -> VkResult -> VkResult
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 :: VkResult -> VkResult -> VkResult
$cmin :: VkResult -> VkResult -> VkResult
max :: VkResult -> VkResult -> VkResult
$cmax :: VkResult -> VkResult -> VkResult
>= :: VkResult -> VkResult -> Bool
$c>= :: VkResult -> VkResult -> Bool
> :: VkResult -> VkResult -> Bool
$c> :: VkResult -> VkResult -> Bool
<= :: VkResult -> VkResult -> Bool
$c<= :: VkResult -> VkResult -> Bool
< :: VkResult -> VkResult -> Bool
$c< :: VkResult -> VkResult -> Bool
compare :: VkResult -> VkResult -> Ordering
$ccompare :: VkResult -> VkResult -> Ordering
Ord, Int -> VkResult
VkResult -> Int
VkResult -> [VkResult]
VkResult -> VkResult
VkResult -> VkResult -> [VkResult]
VkResult -> VkResult -> VkResult -> [VkResult]
(VkResult -> VkResult)
-> (VkResult -> VkResult)
-> (Int -> VkResult)
-> (VkResult -> Int)
-> (VkResult -> [VkResult])
-> (VkResult -> VkResult -> [VkResult])
-> (VkResult -> VkResult -> [VkResult])
-> (VkResult -> VkResult -> VkResult -> [VkResult])
-> Enum VkResult
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkResult -> VkResult -> VkResult -> [VkResult]
$cenumFromThenTo :: VkResult -> VkResult -> VkResult -> [VkResult]
enumFromTo :: VkResult -> VkResult -> [VkResult]
$cenumFromTo :: VkResult -> VkResult -> [VkResult]
enumFromThen :: VkResult -> VkResult -> [VkResult]
$cenumFromThen :: VkResult -> VkResult -> [VkResult]
enumFrom :: VkResult -> [VkResult]
$cenumFrom :: VkResult -> [VkResult]
fromEnum :: VkResult -> Int
$cfromEnum :: VkResult -> Int
toEnum :: Int -> VkResult
$ctoEnum :: Int -> VkResult
pred :: VkResult -> VkResult
$cpred :: VkResult -> VkResult
succ :: VkResult -> VkResult
$csucc :: VkResult -> VkResult
Enum, Ptr VkResult -> IO VkResult
Ptr VkResult -> Int -> IO VkResult
Ptr VkResult -> Int -> VkResult -> IO ()
Ptr VkResult -> VkResult -> IO ()
VkResult -> Int
(VkResult -> Int)
-> (VkResult -> Int)
-> (Ptr VkResult -> Int -> IO VkResult)
-> (Ptr VkResult -> Int -> VkResult -> IO ())
-> (forall b. Ptr b -> Int -> IO VkResult)
-> (forall b. Ptr b -> Int -> VkResult -> IO ())
-> (Ptr VkResult -> IO VkResult)
-> (Ptr VkResult -> VkResult -> IO ())
-> Storable VkResult
forall b. Ptr b -> Int -> IO VkResult
forall b. Ptr b -> Int -> VkResult -> 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 VkResult -> VkResult -> IO ()
$cpoke :: Ptr VkResult -> VkResult -> IO ()
peek :: Ptr VkResult -> IO VkResult
$cpeek :: Ptr VkResult -> IO VkResult
pokeByteOff :: forall b. Ptr b -> Int -> VkResult -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkResult -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkResult
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkResult
pokeElemOff :: Ptr VkResult -> Int -> VkResult -> IO ()
$cpokeElemOff :: Ptr VkResult -> Int -> VkResult -> IO ()
peekElemOff :: Ptr VkResult -> Int -> IO VkResult
$cpeekElemOff :: Ptr VkResult -> Int -> IO VkResult
alignment :: VkResult -> Int
$calignment :: VkResult -> Int
sizeOf :: VkResult -> Int
$csizeOf :: VkResult -> Int
Storable)

instance Show VkResult where
    showsPrec :: Int -> VkResult -> ShowS
showsPrec Int
_ VkResult
VK_SUCCESS = String -> ShowS
showString String
"VK_SUCCESS"
    showsPrec Int
_ VkResult
VK_NOT_READY = String -> ShowS
showString String
"VK_NOT_READY"
    showsPrec Int
_ VkResult
VK_TIMEOUT = String -> ShowS
showString String
"VK_TIMEOUT"
    showsPrec Int
_ VkResult
VK_EVENT_SET = String -> ShowS
showString String
"VK_EVENT_SET"
    showsPrec Int
_ VkResult
VK_EVENT_RESET = String -> ShowS
showString String
"VK_EVENT_RESET"
    showsPrec Int
_ VkResult
VK_INCOMPLETE = String -> ShowS
showString String
"VK_INCOMPLETE"
    showsPrec Int
_ VkResult
VK_ERROR_OUT_OF_HOST_MEMORY
      = String -> ShowS
showString String
"VK_ERROR_OUT_OF_HOST_MEMORY"
    showsPrec Int
_ VkResult
VK_ERROR_OUT_OF_DEVICE_MEMORY
      = String -> ShowS
showString String
"VK_ERROR_OUT_OF_DEVICE_MEMORY"
    showsPrec Int
_ VkResult
VK_ERROR_INITIALIZATION_FAILED
      = String -> ShowS
showString String
"VK_ERROR_INITIALIZATION_FAILED"
    showsPrec Int
_ VkResult
VK_ERROR_DEVICE_LOST
      = String -> ShowS
showString String
"VK_ERROR_DEVICE_LOST"
    showsPrec Int
_ VkResult
VK_ERROR_MEMORY_MAP_FAILED
      = String -> ShowS
showString String
"VK_ERROR_MEMORY_MAP_FAILED"
    showsPrec Int
_ VkResult
VK_ERROR_LAYER_NOT_PRESENT
      = String -> ShowS
showString String
"VK_ERROR_LAYER_NOT_PRESENT"
    showsPrec Int
_ VkResult
VK_ERROR_EXTENSION_NOT_PRESENT
      = String -> ShowS
showString String
"VK_ERROR_EXTENSION_NOT_PRESENT"
    showsPrec Int
_ VkResult
VK_ERROR_FEATURE_NOT_PRESENT
      = String -> ShowS
showString String
"VK_ERROR_FEATURE_NOT_PRESENT"
    showsPrec Int
_ VkResult
VK_ERROR_INCOMPATIBLE_DRIVER
      = String -> ShowS
showString String
"VK_ERROR_INCOMPATIBLE_DRIVER"
    showsPrec Int
_ VkResult
VK_ERROR_TOO_MANY_OBJECTS
      = String -> ShowS
showString String
"VK_ERROR_TOO_MANY_OBJECTS"
    showsPrec Int
_ VkResult
VK_ERROR_FORMAT_NOT_SUPPORTED
      = String -> ShowS
showString String
"VK_ERROR_FORMAT_NOT_SUPPORTED"
    showsPrec Int
_ VkResult
VK_ERROR_FRAGMENTED_POOL
      = String -> ShowS
showString String
"VK_ERROR_FRAGMENTED_POOL"
    showsPrec Int
_ VkResult
VK_ERROR_UNKNOWN = String -> ShowS
showString String
"VK_ERROR_UNKNOWN"
    showsPrec Int
p (VkResult Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (String -> ShowS
showString String
"VkResult " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int32
x)

instance Read VkResult where
    readPrec :: ReadPrec VkResult
readPrec
      = ReadPrec VkResult -> ReadPrec VkResult
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkResult)] -> ReadPrec VkResult
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_SUCCESS", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_SUCCESS),
              (String
"VK_NOT_READY", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_NOT_READY),
              (String
"VK_TIMEOUT", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_TIMEOUT),
              (String
"VK_EVENT_SET", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_EVENT_SET),
              (String
"VK_EVENT_RESET", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_EVENT_RESET),
              (String
"VK_INCOMPLETE", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_INCOMPLETE),
              (String
"VK_ERROR_OUT_OF_HOST_MEMORY", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_OUT_OF_HOST_MEMORY),
              (String
"VK_ERROR_OUT_OF_DEVICE_MEMORY",
               VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_OUT_OF_DEVICE_MEMORY),
              (String
"VK_ERROR_INITIALIZATION_FAILED",
               VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_INITIALIZATION_FAILED),
              (String
"VK_ERROR_DEVICE_LOST", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_DEVICE_LOST),
              (String
"VK_ERROR_MEMORY_MAP_FAILED", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_MEMORY_MAP_FAILED),
              (String
"VK_ERROR_LAYER_NOT_PRESENT", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_LAYER_NOT_PRESENT),
              (String
"VK_ERROR_EXTENSION_NOT_PRESENT",
               VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_EXTENSION_NOT_PRESENT),
              (String
"VK_ERROR_FEATURE_NOT_PRESENT",
               VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_FEATURE_NOT_PRESENT),
              (String
"VK_ERROR_INCOMPATIBLE_DRIVER",
               VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_INCOMPATIBLE_DRIVER),
              (String
"VK_ERROR_TOO_MANY_OBJECTS", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_TOO_MANY_OBJECTS),
              (String
"VK_ERROR_FORMAT_NOT_SUPPORTED",
               VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_FORMAT_NOT_SUPPORTED),
              (String
"VK_ERROR_FRAGMENTED_POOL", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_FRAGMENTED_POOL),
              (String
"VK_ERROR_UNKNOWN", VkResult -> ReadPrec VkResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkResult
VK_ERROR_UNKNOWN)]
             ReadPrec VkResult -> ReadPrec VkResult -> ReadPrec VkResult
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkResult -> ReadPrec VkResult
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkResult") ReadPrec () -> ReadPrec VkResult -> ReadPrec VkResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int32 -> VkResult
VkResult (Int32 -> VkResult) -> ReadPrec Int32 -> ReadPrec VkResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

-- | Command completed successfully
pattern VK_SUCCESS :: VkResult

pattern $bVK_SUCCESS :: VkResult
$mVK_SUCCESS :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_SUCCESS = VkResult 0

-- | A fence or query has not yet completed
pattern VK_NOT_READY :: VkResult

pattern $bVK_NOT_READY :: VkResult
$mVK_NOT_READY :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_NOT_READY = VkResult 1

-- | A wait operation has not completed in the specified time
pattern VK_TIMEOUT :: VkResult

pattern $bVK_TIMEOUT :: VkResult
$mVK_TIMEOUT :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_TIMEOUT = VkResult 2

-- | An event is signaled
pattern VK_EVENT_SET :: VkResult

pattern $bVK_EVENT_SET :: VkResult
$mVK_EVENT_SET :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_EVENT_SET = VkResult 3

-- | An event is unsignaled
pattern VK_EVENT_RESET :: VkResult

pattern $bVK_EVENT_RESET :: VkResult
$mVK_EVENT_RESET :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_EVENT_RESET = VkResult 4

-- | A return array was too small for the result
pattern VK_INCOMPLETE :: VkResult

pattern $bVK_INCOMPLETE :: VkResult
$mVK_INCOMPLETE :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_INCOMPLETE = VkResult 5

-- | A host memory allocation has failed
pattern VK_ERROR_OUT_OF_HOST_MEMORY :: VkResult

pattern $bVK_ERROR_OUT_OF_HOST_MEMORY :: VkResult
$mVK_ERROR_OUT_OF_HOST_MEMORY :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_OUT_OF_HOST_MEMORY = VkResult (-1)

-- | A device memory allocation has failed
pattern VK_ERROR_OUT_OF_DEVICE_MEMORY :: VkResult

pattern $bVK_ERROR_OUT_OF_DEVICE_MEMORY :: VkResult
$mVK_ERROR_OUT_OF_DEVICE_MEMORY :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_OUT_OF_DEVICE_MEMORY = VkResult (-2)

-- | Initialization of a object has failed
pattern VK_ERROR_INITIALIZATION_FAILED :: VkResult

pattern $bVK_ERROR_INITIALIZATION_FAILED :: VkResult
$mVK_ERROR_INITIALIZATION_FAILED :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_INITIALIZATION_FAILED = VkResult (-3)

-- | The logical device has been lost. See <<devsandqueues-lost-device>>
pattern VK_ERROR_DEVICE_LOST :: VkResult

pattern $bVK_ERROR_DEVICE_LOST :: VkResult
$mVK_ERROR_DEVICE_LOST :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_DEVICE_LOST = VkResult (-4)

-- | Mapping of a memory object has failed
pattern VK_ERROR_MEMORY_MAP_FAILED :: VkResult

pattern $bVK_ERROR_MEMORY_MAP_FAILED :: VkResult
$mVK_ERROR_MEMORY_MAP_FAILED :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_MEMORY_MAP_FAILED = VkResult (-5)

-- | Layer specified does not exist
pattern VK_ERROR_LAYER_NOT_PRESENT :: VkResult

pattern $bVK_ERROR_LAYER_NOT_PRESENT :: VkResult
$mVK_ERROR_LAYER_NOT_PRESENT :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_LAYER_NOT_PRESENT = VkResult (-6)

-- | Extension specified does not exist
pattern VK_ERROR_EXTENSION_NOT_PRESENT :: VkResult

pattern $bVK_ERROR_EXTENSION_NOT_PRESENT :: VkResult
$mVK_ERROR_EXTENSION_NOT_PRESENT :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_EXTENSION_NOT_PRESENT = VkResult (-7)

-- | Requested feature is not available on this device
pattern VK_ERROR_FEATURE_NOT_PRESENT :: VkResult

pattern $bVK_ERROR_FEATURE_NOT_PRESENT :: VkResult
$mVK_ERROR_FEATURE_NOT_PRESENT :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_FEATURE_NOT_PRESENT = VkResult (-8)

-- | Unable to find a Vulkan driver
pattern VK_ERROR_INCOMPATIBLE_DRIVER :: VkResult

pattern $bVK_ERROR_INCOMPATIBLE_DRIVER :: VkResult
$mVK_ERROR_INCOMPATIBLE_DRIVER :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_INCOMPATIBLE_DRIVER = VkResult (-9)

-- | Too many objects of the type have already been created
pattern VK_ERROR_TOO_MANY_OBJECTS :: VkResult

pattern $bVK_ERROR_TOO_MANY_OBJECTS :: VkResult
$mVK_ERROR_TOO_MANY_OBJECTS :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_TOO_MANY_OBJECTS = VkResult (-10)

-- | Requested format is not supported on this device
pattern VK_ERROR_FORMAT_NOT_SUPPORTED :: VkResult

pattern $bVK_ERROR_FORMAT_NOT_SUPPORTED :: VkResult
$mVK_ERROR_FORMAT_NOT_SUPPORTED :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_FORMAT_NOT_SUPPORTED = VkResult (-11)

-- | A requested pool allocation has failed due to fragmentation of the pool's memory
pattern VK_ERROR_FRAGMENTED_POOL :: VkResult

pattern $bVK_ERROR_FRAGMENTED_POOL :: VkResult
$mVK_ERROR_FRAGMENTED_POOL :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_FRAGMENTED_POOL = VkResult (-12)

-- | An unknown error has occurred, due to an implementation or application bug
pattern VK_ERROR_UNKNOWN :: VkResult

pattern $bVK_ERROR_UNKNOWN :: VkResult
$mVK_ERROR_UNKNOWN :: forall {r}. VkResult -> (Void# -> r) -> (Void# -> r) -> r
VK_ERROR_UNKNOWN = VkResult (-13)