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

pattern RayQueryCommittedIntersectionNoneKHR :: RayQueryCommittedIntersectionType
pattern $bRayQueryCommittedIntersectionNoneKHR :: RayQueryCommittedIntersectionType
$mRayQueryCommittedIntersectionNoneKHR :: forall {r}.
RayQueryCommittedIntersectionType
-> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCommittedIntersectionNoneKHR = RayQueryCommittedIntersectionType 0

pattern RayQueryCommittedIntersectionTriangleKHR :: RayQueryCommittedIntersectionType
pattern $bRayQueryCommittedIntersectionTriangleKHR :: RayQueryCommittedIntersectionType
$mRayQueryCommittedIntersectionTriangleKHR :: forall {r}.
RayQueryCommittedIntersectionType
-> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCommittedIntersectionTriangleKHR = RayQueryCommittedIntersectionType 1

pattern RayQueryCommittedIntersectionGeneratedKHR :: RayQueryCommittedIntersectionType
pattern $bRayQueryCommittedIntersectionGeneratedKHR :: RayQueryCommittedIntersectionType
$mRayQueryCommittedIntersectionGeneratedKHR :: forall {r}.
RayQueryCommittedIntersectionType
-> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCommittedIntersectionGeneratedKHR = RayQueryCommittedIntersectionType 2

toName :: IsString a => RayQueryCommittedIntersectionType -> a
toName :: forall a. IsString a => RayQueryCommittedIntersectionType -> a
toName RayQueryCommittedIntersectionType
x = case RayQueryCommittedIntersectionType
x of
  RayQueryCommittedIntersectionType
RayQueryCommittedIntersectionNoneKHR -> a
"RayQueryCommittedIntersectionNoneKHR"
  RayQueryCommittedIntersectionType
RayQueryCommittedIntersectionTriangleKHR -> a
"RayQueryCommittedIntersectionTriangleKHR"
  RayQueryCommittedIntersectionType
RayQueryCommittedIntersectionGeneratedKHR -> a
"RayQueryCommittedIntersectionGeneratedKHR"
  RayQueryCommittedIntersectionType
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"RayQueryCommittedIntersectionType " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show RayQueryCommittedIntersectionType
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe RayQueryCommittedIntersectionType
fromName :: forall a.
(IsString a, Eq a) =>
a -> Maybe RayQueryCommittedIntersectionType
fromName a
x = case a
x of
  a
"RayQueryCommittedIntersectionNoneKHR" -> forall a. a -> Maybe a
Just RayQueryCommittedIntersectionType
RayQueryCommittedIntersectionNoneKHR
  a
"RayQueryCommittedIntersectionTriangleKHR" -> forall a. a -> Maybe a
Just RayQueryCommittedIntersectionType
RayQueryCommittedIntersectionTriangleKHR
  a
"RayQueryCommittedIntersectionGeneratedKHR" -> forall a. a -> Maybe a
Just RayQueryCommittedIntersectionType
RayQueryCommittedIntersectionGeneratedKHR
  a
_unknown -> forall a. Maybe a
Nothing

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