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

module Data.SpirV.Enum.Scope where

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

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

instance Show Scope where
  showsPrec :: Int -> Scope -> ShowS
showsPrec Int
p (Scope Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"CrossDevice"
    Word32
1 -> String -> ShowS
showString String
"Device"
    Word32
2 -> String -> ShowS
showString String
"Workgroup"
    Word32
3 -> String -> ShowS
showString String
"Subgroup"
    Word32
4 -> String -> ShowS
showString String
"Invocation"
    Word32
5 -> String -> ShowS
showString String
"QueueFamily"
    Word32
6 -> String -> ShowS
showString String
"ShaderCallKHR"
    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
"Scope " 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 CrossDevice :: Scope
pattern $mCrossDevice :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bCrossDevice :: Scope
CrossDevice = Scope 0

pattern Device :: Scope
pattern $mDevice :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bDevice :: Scope
Device = Scope 1

pattern Workgroup :: Scope
pattern $mWorkgroup :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bWorkgroup :: Scope
Workgroup = Scope 2

pattern Subgroup :: Scope
pattern $mSubgroup :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bSubgroup :: Scope
Subgroup = Scope 3

pattern Invocation :: Scope
pattern $mInvocation :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bInvocation :: Scope
Invocation = Scope 4

pattern QueueFamily :: Scope
pattern $mQueueFamily :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bQueueFamily :: Scope
QueueFamily = Scope 5

pattern QueueFamilyKHR :: Scope
pattern $mQueueFamilyKHR :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bQueueFamilyKHR :: Scope
QueueFamilyKHR = Scope 5

pattern ShaderCallKHR :: Scope
pattern $mShaderCallKHR :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
$bShaderCallKHR :: Scope
ShaderCallKHR = Scope 6