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

pattern RayQueryCandidateIntersectionTriangleKHR :: RayQueryCandidateIntersectionType
pattern $bRayQueryCandidateIntersectionTriangleKHR :: RayQueryCandidateIntersectionType
$mRayQueryCandidateIntersectionTriangleKHR :: forall {r}.
RayQueryCandidateIntersectionType
-> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCandidateIntersectionTriangleKHR = RayQueryCandidateIntersectionType 0

pattern RayQueryCandidateIntersectionAABBKHR :: RayQueryCandidateIntersectionType
pattern $bRayQueryCandidateIntersectionAABBKHR :: RayQueryCandidateIntersectionType
$mRayQueryCandidateIntersectionAABBKHR :: forall {r}.
RayQueryCandidateIntersectionType
-> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCandidateIntersectionAABBKHR = RayQueryCandidateIntersectionType 1

toName :: IsString a => RayQueryCandidateIntersectionType -> a
toName :: forall a. IsString a => RayQueryCandidateIntersectionType -> a
toName RayQueryCandidateIntersectionType
x = case RayQueryCandidateIntersectionType
x of
  RayQueryCandidateIntersectionType
RayQueryCandidateIntersectionTriangleKHR -> a
"RayQueryCandidateIntersectionTriangleKHR"
  RayQueryCandidateIntersectionType
RayQueryCandidateIntersectionAABBKHR -> a
"RayQueryCandidateIntersectionAABBKHR"
  RayQueryCandidateIntersectionType
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"RayQueryCandidateIntersectionType " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show RayQueryCandidateIntersectionType
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe RayQueryCandidateIntersectionType
fromName :: forall a.
(IsString a, Eq a) =>
a -> Maybe RayQueryCandidateIntersectionType
fromName a
x = case a
x of
  a
"RayQueryCandidateIntersectionTriangleKHR" -> forall a. a -> Maybe a
Just RayQueryCandidateIntersectionType
RayQueryCandidateIntersectionTriangleKHR
  a
"RayQueryCandidateIntersectionAABBKHR" -> forall a. a -> Maybe a
Just RayQueryCandidateIntersectionType
RayQueryCandidateIntersectionAABBKHR
  a
_unknown -> forall a. Maybe a
Nothing

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