{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.SpirV.Enum.GroupOperation where

import Data.Word (Word32)
import Foreign.Storable (Storable)

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

instance Show GroupOperation where
  showsPrec :: Int -> GroupOperation -> ShowS
showsPrec Int
p (GroupOperation Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"Reduce"
    Word32
1 -> String -> ShowS
showString String
"InclusiveScan"
    Word32
2 -> String -> ShowS
showString String
"ExclusiveScan"
    Word32
3 -> String -> ShowS
showString String
"ClusteredReduce"
    Word32
6 -> String -> ShowS
showString String
"PartitionedReduceNV"
    Word32
7 -> String -> ShowS
showString String
"PartitionedInclusiveScanNV"
    Word32
8 -> String -> ShowS
showString String
"PartitionedExclusiveScanNV"
    Word32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"GroupOperation " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
x

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

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

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

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

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

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

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