{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE Strict                     #-}
module Graphics.Vulkan.Types.Enum.PhysicalDeviceType
       (VkPhysicalDeviceType(VkPhysicalDeviceType,
                             VK_PHYSICAL_DEVICE_TYPE_OTHER,
                             VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU,
                             VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU,
                             VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU, VK_PHYSICAL_DEVICE_TYPE_CPU))
       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#VkPhysicalDeviceType VkPhysicalDeviceType registry at www.khronos.org>
newtype VkPhysicalDeviceType = VkPhysicalDeviceType Int32
                                 deriving (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
(VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool)
-> Eq VkPhysicalDeviceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
$c/= :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
== :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
$c== :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
Eq, Eq VkPhysicalDeviceType
Eq VkPhysicalDeviceType
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Ordering)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool)
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> Ord VkPhysicalDeviceType
VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
VkPhysicalDeviceType -> VkPhysicalDeviceType -> Ordering
VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
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 :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
$cmin :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
max :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
$cmax :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
>= :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
$c>= :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
> :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
$c> :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
<= :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
$c<= :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
< :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
$c< :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Bool
compare :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Ordering
$ccompare :: VkPhysicalDeviceType -> VkPhysicalDeviceType -> Ordering
$cp1Ord :: Eq VkPhysicalDeviceType
Ord, Integer -> VkPhysicalDeviceType
VkPhysicalDeviceType -> VkPhysicalDeviceType
VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
(VkPhysicalDeviceType
 -> VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (Integer -> VkPhysicalDeviceType)
-> Num VkPhysicalDeviceType
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VkPhysicalDeviceType
$cfromInteger :: Integer -> VkPhysicalDeviceType
signum :: VkPhysicalDeviceType -> VkPhysicalDeviceType
$csignum :: VkPhysicalDeviceType -> VkPhysicalDeviceType
abs :: VkPhysicalDeviceType -> VkPhysicalDeviceType
$cabs :: VkPhysicalDeviceType -> VkPhysicalDeviceType
negate :: VkPhysicalDeviceType -> VkPhysicalDeviceType
$cnegate :: VkPhysicalDeviceType -> VkPhysicalDeviceType
* :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
$c* :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
- :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
$c- :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
+ :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
$c+ :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
Num, VkPhysicalDeviceType
VkPhysicalDeviceType
-> VkPhysicalDeviceType -> Bounded VkPhysicalDeviceType
forall a. a -> a -> Bounded a
maxBound :: VkPhysicalDeviceType
$cmaxBound :: VkPhysicalDeviceType
minBound :: VkPhysicalDeviceType
$cminBound :: VkPhysicalDeviceType
Bounded, Ptr b -> Int -> IO VkPhysicalDeviceType
Ptr b -> Int -> VkPhysicalDeviceType -> IO ()
Ptr VkPhysicalDeviceType -> IO VkPhysicalDeviceType
Ptr VkPhysicalDeviceType -> Int -> IO VkPhysicalDeviceType
Ptr VkPhysicalDeviceType -> Int -> VkPhysicalDeviceType -> IO ()
Ptr VkPhysicalDeviceType -> VkPhysicalDeviceType -> IO ()
VkPhysicalDeviceType -> Int
(VkPhysicalDeviceType -> Int)
-> (VkPhysicalDeviceType -> Int)
-> (Ptr VkPhysicalDeviceType -> Int -> IO VkPhysicalDeviceType)
-> (Ptr VkPhysicalDeviceType
    -> Int -> VkPhysicalDeviceType -> IO ())
-> (forall b. Ptr b -> Int -> IO VkPhysicalDeviceType)
-> (forall b. Ptr b -> Int -> VkPhysicalDeviceType -> IO ())
-> (Ptr VkPhysicalDeviceType -> IO VkPhysicalDeviceType)
-> (Ptr VkPhysicalDeviceType -> VkPhysicalDeviceType -> IO ())
-> Storable VkPhysicalDeviceType
forall b. Ptr b -> Int -> IO VkPhysicalDeviceType
forall b. Ptr b -> Int -> VkPhysicalDeviceType -> 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 VkPhysicalDeviceType -> VkPhysicalDeviceType -> IO ()
$cpoke :: Ptr VkPhysicalDeviceType -> VkPhysicalDeviceType -> IO ()
peek :: Ptr VkPhysicalDeviceType -> IO VkPhysicalDeviceType
$cpeek :: Ptr VkPhysicalDeviceType -> IO VkPhysicalDeviceType
pokeByteOff :: Ptr b -> Int -> VkPhysicalDeviceType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkPhysicalDeviceType -> IO ()
peekByteOff :: Ptr b -> Int -> IO VkPhysicalDeviceType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkPhysicalDeviceType
pokeElemOff :: Ptr VkPhysicalDeviceType -> Int -> VkPhysicalDeviceType -> IO ()
$cpokeElemOff :: Ptr VkPhysicalDeviceType -> Int -> VkPhysicalDeviceType -> IO ()
peekElemOff :: Ptr VkPhysicalDeviceType -> Int -> IO VkPhysicalDeviceType
$cpeekElemOff :: Ptr VkPhysicalDeviceType -> Int -> IO VkPhysicalDeviceType
alignment :: VkPhysicalDeviceType -> Int
$calignment :: VkPhysicalDeviceType -> Int
sizeOf :: VkPhysicalDeviceType -> Int
$csizeOf :: VkPhysicalDeviceType -> Int
Storable, Int -> VkPhysicalDeviceType
VkPhysicalDeviceType -> Int
VkPhysicalDeviceType -> [VkPhysicalDeviceType]
VkPhysicalDeviceType -> VkPhysicalDeviceType
VkPhysicalDeviceType
-> VkPhysicalDeviceType -> [VkPhysicalDeviceType]
VkPhysicalDeviceType
-> VkPhysicalDeviceType
-> VkPhysicalDeviceType
-> [VkPhysicalDeviceType]
(VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (Int -> VkPhysicalDeviceType)
-> (VkPhysicalDeviceType -> Int)
-> (VkPhysicalDeviceType -> [VkPhysicalDeviceType])
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType -> [VkPhysicalDeviceType])
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType -> [VkPhysicalDeviceType])
-> (VkPhysicalDeviceType
    -> VkPhysicalDeviceType
    -> VkPhysicalDeviceType
    -> [VkPhysicalDeviceType])
-> Enum VkPhysicalDeviceType
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 :: VkPhysicalDeviceType
-> VkPhysicalDeviceType
-> VkPhysicalDeviceType
-> [VkPhysicalDeviceType]
$cenumFromThenTo :: VkPhysicalDeviceType
-> VkPhysicalDeviceType
-> VkPhysicalDeviceType
-> [VkPhysicalDeviceType]
enumFromTo :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> [VkPhysicalDeviceType]
$cenumFromTo :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> [VkPhysicalDeviceType]
enumFromThen :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> [VkPhysicalDeviceType]
$cenumFromThen :: VkPhysicalDeviceType
-> VkPhysicalDeviceType -> [VkPhysicalDeviceType]
enumFrom :: VkPhysicalDeviceType -> [VkPhysicalDeviceType]
$cenumFrom :: VkPhysicalDeviceType -> [VkPhysicalDeviceType]
fromEnum :: VkPhysicalDeviceType -> Int
$cfromEnum :: VkPhysicalDeviceType -> Int
toEnum :: Int -> VkPhysicalDeviceType
$ctoEnum :: Int -> VkPhysicalDeviceType
pred :: VkPhysicalDeviceType -> VkPhysicalDeviceType
$cpred :: VkPhysicalDeviceType -> VkPhysicalDeviceType
succ :: VkPhysicalDeviceType -> VkPhysicalDeviceType
$csucc :: VkPhysicalDeviceType -> VkPhysicalDeviceType
Enum, Typeable VkPhysicalDeviceType
DataType
Constr
Typeable VkPhysicalDeviceType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VkPhysicalDeviceType
    -> c VkPhysicalDeviceType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VkPhysicalDeviceType)
-> (VkPhysicalDeviceType -> Constr)
-> (VkPhysicalDeviceType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VkPhysicalDeviceType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VkPhysicalDeviceType))
-> ((forall b. Data b => b -> b)
    -> VkPhysicalDeviceType -> VkPhysicalDeviceType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VkPhysicalDeviceType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VkPhysicalDeviceType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VkPhysicalDeviceType -> m VkPhysicalDeviceType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VkPhysicalDeviceType -> m VkPhysicalDeviceType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VkPhysicalDeviceType -> m VkPhysicalDeviceType)
-> Data VkPhysicalDeviceType
VkPhysicalDeviceType -> DataType
VkPhysicalDeviceType -> Constr
(forall b. Data b => b -> b)
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkPhysicalDeviceType
-> c VkPhysicalDeviceType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkPhysicalDeviceType
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) -> VkPhysicalDeviceType -> u
forall u.
(forall d. Data d => d -> u) -> VkPhysicalDeviceType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkPhysicalDeviceType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkPhysicalDeviceType
-> c VkPhysicalDeviceType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkPhysicalDeviceType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkPhysicalDeviceType)
$cVkPhysicalDeviceType :: Constr
$tVkPhysicalDeviceType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
gmapMp :: (forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
gmapM :: (forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VkPhysicalDeviceType -> m VkPhysicalDeviceType
gmapQi :: Int -> (forall d. Data d => d -> u) -> VkPhysicalDeviceType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> VkPhysicalDeviceType -> u
gmapQ :: (forall d. Data d => d -> u) -> VkPhysicalDeviceType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VkPhysicalDeviceType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VkPhysicalDeviceType -> r
gmapT :: (forall b. Data b => b -> b)
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
$cgmapT :: (forall b. Data b => b -> b)
-> VkPhysicalDeviceType -> VkPhysicalDeviceType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkPhysicalDeviceType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkPhysicalDeviceType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VkPhysicalDeviceType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkPhysicalDeviceType)
dataTypeOf :: VkPhysicalDeviceType -> DataType
$cdataTypeOf :: VkPhysicalDeviceType -> DataType
toConstr :: VkPhysicalDeviceType -> Constr
$ctoConstr :: VkPhysicalDeviceType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkPhysicalDeviceType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkPhysicalDeviceType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkPhysicalDeviceType
-> c VkPhysicalDeviceType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkPhysicalDeviceType
-> c VkPhysicalDeviceType
$cp1Data :: Typeable VkPhysicalDeviceType
Data, (forall x. VkPhysicalDeviceType -> Rep VkPhysicalDeviceType x)
-> (forall x. Rep VkPhysicalDeviceType x -> VkPhysicalDeviceType)
-> Generic VkPhysicalDeviceType
forall x. Rep VkPhysicalDeviceType x -> VkPhysicalDeviceType
forall x. VkPhysicalDeviceType -> Rep VkPhysicalDeviceType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VkPhysicalDeviceType x -> VkPhysicalDeviceType
$cfrom :: forall x. VkPhysicalDeviceType -> Rep VkPhysicalDeviceType x
Generic)

instance Show VkPhysicalDeviceType where
        showsPrec :: Int -> VkPhysicalDeviceType -> ShowS
showsPrec Int
_ VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_OTHER
          = String -> ShowS
showString String
"VK_PHYSICAL_DEVICE_TYPE_OTHER"
        showsPrec Int
_ VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU
          = String -> ShowS
showString String
"VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU"
        showsPrec Int
_ VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU
          = String -> ShowS
showString String
"VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU"
        showsPrec Int
_ VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU
          = String -> ShowS
showString String
"VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU"
        showsPrec Int
_ VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_CPU
          = String -> ShowS
showString String
"VK_PHYSICAL_DEVICE_TYPE_CPU"
        showsPrec Int
p (VkPhysicalDeviceType Int32
x)
          = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
              (String -> ShowS
showString String
"VkPhysicalDeviceType " 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 VkPhysicalDeviceType where
        readPrec :: ReadPrec VkPhysicalDeviceType
readPrec
          = ReadPrec VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall a. ReadPrec a -> ReadPrec a
parens
              ([(String, ReadPrec VkPhysicalDeviceType)]
-> ReadPrec VkPhysicalDeviceType
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
                 [(String
"VK_PHYSICAL_DEVICE_TYPE_OTHER",
                   VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_OTHER),
                  (String
"VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU",
                   VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU),
                  (String
"VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU",
                   VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU),
                  (String
"VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU",
                   VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU),
                  (String
"VK_PHYSICAL_DEVICE_TYPE_CPU", VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkPhysicalDeviceType
VK_PHYSICAL_DEVICE_TYPE_CPU)]
                 ReadPrec VkPhysicalDeviceType
-> ReadPrec VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                 Int
-> ReadPrec VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
                   (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkPhysicalDeviceType") ReadPrec ()
-> ReadPrec VkPhysicalDeviceType -> ReadPrec VkPhysicalDeviceType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                      (Int32 -> VkPhysicalDeviceType
VkPhysicalDeviceType (Int32 -> VkPhysicalDeviceType)
-> ReadPrec Int32 -> ReadPrec VkPhysicalDeviceType
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_PHYSICAL_DEVICE_TYPE_OTHER :: VkPhysicalDeviceType

pattern $bVK_PHYSICAL_DEVICE_TYPE_OTHER :: VkPhysicalDeviceType
$mVK_PHYSICAL_DEVICE_TYPE_OTHER :: forall r. VkPhysicalDeviceType -> (Void# -> r) -> (Void# -> r) -> r
VK_PHYSICAL_DEVICE_TYPE_OTHER = VkPhysicalDeviceType 0

pattern VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU ::
        VkPhysicalDeviceType

pattern $bVK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU :: VkPhysicalDeviceType
$mVK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU :: forall r. VkPhysicalDeviceType -> (Void# -> r) -> (Void# -> r) -> r
VK_PHYSICAL_DEVICE_TYPE_INTEGRATED_GPU =
        VkPhysicalDeviceType 1

pattern VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU ::
        VkPhysicalDeviceType

pattern $bVK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU :: VkPhysicalDeviceType
$mVK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU :: forall r. VkPhysicalDeviceType -> (Void# -> r) -> (Void# -> r) -> r
VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU =
        VkPhysicalDeviceType 2

pattern VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU :: VkPhysicalDeviceType

pattern $bVK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU :: VkPhysicalDeviceType
$mVK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU :: forall r. VkPhysicalDeviceType -> (Void# -> r) -> (Void# -> r) -> r
VK_PHYSICAL_DEVICE_TYPE_VIRTUAL_GPU =
        VkPhysicalDeviceType 3

pattern VK_PHYSICAL_DEVICE_TYPE_CPU :: VkPhysicalDeviceType

pattern $bVK_PHYSICAL_DEVICE_TYPE_CPU :: VkPhysicalDeviceType
$mVK_PHYSICAL_DEVICE_TYPE_CPU :: forall r. VkPhysicalDeviceType -> (Void# -> r) -> (Void# -> r) -> r
VK_PHYSICAL_DEVICE_TYPE_CPU = VkPhysicalDeviceType 4