{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE Strict                     #-}
module Graphics.Vulkan.Types.Enum.ComponentSwizzle
       (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))
       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 (..))

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-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
$cp1Ord :: Eq VkComponentSwizzle
Ord, Integer -> VkComponentSwizzle
VkComponentSwizzle -> VkComponentSwizzle
VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
(VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle)
-> (VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle)
-> (VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle)
-> (VkComponentSwizzle -> VkComponentSwizzle)
-> (VkComponentSwizzle -> VkComponentSwizzle)
-> (VkComponentSwizzle -> VkComponentSwizzle)
-> (Integer -> VkComponentSwizzle)
-> Num VkComponentSwizzle
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VkComponentSwizzle
$cfromInteger :: Integer -> VkComponentSwizzle
signum :: VkComponentSwizzle -> VkComponentSwizzle
$csignum :: VkComponentSwizzle -> VkComponentSwizzle
abs :: VkComponentSwizzle -> VkComponentSwizzle
$cabs :: VkComponentSwizzle -> VkComponentSwizzle
negate :: VkComponentSwizzle -> VkComponentSwizzle
$cnegate :: VkComponentSwizzle -> VkComponentSwizzle
* :: VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
$c* :: VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
- :: VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
$c- :: VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
+ :: VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
$c+ :: VkComponentSwizzle -> VkComponentSwizzle -> VkComponentSwizzle
Num, VkComponentSwizzle
VkComponentSwizzle
-> VkComponentSwizzle -> Bounded VkComponentSwizzle
forall a. a -> a -> Bounded a
maxBound :: VkComponentSwizzle
$cmaxBound :: VkComponentSwizzle
minBound :: VkComponentSwizzle
$cminBound :: VkComponentSwizzle
Bounded, Ptr b -> Int -> IO VkComponentSwizzle
Ptr b -> Int -> VkComponentSwizzle -> IO ()
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 :: Ptr b -> Int -> VkComponentSwizzle -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkComponentSwizzle -> IO ()
peekByteOff :: 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, 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, Typeable VkComponentSwizzle
DataType
Constr
Typeable VkComponentSwizzle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VkComponentSwizzle
    -> c VkComponentSwizzle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VkComponentSwizzle)
-> (VkComponentSwizzle -> Constr)
-> (VkComponentSwizzle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VkComponentSwizzle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VkComponentSwizzle))
-> ((forall b. Data b => b -> b)
    -> VkComponentSwizzle -> VkComponentSwizzle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VkComponentSwizzle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VkComponentSwizzle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VkComponentSwizzle -> m VkComponentSwizzle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VkComponentSwizzle -> m VkComponentSwizzle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VkComponentSwizzle -> m VkComponentSwizzle)
-> Data VkComponentSwizzle
VkComponentSwizzle -> DataType
VkComponentSwizzle -> Constr
(forall b. Data b => b -> b)
-> VkComponentSwizzle -> VkComponentSwizzle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkComponentSwizzle
-> c VkComponentSwizzle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkComponentSwizzle
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) -> VkComponentSwizzle -> u
forall u. (forall d. Data d => d -> u) -> VkComponentSwizzle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkComponentSwizzle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkComponentSwizzle
-> c VkComponentSwizzle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkComponentSwizzle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkComponentSwizzle)
$cVkComponentSwizzle :: Constr
$tVkComponentSwizzle :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
gmapMp :: (forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
gmapM :: (forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VkComponentSwizzle -> m VkComponentSwizzle
gmapQi :: Int -> (forall d. Data d => d -> u) -> VkComponentSwizzle -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> VkComponentSwizzle -> u
gmapQ :: (forall d. Data d => d -> u) -> VkComponentSwizzle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VkComponentSwizzle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkComponentSwizzle -> r
gmapT :: (forall b. Data b => b -> b)
-> VkComponentSwizzle -> VkComponentSwizzle
$cgmapT :: (forall b. Data b => b -> b)
-> VkComponentSwizzle -> VkComponentSwizzle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkComponentSwizzle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkComponentSwizzle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VkComponentSwizzle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkComponentSwizzle)
dataTypeOf :: VkComponentSwizzle -> DataType
$cdataTypeOf :: VkComponentSwizzle -> DataType
toConstr :: VkComponentSwizzle -> Constr
$ctoConstr :: VkComponentSwizzle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkComponentSwizzle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkComponentSwizzle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkComponentSwizzle
-> c VkComponentSwizzle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkComponentSwizzle
-> c VkComponentSwizzle
$cp1Data :: Typeable VkComponentSwizzle
Data, (forall x. VkComponentSwizzle -> Rep VkComponentSwizzle x)
-> (forall x. Rep VkComponentSwizzle x -> VkComponentSwizzle)
-> Generic VkComponentSwizzle
forall x. Rep VkComponentSwizzle x -> VkComponentSwizzle
forall x. VkComponentSwizzle -> Rep VkComponentSwizzle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VkComponentSwizzle x -> VkComponentSwizzle
$cfrom :: forall x. VkComponentSwizzle -> Rep VkComponentSwizzle x
Generic)

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