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

pattern None :: SamplerAddressingMode
pattern $bNone :: SamplerAddressingMode
$mNone :: forall {r}.
SamplerAddressingMode -> ((# #) -> r) -> ((# #) -> r) -> r
None = SamplerAddressingMode 0

pattern ClampToEdge :: SamplerAddressingMode
pattern $bClampToEdge :: SamplerAddressingMode
$mClampToEdge :: forall {r}.
SamplerAddressingMode -> ((# #) -> r) -> ((# #) -> r) -> r
ClampToEdge = SamplerAddressingMode 1

pattern Clamp :: SamplerAddressingMode
pattern $bClamp :: SamplerAddressingMode
$mClamp :: forall {r}.
SamplerAddressingMode -> ((# #) -> r) -> ((# #) -> r) -> r
Clamp = SamplerAddressingMode 2

pattern Repeat :: SamplerAddressingMode
pattern $bRepeat :: SamplerAddressingMode
$mRepeat :: forall {r}.
SamplerAddressingMode -> ((# #) -> r) -> ((# #) -> r) -> r
Repeat = SamplerAddressingMode 3

pattern RepeatMirrored :: SamplerAddressingMode
pattern $bRepeatMirrored :: SamplerAddressingMode
$mRepeatMirrored :: forall {r}.
SamplerAddressingMode -> ((# #) -> r) -> ((# #) -> r) -> r
RepeatMirrored = SamplerAddressingMode 4

toName :: IsString a => SamplerAddressingMode -> a
toName :: forall a. IsString a => SamplerAddressingMode -> a
toName SamplerAddressingMode
x = case SamplerAddressingMode
x of
  SamplerAddressingMode
None -> a
"None"
  SamplerAddressingMode
ClampToEdge -> a
"ClampToEdge"
  SamplerAddressingMode
Clamp -> a
"Clamp"
  SamplerAddressingMode
Repeat -> a
"Repeat"
  SamplerAddressingMode
RepeatMirrored -> a
"RepeatMirrored"
  SamplerAddressingMode
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"SamplerAddressingMode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SamplerAddressingMode
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe SamplerAddressingMode
fromName :: forall a. (IsString a, Eq a) => a -> Maybe SamplerAddressingMode
fromName a
x = case a
x of
  a
"None" -> forall a. a -> Maybe a
Just SamplerAddressingMode
None
  a
"ClampToEdge" -> forall a. a -> Maybe a
Just SamplerAddressingMode
ClampToEdge
  a
"Clamp" -> forall a. a -> Maybe a
Just SamplerAddressingMode
Clamp
  a
"Repeat" -> forall a. a -> Maybe a
Just SamplerAddressingMode
Repeat
  a
"RepeatMirrored" -> forall a. a -> Maybe a
Just SamplerAddressingMode
RepeatMirrored
  a
_unknown -> forall a. Maybe a
Nothing

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