{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE Strict                     #-}
module Graphics.Vulkan.Types.Enum.Component
       (VkComponentSwizzle(VkComponentSwizzle,
                           VK_COMPONENT_SWIZZLE_IDENTITY, VK_COMPONENT_SWIZZLE_ZERO,
                           VK_COMPONENT_SWIZZLE_ONE, VK_COMPONENT_SWIZZLE_R,
                           VK_COMPONENT_SWIZZLE_G, VK_COMPONENT_SWIZZLE_B,
                           VK_COMPONENT_SWIZZLE_A),
        VkComponentTypeNV(VkComponentTypeNV, VK_COMPONENT_TYPE_FLOAT16_NV,
                          VK_COMPONENT_TYPE_FLOAT32_NV, VK_COMPONENT_TYPE_FLOAT64_NV,
                          VK_COMPONENT_TYPE_SINT8_NV, VK_COMPONENT_TYPE_SINT16_NV,
                          VK_COMPONENT_TYPE_SINT32_NV, VK_COMPONENT_TYPE_SINT64_NV,
                          VK_COMPONENT_TYPE_UINT8_NV, VK_COMPONENT_TYPE_UINT16_NV,
                          VK_COMPONENT_TYPE_UINT32_NV, VK_COMPONENT_TYPE_UINT64_NV))
       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 (..))

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

instance Show VkComponentSwizzle where
    showsPrec :: Int -> VkComponentSwizzle -> ShowS
showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_IDENTITY
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_IDENTITY"
    showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_ZERO
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_ZERO"
    showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_ONE
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_ONE"
    showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_R
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_R"
    showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_G
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_G"
    showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_B
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_B"
    showsPrec Int
_ VkComponentSwizzle
VK_COMPONENT_SWIZZLE_A
      = String -> ShowS
showString String
"VK_COMPONENT_SWIZZLE_A"
    showsPrec Int
p (VkComponentSwizzle Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkComponentSwizzle " 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 VkComponentSwizzle where
    readPrec :: ReadPrec VkComponentSwizzle
readPrec
      = ReadPrec VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkComponentSwizzle)]
-> ReadPrec VkComponentSwizzle
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_COMPONENT_SWIZZLE_IDENTITY",
               VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_IDENTITY),
              (String
"VK_COMPONENT_SWIZZLE_ZERO", VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_ZERO),
              (String
"VK_COMPONENT_SWIZZLE_ONE", VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_ONE),
              (String
"VK_COMPONENT_SWIZZLE_R", VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_R),
              (String
"VK_COMPONENT_SWIZZLE_G", VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_G),
              (String
"VK_COMPONENT_SWIZZLE_B", VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_B),
              (String
"VK_COMPONENT_SWIZZLE_A", VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentSwizzle
VK_COMPONENT_SWIZZLE_A)]
             ReadPrec VkComponentSwizzle
-> ReadPrec VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkComponentSwizzle") ReadPrec ()
-> ReadPrec VkComponentSwizzle -> ReadPrec VkComponentSwizzle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkComponentSwizzle
VkComponentSwizzle (Int32 -> VkComponentSwizzle)
-> ReadPrec Int32 -> ReadPrec VkComponentSwizzle
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)))

pattern VK_COMPONENT_SWIZZLE_IDENTITY :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_IDENTITY :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_IDENTITY :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_IDENTITY = VkComponentSwizzle 0

pattern VK_COMPONENT_SWIZZLE_ZERO :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_ZERO :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_ZERO :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_ZERO = VkComponentSwizzle 1

pattern VK_COMPONENT_SWIZZLE_ONE :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_ONE :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_ONE :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_ONE = VkComponentSwizzle 2

pattern VK_COMPONENT_SWIZZLE_R :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_R :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_R :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_R = VkComponentSwizzle 3

pattern VK_COMPONENT_SWIZZLE_G :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_G :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_G :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_G = VkComponentSwizzle 4

pattern VK_COMPONENT_SWIZZLE_B :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_B :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_B :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_B = VkComponentSwizzle 5

pattern VK_COMPONENT_SWIZZLE_A :: VkComponentSwizzle

pattern $bVK_COMPONENT_SWIZZLE_A :: VkComponentSwizzle
$mVK_COMPONENT_SWIZZLE_A :: forall {r}. VkComponentSwizzle -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_SWIZZLE_A = VkComponentSwizzle 6

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

instance Show VkComponentTypeNV where
    showsPrec :: Int -> VkComponentTypeNV -> ShowS
showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_FLOAT16_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_FLOAT16_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_FLOAT32_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_FLOAT32_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_FLOAT64_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_FLOAT64_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_SINT8_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_SINT8_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_SINT16_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_SINT16_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_SINT32_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_SINT32_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_SINT64_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_SINT64_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_UINT8_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_UINT8_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_UINT16_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_UINT16_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_UINT32_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_UINT32_NV"
    showsPrec Int
_ VkComponentTypeNV
VK_COMPONENT_TYPE_UINT64_NV
      = String -> ShowS
showString String
"VK_COMPONENT_TYPE_UINT64_NV"
    showsPrec Int
p (VkComponentTypeNV Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkComponentTypeNV " 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 VkComponentTypeNV where
    readPrec :: ReadPrec VkComponentTypeNV
readPrec
      = ReadPrec VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkComponentTypeNV)]
-> ReadPrec VkComponentTypeNV
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_COMPONENT_TYPE_FLOAT16_NV",
               VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_FLOAT16_NV),
              (String
"VK_COMPONENT_TYPE_FLOAT32_NV",
               VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_FLOAT32_NV),
              (String
"VK_COMPONENT_TYPE_FLOAT64_NV",
               VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_FLOAT64_NV),
              (String
"VK_COMPONENT_TYPE_SINT8_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_SINT8_NV),
              (String
"VK_COMPONENT_TYPE_SINT16_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_SINT16_NV),
              (String
"VK_COMPONENT_TYPE_SINT32_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_SINT32_NV),
              (String
"VK_COMPONENT_TYPE_SINT64_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_SINT64_NV),
              (String
"VK_COMPONENT_TYPE_UINT8_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_UINT8_NV),
              (String
"VK_COMPONENT_TYPE_UINT16_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_UINT16_NV),
              (String
"VK_COMPONENT_TYPE_UINT32_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_UINT32_NV),
              (String
"VK_COMPONENT_TYPE_UINT64_NV", VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkComponentTypeNV
VK_COMPONENT_TYPE_UINT64_NV)]
             ReadPrec VkComponentTypeNV
-> ReadPrec VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkComponentTypeNV") ReadPrec ()
-> ReadPrec VkComponentTypeNV -> ReadPrec VkComponentTypeNV
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkComponentTypeNV
VkComponentTypeNV (Int32 -> VkComponentTypeNV)
-> ReadPrec Int32 -> ReadPrec VkComponentTypeNV
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)))

pattern VK_COMPONENT_TYPE_FLOAT16_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_FLOAT16_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_FLOAT16_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_FLOAT16_NV = VkComponentTypeNV 0

pattern VK_COMPONENT_TYPE_FLOAT32_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_FLOAT32_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_FLOAT32_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_FLOAT32_NV = VkComponentTypeNV 1

pattern VK_COMPONENT_TYPE_FLOAT64_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_FLOAT64_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_FLOAT64_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_FLOAT64_NV = VkComponentTypeNV 2

pattern VK_COMPONENT_TYPE_SINT8_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_SINT8_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_SINT8_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_SINT8_NV = VkComponentTypeNV 3

pattern VK_COMPONENT_TYPE_SINT16_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_SINT16_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_SINT16_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_SINT16_NV = VkComponentTypeNV 4

pattern VK_COMPONENT_TYPE_SINT32_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_SINT32_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_SINT32_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_SINT32_NV = VkComponentTypeNV 5

pattern VK_COMPONENT_TYPE_SINT64_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_SINT64_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_SINT64_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_SINT64_NV = VkComponentTypeNV 6

pattern VK_COMPONENT_TYPE_UINT8_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_UINT8_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_UINT8_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_UINT8_NV = VkComponentTypeNV 7

pattern VK_COMPONENT_TYPE_UINT16_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_UINT16_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_UINT16_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_UINT16_NV = VkComponentTypeNV 8

pattern VK_COMPONENT_TYPE_UINT32_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_UINT32_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_UINT32_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_UINT32_NV = VkComponentTypeNV 9

pattern VK_COMPONENT_TYPE_UINT64_NV :: VkComponentTypeNV

pattern $bVK_COMPONENT_TYPE_UINT64_NV :: VkComponentTypeNV
$mVK_COMPONENT_TYPE_UINT64_NV :: forall {r}. VkComponentTypeNV -> (Void# -> r) -> (Void# -> r) -> r
VK_COMPONENT_TYPE_UINT64_NV = VkComponentTypeNV 10