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

pattern CrossDevice :: Scope
pattern $bCrossDevice :: Scope
$mCrossDevice :: forall {r}. Scope -> ((# #) -> r) -> ((# #) -> r) -> r
CrossDevice = Scope 0

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

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

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

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

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

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

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

toName :: IsString a => Scope -> a
toName :: forall a. IsString a => Scope -> a
toName Scope
x = case Scope
x of
  Scope
CrossDevice -> a
"CrossDevice"
  Scope
Device -> a
"Device"
  Scope
Workgroup -> a
"Workgroup"
  Scope
Subgroup -> a
"Subgroup"
  Scope
Invocation -> a
"Invocation"
  Scope
QueueFamily -> a
"QueueFamily"
  Scope
QueueFamilyKHR -> a
"QueueFamilyKHR"
  Scope
ShaderCallKHR -> a
"ShaderCallKHR"
  Scope
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"Scope " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Scope
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe Scope
fromName :: forall a. (IsString a, Eq a) => a -> Maybe Scope
fromName a
x = case a
x of
  a
"CrossDevice" -> forall a. a -> Maybe a
Just Scope
CrossDevice
  a
"Device" -> forall a. a -> Maybe a
Just Scope
Device
  a
"Workgroup" -> forall a. a -> Maybe a
Just Scope
Workgroup
  a
"Subgroup" -> forall a. a -> Maybe a
Just Scope
Subgroup
  a
"Invocation" -> forall a. a -> Maybe a
Just Scope
Invocation
  a
"QueueFamily" -> forall a. a -> Maybe a
Just Scope
QueueFamily
  a
"QueueFamilyKHR" -> forall a. a -> Maybe a
Just Scope
QueueFamilyKHR
  a
"ShaderCallKHR" -> forall a. a -> Maybe a
Just Scope
ShaderCallKHR
  a
_unknown -> forall a. Maybe a
Nothing

instance Read Scope where
  readPrec :: ReadPrec Scope
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 Scope
fromName [Char]
s