{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.SpirV.Enum.ImageChannelDataType where

import Data.Word (Word32)
import Foreign.Storable (Storable)

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

instance Show ImageChannelDataType where
  showsPrec :: Int -> ImageChannelDataType -> ShowS
showsPrec Int
p (ImageChannelDataType Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"SnormInt8"
    Word32
1 -> String -> ShowS
showString String
"SnormInt16"
    Word32
2 -> String -> ShowS
showString String
"UnormInt8"
    Word32
3 -> String -> ShowS
showString String
"UnormInt16"
    Word32
4 -> String -> ShowS
showString String
"UnormShort565"
    Word32
5 -> String -> ShowS
showString String
"UnormShort555"
    Word32
6 -> String -> ShowS
showString String
"UnormInt101010"
    Word32
7 -> String -> ShowS
showString String
"SignedInt8"
    Word32
8 -> String -> ShowS
showString String
"SignedInt16"
    Word32
9 -> String -> ShowS
showString String
"SignedInt32"
    Word32
10 -> String -> ShowS
showString String
"UnsignedInt8"
    Word32
11 -> String -> ShowS
showString String
"UnsignedInt16"
    Word32
12 -> String -> ShowS
showString String
"UnsignedInt32"
    Word32
13 -> String -> ShowS
showString String
"HalfFloat"
    Word32
14 -> String -> ShowS
showString String
"Float"
    Word32
15 -> String -> ShowS
showString String
"UnormInt24"
    Word32
16 -> String -> ShowS
showString String
"UnormInt101010_2"
    Word32
19 -> String -> ShowS
showString String
"UnsignedIntRaw10EXT"
    Word32
20 -> String -> ShowS
showString String
"UnsignedIntRaw12EXT"
    Word32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ImageChannelDataType " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
x

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

pattern UnsignedIntRaw10EXT :: ImageChannelDataType
pattern $mUnsignedIntRaw10EXT :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsignedIntRaw10EXT :: ImageChannelDataType
UnsignedIntRaw10EXT = ImageChannelDataType 19

pattern UnsignedIntRaw12EXT :: ImageChannelDataType
pattern $mUnsignedIntRaw12EXT :: forall {r}.
ImageChannelDataType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsignedIntRaw12EXT :: ImageChannelDataType
UnsignedIntRaw12EXT = ImageChannelDataType 20