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

module Data.SpirV.Enum.ExecutionModel where

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

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

instance Show ExecutionModel where
  showsPrec :: Int -> ExecutionModel -> ShowS
showsPrec Int
p (ExecutionModel Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"Vertex"
    Word32
1 -> String -> ShowS
showString String
"TessellationControl"
    Word32
2 -> String -> ShowS
showString String
"TessellationEvaluation"
    Word32
3 -> String -> ShowS
showString String
"Geometry"
    Word32
4 -> String -> ShowS
showString String
"Fragment"
    Word32
5 -> String -> ShowS
showString String
"GLCompute"
    Word32
6 -> String -> ShowS
showString String
"Kernel"
    Word32
5267 -> String -> ShowS
showString String
"TaskNV"
    Word32
5268 -> String -> ShowS
showString String
"MeshNV"
    Word32
5313 -> String -> ShowS
showString String
"RayGenerationKHR"
    Word32
5314 -> String -> ShowS
showString String
"IntersectionKHR"
    Word32
5315 -> String -> ShowS
showString String
"AnyHitKHR"
    Word32
5316 -> String -> ShowS
showString String
"ClosestHitKHR"
    Word32
5317 -> String -> ShowS
showString String
"MissKHR"
    Word32
5318 -> String -> ShowS
showString String
"CallableKHR"
    Word32
5364 -> String -> ShowS
showString String
"TaskEXT"
    Word32
5365 -> String -> ShowS
showString String
"MeshEXT"
    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
"ExecutionModel " 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 Vertex :: ExecutionModel
pattern $mVertex :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bVertex :: ExecutionModel
Vertex = ExecutionModel 0

pattern TessellationControl :: ExecutionModel
pattern $mTessellationControl :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bTessellationControl :: ExecutionModel
TessellationControl = ExecutionModel 1

pattern TessellationEvaluation :: ExecutionModel
pattern $mTessellationEvaluation :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bTessellationEvaluation :: ExecutionModel
TessellationEvaluation = ExecutionModel 2

pattern Geometry :: ExecutionModel
pattern $mGeometry :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bGeometry :: ExecutionModel
Geometry = ExecutionModel 3

pattern Fragment :: ExecutionModel
pattern $mFragment :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bFragment :: ExecutionModel
Fragment = ExecutionModel 4

pattern GLCompute :: ExecutionModel
pattern $mGLCompute :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bGLCompute :: ExecutionModel
GLCompute = ExecutionModel 5

pattern Kernel :: ExecutionModel
pattern $mKernel :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bKernel :: ExecutionModel
Kernel = ExecutionModel 6

pattern TaskNV :: ExecutionModel
pattern $mTaskNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bTaskNV :: ExecutionModel
TaskNV = ExecutionModel 5267

pattern MeshNV :: ExecutionModel
pattern $mMeshNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bMeshNV :: ExecutionModel
MeshNV = ExecutionModel 5268

pattern RayGenerationKHR :: ExecutionModel
pattern $mRayGenerationKHR :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bRayGenerationKHR :: ExecutionModel
RayGenerationKHR = ExecutionModel 5313

pattern RayGenerationNV :: ExecutionModel
pattern $mRayGenerationNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bRayGenerationNV :: ExecutionModel
RayGenerationNV = ExecutionModel 5313

pattern IntersectionKHR :: ExecutionModel
pattern $mIntersectionKHR :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bIntersectionKHR :: ExecutionModel
IntersectionKHR = ExecutionModel 5314

pattern IntersectionNV :: ExecutionModel
pattern $mIntersectionNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bIntersectionNV :: ExecutionModel
IntersectionNV = ExecutionModel 5314

pattern AnyHitKHR :: ExecutionModel
pattern $mAnyHitKHR :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bAnyHitKHR :: ExecutionModel
AnyHitKHR = ExecutionModel 5315

pattern AnyHitNV :: ExecutionModel
pattern $mAnyHitNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bAnyHitNV :: ExecutionModel
AnyHitNV = ExecutionModel 5315

pattern ClosestHitKHR :: ExecutionModel
pattern $mClosestHitKHR :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bClosestHitKHR :: ExecutionModel
ClosestHitKHR = ExecutionModel 5316

pattern ClosestHitNV :: ExecutionModel
pattern $mClosestHitNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bClosestHitNV :: ExecutionModel
ClosestHitNV = ExecutionModel 5316

pattern MissKHR :: ExecutionModel
pattern $mMissKHR :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bMissKHR :: ExecutionModel
MissKHR = ExecutionModel 5317

pattern MissNV :: ExecutionModel
pattern $mMissNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bMissNV :: ExecutionModel
MissNV = ExecutionModel 5317

pattern CallableKHR :: ExecutionModel
pattern $mCallableKHR :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bCallableKHR :: ExecutionModel
CallableKHR = ExecutionModel 5318

pattern CallableNV :: ExecutionModel
pattern $mCallableNV :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bCallableNV :: ExecutionModel
CallableNV = ExecutionModel 5318

pattern TaskEXT :: ExecutionModel
pattern $mTaskEXT :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bTaskEXT :: ExecutionModel
TaskEXT = ExecutionModel 5364

pattern MeshEXT :: ExecutionModel
pattern $mMeshEXT :: forall {r}. ExecutionModel -> ((# #) -> r) -> ((# #) -> r) -> r
$bMeshEXT :: ExecutionModel
MeshEXT = ExecutionModel 5365