{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE Strict                     #-}
module Graphics.Vulkan.Types.Enum.IndexType
       (VkIndexType(VkIndexType, VK_INDEX_TYPE_UINT16,
                    VK_INDEX_TYPE_UINT32))
       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#VkIndexType VkIndexType registry at www.khronos.org>
newtype VkIndexType = VkIndexType Int32
                      deriving (VkIndexType -> VkIndexType -> Bool
(VkIndexType -> VkIndexType -> Bool)
-> (VkIndexType -> VkIndexType -> Bool) -> Eq VkIndexType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkIndexType -> VkIndexType -> Bool
$c/= :: VkIndexType -> VkIndexType -> Bool
== :: VkIndexType -> VkIndexType -> Bool
$c== :: VkIndexType -> VkIndexType -> Bool
Eq, Eq VkIndexType
Eq VkIndexType
-> (VkIndexType -> VkIndexType -> Ordering)
-> (VkIndexType -> VkIndexType -> Bool)
-> (VkIndexType -> VkIndexType -> Bool)
-> (VkIndexType -> VkIndexType -> Bool)
-> (VkIndexType -> VkIndexType -> Bool)
-> (VkIndexType -> VkIndexType -> VkIndexType)
-> (VkIndexType -> VkIndexType -> VkIndexType)
-> Ord VkIndexType
VkIndexType -> VkIndexType -> Bool
VkIndexType -> VkIndexType -> Ordering
VkIndexType -> VkIndexType -> VkIndexType
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 :: VkIndexType -> VkIndexType -> VkIndexType
$cmin :: VkIndexType -> VkIndexType -> VkIndexType
max :: VkIndexType -> VkIndexType -> VkIndexType
$cmax :: VkIndexType -> VkIndexType -> VkIndexType
>= :: VkIndexType -> VkIndexType -> Bool
$c>= :: VkIndexType -> VkIndexType -> Bool
> :: VkIndexType -> VkIndexType -> Bool
$c> :: VkIndexType -> VkIndexType -> Bool
<= :: VkIndexType -> VkIndexType -> Bool
$c<= :: VkIndexType -> VkIndexType -> Bool
< :: VkIndexType -> VkIndexType -> Bool
$c< :: VkIndexType -> VkIndexType -> Bool
compare :: VkIndexType -> VkIndexType -> Ordering
$ccompare :: VkIndexType -> VkIndexType -> Ordering
Ord, Int -> VkIndexType
VkIndexType -> Int
VkIndexType -> [VkIndexType]
VkIndexType -> VkIndexType
VkIndexType -> VkIndexType -> [VkIndexType]
VkIndexType -> VkIndexType -> VkIndexType -> [VkIndexType]
(VkIndexType -> VkIndexType)
-> (VkIndexType -> VkIndexType)
-> (Int -> VkIndexType)
-> (VkIndexType -> Int)
-> (VkIndexType -> [VkIndexType])
-> (VkIndexType -> VkIndexType -> [VkIndexType])
-> (VkIndexType -> VkIndexType -> [VkIndexType])
-> (VkIndexType -> VkIndexType -> VkIndexType -> [VkIndexType])
-> Enum VkIndexType
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 :: VkIndexType -> VkIndexType -> VkIndexType -> [VkIndexType]
$cenumFromThenTo :: VkIndexType -> VkIndexType -> VkIndexType -> [VkIndexType]
enumFromTo :: VkIndexType -> VkIndexType -> [VkIndexType]
$cenumFromTo :: VkIndexType -> VkIndexType -> [VkIndexType]
enumFromThen :: VkIndexType -> VkIndexType -> [VkIndexType]
$cenumFromThen :: VkIndexType -> VkIndexType -> [VkIndexType]
enumFrom :: VkIndexType -> [VkIndexType]
$cenumFrom :: VkIndexType -> [VkIndexType]
fromEnum :: VkIndexType -> Int
$cfromEnum :: VkIndexType -> Int
toEnum :: Int -> VkIndexType
$ctoEnum :: Int -> VkIndexType
pred :: VkIndexType -> VkIndexType
$cpred :: VkIndexType -> VkIndexType
succ :: VkIndexType -> VkIndexType
$csucc :: VkIndexType -> VkIndexType
Enum, Ptr VkIndexType -> IO VkIndexType
Ptr VkIndexType -> Int -> IO VkIndexType
Ptr VkIndexType -> Int -> VkIndexType -> IO ()
Ptr VkIndexType -> VkIndexType -> IO ()
VkIndexType -> Int
(VkIndexType -> Int)
-> (VkIndexType -> Int)
-> (Ptr VkIndexType -> Int -> IO VkIndexType)
-> (Ptr VkIndexType -> Int -> VkIndexType -> IO ())
-> (forall b. Ptr b -> Int -> IO VkIndexType)
-> (forall b. Ptr b -> Int -> VkIndexType -> IO ())
-> (Ptr VkIndexType -> IO VkIndexType)
-> (Ptr VkIndexType -> VkIndexType -> IO ())
-> Storable VkIndexType
forall b. Ptr b -> Int -> IO VkIndexType
forall b. Ptr b -> Int -> VkIndexType -> 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 VkIndexType -> VkIndexType -> IO ()
$cpoke :: Ptr VkIndexType -> VkIndexType -> IO ()
peek :: Ptr VkIndexType -> IO VkIndexType
$cpeek :: Ptr VkIndexType -> IO VkIndexType
pokeByteOff :: forall b. Ptr b -> Int -> VkIndexType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkIndexType -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkIndexType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkIndexType
pokeElemOff :: Ptr VkIndexType -> Int -> VkIndexType -> IO ()
$cpokeElemOff :: Ptr VkIndexType -> Int -> VkIndexType -> IO ()
peekElemOff :: Ptr VkIndexType -> Int -> IO VkIndexType
$cpeekElemOff :: Ptr VkIndexType -> Int -> IO VkIndexType
alignment :: VkIndexType -> Int
$calignment :: VkIndexType -> Int
sizeOf :: VkIndexType -> Int
$csizeOf :: VkIndexType -> Int
Storable)

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

pattern $bVK_INDEX_TYPE_UINT16 :: VkIndexType
$mVK_INDEX_TYPE_UINT16 :: forall {r}. VkIndexType -> (Void# -> r) -> (Void# -> r) -> r
VK_INDEX_TYPE_UINT16 = VkIndexType 0

pattern VK_INDEX_TYPE_UINT32 :: VkIndexType

pattern $bVK_INDEX_TYPE_UINT32 :: VkIndexType
$mVK_INDEX_TYPE_UINT32 :: forall {r}. VkIndexType -> (Void# -> r) -> (Void# -> r) -> r
VK_INDEX_TYPE_UINT32 = VkIndexType 1