module Data.SpirV.Enum.SelectionControl where

import Data.Bits (Bits)
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 SelectionControl = SelectionControl Word32
  deriving (SelectionControl -> SelectionControl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionControl -> SelectionControl -> Bool
$c/= :: SelectionControl -> SelectionControl -> Bool
== :: SelectionControl -> SelectionControl -> Bool
$c== :: SelectionControl -> SelectionControl -> Bool
Eq, Eq SelectionControl
SelectionControl -> SelectionControl -> Bool
SelectionControl -> SelectionControl -> Ordering
SelectionControl -> SelectionControl -> SelectionControl
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 :: SelectionControl -> SelectionControl -> SelectionControl
$cmin :: SelectionControl -> SelectionControl -> SelectionControl
max :: SelectionControl -> SelectionControl -> SelectionControl
$cmax :: SelectionControl -> SelectionControl -> SelectionControl
>= :: SelectionControl -> SelectionControl -> Bool
$c>= :: SelectionControl -> SelectionControl -> Bool
> :: SelectionControl -> SelectionControl -> Bool
$c> :: SelectionControl -> SelectionControl -> Bool
<= :: SelectionControl -> SelectionControl -> Bool
$c<= :: SelectionControl -> SelectionControl -> Bool
< :: SelectionControl -> SelectionControl -> Bool
$c< :: SelectionControl -> SelectionControl -> Bool
compare :: SelectionControl -> SelectionControl -> Ordering
$ccompare :: SelectionControl -> SelectionControl -> Ordering
Ord, Ptr SelectionControl -> IO SelectionControl
Ptr SelectionControl -> Int -> IO SelectionControl
Ptr SelectionControl -> Int -> SelectionControl -> IO ()
Ptr SelectionControl -> SelectionControl -> IO ()
SelectionControl -> Int
forall b. Ptr b -> Int -> IO SelectionControl
forall b. Ptr b -> Int -> SelectionControl -> 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 SelectionControl -> SelectionControl -> IO ()
$cpoke :: Ptr SelectionControl -> SelectionControl -> IO ()
peek :: Ptr SelectionControl -> IO SelectionControl
$cpeek :: Ptr SelectionControl -> IO SelectionControl
pokeByteOff :: forall b. Ptr b -> Int -> SelectionControl -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> SelectionControl -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO SelectionControl
$cpeekByteOff :: forall b. Ptr b -> Int -> IO SelectionControl
pokeElemOff :: Ptr SelectionControl -> Int -> SelectionControl -> IO ()
$cpokeElemOff :: Ptr SelectionControl -> Int -> SelectionControl -> IO ()
peekElemOff :: Ptr SelectionControl -> Int -> IO SelectionControl
$cpeekElemOff :: Ptr SelectionControl -> Int -> IO SelectionControl
alignment :: SelectionControl -> Int
$calignment :: SelectionControl -> Int
sizeOf :: SelectionControl -> Int
$csizeOf :: SelectionControl -> Int
Storable, Eq SelectionControl
SelectionControl
Int -> SelectionControl
SelectionControl -> Bool
SelectionControl -> Int
SelectionControl -> Maybe Int
SelectionControl -> SelectionControl
SelectionControl -> Int -> Bool
SelectionControl -> Int -> SelectionControl
SelectionControl -> SelectionControl -> SelectionControl
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: SelectionControl -> Int
$cpopCount :: SelectionControl -> Int
rotateR :: SelectionControl -> Int -> SelectionControl
$crotateR :: SelectionControl -> Int -> SelectionControl
rotateL :: SelectionControl -> Int -> SelectionControl
$crotateL :: SelectionControl -> Int -> SelectionControl
unsafeShiftR :: SelectionControl -> Int -> SelectionControl
$cunsafeShiftR :: SelectionControl -> Int -> SelectionControl
shiftR :: SelectionControl -> Int -> SelectionControl
$cshiftR :: SelectionControl -> Int -> SelectionControl
unsafeShiftL :: SelectionControl -> Int -> SelectionControl
$cunsafeShiftL :: SelectionControl -> Int -> SelectionControl
shiftL :: SelectionControl -> Int -> SelectionControl
$cshiftL :: SelectionControl -> Int -> SelectionControl
isSigned :: SelectionControl -> Bool
$cisSigned :: SelectionControl -> Bool
bitSize :: SelectionControl -> Int
$cbitSize :: SelectionControl -> Int
bitSizeMaybe :: SelectionControl -> Maybe Int
$cbitSizeMaybe :: SelectionControl -> Maybe Int
testBit :: SelectionControl -> Int -> Bool
$ctestBit :: SelectionControl -> Int -> Bool
complementBit :: SelectionControl -> Int -> SelectionControl
$ccomplementBit :: SelectionControl -> Int -> SelectionControl
clearBit :: SelectionControl -> Int -> SelectionControl
$cclearBit :: SelectionControl -> Int -> SelectionControl
setBit :: SelectionControl -> Int -> SelectionControl
$csetBit :: SelectionControl -> Int -> SelectionControl
bit :: Int -> SelectionControl
$cbit :: Int -> SelectionControl
zeroBits :: SelectionControl
$czeroBits :: SelectionControl
rotate :: SelectionControl -> Int -> SelectionControl
$crotate :: SelectionControl -> Int -> SelectionControl
shift :: SelectionControl -> Int -> SelectionControl
$cshift :: SelectionControl -> Int -> SelectionControl
complement :: SelectionControl -> SelectionControl
$ccomplement :: SelectionControl -> SelectionControl
xor :: SelectionControl -> SelectionControl -> SelectionControl
$cxor :: SelectionControl -> SelectionControl -> SelectionControl
.|. :: SelectionControl -> SelectionControl -> SelectionControl
$c.|. :: SelectionControl -> SelectionControl -> SelectionControl
.&. :: SelectionControl -> SelectionControl -> SelectionControl
$c.&. :: SelectionControl -> SelectionControl -> SelectionControl
Bits)

pattern Flatten :: SelectionControl
pattern $bFlatten :: SelectionControl
$mFlatten :: forall {r}. SelectionControl -> ((# #) -> r) -> ((# #) -> r) -> r
Flatten = SelectionControl 0x1

pattern DontFlatten :: SelectionControl
pattern $bDontFlatten :: SelectionControl
$mDontFlatten :: forall {r}. SelectionControl -> ((# #) -> r) -> ((# #) -> r) -> r
DontFlatten = SelectionControl 0x2

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

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

fromName :: (IsString a, Eq a) => a -> Maybe SelectionControl
fromName :: forall a. (IsString a, Eq a) => a -> Maybe SelectionControl
fromName a
x = case a
x of
  a
"Flatten" -> forall a. a -> Maybe a
Just SelectionControl
Flatten
  a
"DontFlatten" -> forall a. a -> Maybe a
Just SelectionControl
DontFlatten
  a
_unknown -> forall a. Maybe a
Nothing

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