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

pattern Reduce :: GroupOperation
pattern $bReduce :: GroupOperation
$mReduce :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
Reduce = GroupOperation 0

pattern InclusiveScan :: GroupOperation
pattern $bInclusiveScan :: GroupOperation
$mInclusiveScan :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
InclusiveScan = GroupOperation 1

pattern ExclusiveScan :: GroupOperation
pattern $bExclusiveScan :: GroupOperation
$mExclusiveScan :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
ExclusiveScan = GroupOperation 2

pattern ClusteredReduce :: GroupOperation
pattern $bClusteredReduce :: GroupOperation
$mClusteredReduce :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
ClusteredReduce = GroupOperation 3

pattern PartitionedReduceNV :: GroupOperation
pattern $bPartitionedReduceNV :: GroupOperation
$mPartitionedReduceNV :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
PartitionedReduceNV = GroupOperation 6

pattern PartitionedInclusiveScanNV :: GroupOperation
pattern $bPartitionedInclusiveScanNV :: GroupOperation
$mPartitionedInclusiveScanNV :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
PartitionedInclusiveScanNV = GroupOperation 7

pattern PartitionedExclusiveScanNV :: GroupOperation
pattern $bPartitionedExclusiveScanNV :: GroupOperation
$mPartitionedExclusiveScanNV :: forall {r}. GroupOperation -> ((# #) -> r) -> ((# #) -> r) -> r
PartitionedExclusiveScanNV = GroupOperation 8

toName :: IsString a => GroupOperation -> a
toName :: forall a. IsString a => GroupOperation -> a
toName GroupOperation
x = case GroupOperation
x of
  GroupOperation
Reduce -> a
"Reduce"
  GroupOperation
InclusiveScan -> a
"InclusiveScan"
  GroupOperation
ExclusiveScan -> a
"ExclusiveScan"
  GroupOperation
ClusteredReduce -> a
"ClusteredReduce"
  GroupOperation
PartitionedReduceNV -> a
"PartitionedReduceNV"
  GroupOperation
PartitionedInclusiveScanNV -> a
"PartitionedInclusiveScanNV"
  GroupOperation
PartitionedExclusiveScanNV -> a
"PartitionedExclusiveScanNV"
  GroupOperation
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"GroupOperation " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show GroupOperation
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe GroupOperation
fromName :: forall a. (IsString a, Eq a) => a -> Maybe GroupOperation
fromName a
x = case a
x of
  a
"Reduce" -> forall a. a -> Maybe a
Just GroupOperation
Reduce
  a
"InclusiveScan" -> forall a. a -> Maybe a
Just GroupOperation
InclusiveScan
  a
"ExclusiveScan" -> forall a. a -> Maybe a
Just GroupOperation
ExclusiveScan
  a
"ClusteredReduce" -> forall a. a -> Maybe a
Just GroupOperation
ClusteredReduce
  a
"PartitionedReduceNV" -> forall a. a -> Maybe a
Just GroupOperation
PartitionedReduceNV
  a
"PartitionedInclusiveScanNV" -> forall a. a -> Maybe a
Just GroupOperation
PartitionedInclusiveScanNV
  a
"PartitionedExclusiveScanNV" -> forall a. a -> Maybe a
Just GroupOperation
PartitionedExclusiveScanNV
  a
_unknown -> forall a. Maybe a
Nothing

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