{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# 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))
       where
import           Data.Data                       (Data)
import           Foreign.Storable                (Storable)
import           GHC.Generics                    (Generic)
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.1-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
$cp1Ord :: Eq VkResult
Ord, Integer -> VkResult
VkResult -> VkResult
VkResult -> VkResult -> VkResult
(VkResult -> VkResult -> VkResult)
-> (VkResult -> VkResult -> VkResult)
-> (VkResult -> VkResult -> VkResult)
-> (VkResult -> VkResult)
-> (VkResult -> VkResult)
-> (VkResult -> VkResult)
-> (Integer -> VkResult)
-> Num VkResult
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VkResult
$cfromInteger :: Integer -> VkResult
signum :: VkResult -> VkResult
$csignum :: VkResult -> VkResult
abs :: VkResult -> VkResult
$cabs :: VkResult -> VkResult
negate :: VkResult -> VkResult
$cnegate :: VkResult -> VkResult
* :: VkResult -> VkResult -> VkResult
$c* :: VkResult -> VkResult -> VkResult
- :: VkResult -> VkResult -> VkResult
$c- :: VkResult -> VkResult -> VkResult
+ :: VkResult -> VkResult -> VkResult
$c+ :: VkResult -> VkResult -> VkResult
Num, VkResult
VkResult -> VkResult -> Bounded VkResult
forall a. a -> a -> Bounded a
maxBound :: VkResult
$cmaxBound :: VkResult
minBound :: VkResult
$cminBound :: VkResult
Bounded, Ptr b -> Int -> IO VkResult
Ptr b -> Int -> VkResult -> IO ()
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 :: Ptr b -> Int -> VkResult -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkResult -> IO ()
peekByteOff :: 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, 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, Typeable VkResult
DataType
Constr
Typeable VkResult
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VkResult -> c VkResult)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VkResult)
-> (VkResult -> Constr)
-> (VkResult -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VkResult))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VkResult))
-> ((forall b. Data b => b -> b) -> VkResult -> VkResult)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VkResult -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VkResult -> r)
-> (forall u. (forall d. Data d => d -> u) -> VkResult -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> VkResult -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> VkResult -> m VkResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VkResult -> m VkResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VkResult -> m VkResult)
-> Data VkResult
VkResult -> DataType
VkResult -> Constr
(forall b. Data b => b -> b) -> VkResult -> VkResult
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkResult -> c VkResult
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkResult
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> VkResult -> u
forall u. (forall d. Data d => d -> u) -> VkResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VkResult -> m VkResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VkResult -> m VkResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkResult -> c VkResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VkResult)
$cVkResult :: Constr
$tVkResult :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VkResult -> m VkResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VkResult -> m VkResult
gmapMp :: (forall d. Data d => d -> m d) -> VkResult -> m VkResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VkResult -> m VkResult
gmapM :: (forall d. Data d => d -> m d) -> VkResult -> m VkResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VkResult -> m VkResult
gmapQi :: Int -> (forall d. Data d => d -> u) -> VkResult -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VkResult -> u
gmapQ :: (forall d. Data d => d -> u) -> VkResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VkResult -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkResult -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkResult -> r
gmapT :: (forall b. Data b => b -> b) -> VkResult -> VkResult
$cgmapT :: (forall b. Data b => b -> b) -> VkResult -> VkResult
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VkResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VkResult)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VkResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkResult)
dataTypeOf :: VkResult -> DataType
$cdataTypeOf :: VkResult -> DataType
toConstr :: VkResult -> Constr
$ctoConstr :: VkResult -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkResult
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkResult -> c VkResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VkResult -> c VkResult
$cp1Data :: Typeable VkResult
Data, (forall x. VkResult -> Rep VkResult x)
-> (forall x. Rep VkResult x -> VkResult) -> Generic VkResult
forall x. Rep VkResult x -> VkResult
forall x. VkResult -> Rep VkResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VkResult x -> VkResult
$cfrom :: forall x. VkResult -> Rep VkResult x
Generic)

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
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)]
                 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)