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

pattern RayQueryCandidateIntersectionKHR :: RayQueryIntersection
pattern $bRayQueryCandidateIntersectionKHR :: RayQueryIntersection
$mRayQueryCandidateIntersectionKHR :: forall {r}.
RayQueryIntersection -> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCandidateIntersectionKHR = RayQueryIntersection 0

pattern RayQueryCommittedIntersectionKHR :: RayQueryIntersection
pattern $bRayQueryCommittedIntersectionKHR :: RayQueryIntersection
$mRayQueryCommittedIntersectionKHR :: forall {r}.
RayQueryIntersection -> ((# #) -> r) -> ((# #) -> r) -> r
RayQueryCommittedIntersectionKHR = RayQueryIntersection 1

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

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

fromName :: (IsString a, Eq a) => a -> Maybe RayQueryIntersection
fromName :: forall a. (IsString a, Eq a) => a -> Maybe RayQueryIntersection
fromName a
x = case a
x of
  a
"RayQueryCandidateIntersectionKHR" -> forall a. a -> Maybe a
Just RayQueryIntersection
RayQueryCandidateIntersectionKHR
  a
"RayQueryCommittedIntersectionKHR" -> forall a. a -> Maybe a
Just RayQueryIntersection
RayQueryCommittedIntersectionKHR
  a
_unknown -> forall a. Maybe a
Nothing

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