module Data.SpirV.Enum.ImageChannelDataType where

import Data.String (IsString(..))
import Data.Word (Word32)
import Foreign (Storable(..))
import GHC.Read (Read(..))
import Text.ParserCombinators.ReadPrec (pfail)
import qualified GHC.Read as Read
import qualified Text.Read.Lex as Lex

newtype ImageChannelDataType = ImageChannelDataType Word32
  deriving (ImageChannelDataType -> ImageChannelDataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageChannelDataType -> ImageChannelDataType -> Bool
$c/= :: ImageChannelDataType -> ImageChannelDataType -> Bool
== :: ImageChannelDataType -> ImageChannelDataType -> Bool
$c== :: ImageChannelDataType -> ImageChannelDataType -> Bool
Eq, Eq ImageChannelDataType
ImageChannelDataType -> ImageChannelDataType -> Bool
ImageChannelDataType -> ImageChannelDataType -> Ordering
ImageChannelDataType
-> ImageChannelDataType -> ImageChannelDataType
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 :: ImageChannelDataType
-> ImageChannelDataType -> ImageChannelDataType
$cmin :: ImageChannelDataType
-> ImageChannelDataType -> ImageChannelDataType
max :: ImageChannelDataType
-> ImageChannelDataType -> ImageChannelDataType
$cmax :: ImageChannelDataType
-> ImageChannelDataType -> ImageChannelDataType
>= :: ImageChannelDataType -> ImageChannelDataType -> Bool
$c>= :: ImageChannelDataType -> ImageChannelDataType -> Bool
> :: ImageChannelDataType -> ImageChannelDataType -> Bool
$c> :: ImageChannelDataType -> ImageChannelDataType -> Bool
<= :: ImageChannelDataType -> ImageChannelDataType -> Bool
$c<= :: ImageChannelDataType -> ImageChannelDataType -> Bool
< :: ImageChannelDataType -> ImageChannelDataType -> Bool
$c< :: ImageChannelDataType -> ImageChannelDataType -> Bool
compare :: ImageChannelDataType -> ImageChannelDataType -> Ordering
$ccompare :: ImageChannelDataType -> ImageChannelDataType -> Ordering
Ord, Ptr ImageChannelDataType -> IO ImageChannelDataType
Ptr ImageChannelDataType -> Int -> IO ImageChannelDataType
Ptr ImageChannelDataType -> Int -> ImageChannelDataType -> IO ()
Ptr ImageChannelDataType -> ImageChannelDataType -> IO ()
ImageChannelDataType -> Int
forall b. Ptr b -> Int -> IO ImageChannelDataType
forall b. Ptr b -> Int -> ImageChannelDataType -> 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 ImageChannelDataType -> ImageChannelDataType -> IO ()
$cpoke :: Ptr ImageChannelDataType -> ImageChannelDataType -> IO ()
peek :: Ptr ImageChannelDataType -> IO ImageChannelDataType
$cpeek :: Ptr ImageChannelDataType -> IO ImageChannelDataType
pokeByteOff :: forall b. Ptr b -> Int -> ImageChannelDataType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ImageChannelDataType -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO ImageChannelDataType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ImageChannelDataType
pokeElemOff :: Ptr ImageChannelDataType -> Int -> ImageChannelDataType -> IO ()
$cpokeElemOff :: Ptr ImageChannelDataType -> Int -> ImageChannelDataType -> IO ()
peekElemOff :: Ptr ImageChannelDataType -> Int -> IO ImageChannelDataType
$cpeekElemOff :: Ptr ImageChannelDataType -> Int -> IO ImageChannelDataType
alignment :: ImageChannelDataType -> Int
$calignment :: ImageChannelDataType -> Int
sizeOf :: ImageChannelDataType -> Int
$csizeOf :: ImageChannelDataType -> Int
Storable)

pattern SnormInt8 :: ImageChannelDataType
pattern $bSnormInt8 :: ImageChannelDataType
$mSnormInt8 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
SnormInt8 = ImageChannelDataType 0

pattern SnormInt16 :: ImageChannelDataType
pattern $bSnormInt16 :: ImageChannelDataType
$mSnormInt16 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
SnormInt16 = ImageChannelDataType 1

pattern UnormInt8 :: ImageChannelDataType
pattern $bUnormInt8 :: ImageChannelDataType
$mUnormInt8 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormInt8 = ImageChannelDataType 2

pattern UnormInt16 :: ImageChannelDataType
pattern $bUnormInt16 :: ImageChannelDataType
$mUnormInt16 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormInt16 = ImageChannelDataType 3

pattern UnormShort565 :: ImageChannelDataType
pattern $bUnormShort565 :: ImageChannelDataType
$mUnormShort565 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormShort565 = ImageChannelDataType 4

pattern UnormShort555 :: ImageChannelDataType
pattern $bUnormShort555 :: ImageChannelDataType
$mUnormShort555 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormShort555 = ImageChannelDataType 5

pattern UnormInt101010 :: ImageChannelDataType
pattern $bUnormInt101010 :: ImageChannelDataType
$mUnormInt101010 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormInt101010 = ImageChannelDataType 6

pattern SignedInt8 :: ImageChannelDataType
pattern $bSignedInt8 :: ImageChannelDataType
$mSignedInt8 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
SignedInt8 = ImageChannelDataType 7

pattern SignedInt16 :: ImageChannelDataType
pattern $bSignedInt16 :: ImageChannelDataType
$mSignedInt16 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
SignedInt16 = ImageChannelDataType 8

pattern SignedInt32 :: ImageChannelDataType
pattern $bSignedInt32 :: ImageChannelDataType
$mSignedInt32 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
SignedInt32 = ImageChannelDataType 9

pattern UnsignedInt8 :: ImageChannelDataType
pattern $bUnsignedInt8 :: ImageChannelDataType
$mUnsignedInt8 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnsignedInt8 = ImageChannelDataType 10

pattern UnsignedInt16 :: ImageChannelDataType
pattern $bUnsignedInt16 :: ImageChannelDataType
$mUnsignedInt16 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnsignedInt16 = ImageChannelDataType 11

pattern UnsignedInt32 :: ImageChannelDataType
pattern $bUnsignedInt32 :: ImageChannelDataType
$mUnsignedInt32 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnsignedInt32 = ImageChannelDataType 12

pattern HalfFloat :: ImageChannelDataType
pattern $bHalfFloat :: ImageChannelDataType
$mHalfFloat :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
HalfFloat = ImageChannelDataType 13

pattern Float :: ImageChannelDataType
pattern $bFloat :: ImageChannelDataType
$mFloat :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
Float = ImageChannelDataType 14

pattern UnormInt24 :: ImageChannelDataType
pattern $bUnormInt24 :: ImageChannelDataType
$mUnormInt24 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormInt24 = ImageChannelDataType 15

pattern UnormInt101010_2 :: ImageChannelDataType
pattern $bUnormInt101010_2 :: ImageChannelDataType
$mUnormInt101010_2 :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
UnormInt101010_2 = ImageChannelDataType 16

toName :: IsString a => ImageChannelDataType -> a
toName :: forall a. IsString a => ImageChannelDataType -> a
toName ImageChannelDataType
x = case ImageChannelDataType
x of
  ImageChannelDataType
SnormInt8 -> a
"SnormInt8"
  ImageChannelDataType
SnormInt16 -> a
"SnormInt16"
  ImageChannelDataType
UnormInt8 -> a
"UnormInt8"
  ImageChannelDataType
UnormInt16 -> a
"UnormInt16"
  ImageChannelDataType
UnormShort565 -> a
"UnormShort565"
  ImageChannelDataType
UnormShort555 -> a
"UnormShort555"
  ImageChannelDataType
UnormInt101010 -> a
"UnormInt101010"
  ImageChannelDataType
SignedInt8 -> a
"SignedInt8"
  ImageChannelDataType
SignedInt16 -> a
"SignedInt16"
  ImageChannelDataType
SignedInt32 -> a
"SignedInt32"
  ImageChannelDataType
UnsignedInt8 -> a
"UnsignedInt8"
  ImageChannelDataType
UnsignedInt16 -> a
"UnsignedInt16"
  ImageChannelDataType
UnsignedInt32 -> a
"UnsignedInt32"
  ImageChannelDataType
HalfFloat -> a
"HalfFloat"
  ImageChannelDataType
Float -> a
"Float"
  ImageChannelDataType
UnormInt24 -> a
"UnormInt24"
  ImageChannelDataType
UnormInt101010_2 -> a
"UnormInt101010_2"
  ImageChannelDataType
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"ImageChannelDataType " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ImageChannelDataType
unknown

instance Show ImageChannelDataType where
  show :: ImageChannelDataType -> [Char]
show = forall a. IsString a => ImageChannelDataType -> a
toName

fromName :: (IsString a, Eq a) => a -> Maybe ImageChannelDataType
fromName :: forall a. (IsString a, Eq a) => a -> Maybe ImageChannelDataType
fromName a
x = case a
x of
  a
"SnormInt8" -> forall a. a -> Maybe a
Just ImageChannelDataType
SnormInt8
  a
"SnormInt16" -> forall a. a -> Maybe a
Just ImageChannelDataType
SnormInt16
  a
"UnormInt8" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormInt8
  a
"UnormInt16" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormInt16
  a
"UnormShort565" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormShort565
  a
"UnormShort555" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormShort555
  a
"UnormInt101010" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormInt101010
  a
"SignedInt8" -> forall a. a -> Maybe a
Just ImageChannelDataType
SignedInt8
  a
"SignedInt16" -> forall a. a -> Maybe a
Just ImageChannelDataType
SignedInt16
  a
"SignedInt32" -> forall a. a -> Maybe a
Just ImageChannelDataType
SignedInt32
  a
"UnsignedInt8" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnsignedInt8
  a
"UnsignedInt16" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnsignedInt16
  a
"UnsignedInt32" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnsignedInt32
  a
"HalfFloat" -> forall a. a -> Maybe a
Just ImageChannelDataType
HalfFloat
  a
"Float" -> forall a. a -> Maybe a
Just ImageChannelDataType
Float
  a
"UnormInt24" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormInt24
  a
"UnormInt101010_2" -> forall a. a -> Maybe a
Just ImageChannelDataType
UnormInt101010_2
  a
_unknown -> forall a. Maybe a
Nothing

instance Read ImageChannelDataType where
  readPrec :: ReadPrec ImageChannelDataType
readPrec = forall a. ReadPrec a -> ReadPrec a
Read.parens do
    Lex.Ident [Char]
s <- ReadPrec Lexeme
Read.lexP
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (IsString a, Eq a) => a -> Maybe ImageChannelDataType
fromName [Char]
s