module Data.SpirV.Reflect.Enums.TypeFlags where

import Control.Monad (guard)

import Data.SpirV.Reflect.Enums.Common

type TypeFlags = TypeFlagBits

newtype TypeFlagBits = TypeFlagBits Flags
  deriving newtype (TypeFlagBits -> TypeFlagBits -> Bool
(TypeFlagBits -> TypeFlagBits -> Bool)
-> (TypeFlagBits -> TypeFlagBits -> Bool) -> Eq TypeFlagBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeFlagBits -> TypeFlagBits -> Bool
== :: TypeFlagBits -> TypeFlagBits -> Bool
$c/= :: TypeFlagBits -> TypeFlagBits -> Bool
/= :: TypeFlagBits -> TypeFlagBits -> Bool
Eq, Eq TypeFlagBits
Eq TypeFlagBits =>
(TypeFlagBits -> TypeFlagBits -> Ordering)
-> (TypeFlagBits -> TypeFlagBits -> Bool)
-> (TypeFlagBits -> TypeFlagBits -> Bool)
-> (TypeFlagBits -> TypeFlagBits -> Bool)
-> (TypeFlagBits -> TypeFlagBits -> Bool)
-> (TypeFlagBits -> TypeFlagBits -> TypeFlagBits)
-> (TypeFlagBits -> TypeFlagBits -> TypeFlagBits)
-> Ord TypeFlagBits
TypeFlagBits -> TypeFlagBits -> Bool
TypeFlagBits -> TypeFlagBits -> Ordering
TypeFlagBits -> TypeFlagBits -> TypeFlagBits
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 :: TypeFlagBits -> TypeFlagBits -> Ordering
compare :: TypeFlagBits -> TypeFlagBits -> Ordering
$c< :: TypeFlagBits -> TypeFlagBits -> Bool
< :: TypeFlagBits -> TypeFlagBits -> Bool
$c<= :: TypeFlagBits -> TypeFlagBits -> Bool
<= :: TypeFlagBits -> TypeFlagBits -> Bool
$c> :: TypeFlagBits -> TypeFlagBits -> Bool
> :: TypeFlagBits -> TypeFlagBits -> Bool
$c>= :: TypeFlagBits -> TypeFlagBits -> Bool
>= :: TypeFlagBits -> TypeFlagBits -> Bool
$cmax :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
max :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
$cmin :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
min :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
Ord, Int -> TypeFlagBits -> ShowS
[TypeFlagBits] -> ShowS
TypeFlagBits -> String
(Int -> TypeFlagBits -> ShowS)
-> (TypeFlagBits -> String)
-> ([TypeFlagBits] -> ShowS)
-> Show TypeFlagBits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeFlagBits -> ShowS
showsPrec :: Int -> TypeFlagBits -> ShowS
$cshow :: TypeFlagBits -> String
show :: TypeFlagBits -> String
$cshowList :: [TypeFlagBits] -> ShowS
showList :: [TypeFlagBits] -> ShowS
Show, Eq TypeFlagBits
TypeFlagBits
Eq TypeFlagBits =>
(TypeFlagBits -> TypeFlagBits -> TypeFlagBits)
-> (TypeFlagBits -> TypeFlagBits -> TypeFlagBits)
-> (TypeFlagBits -> TypeFlagBits -> TypeFlagBits)
-> (TypeFlagBits -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> TypeFlagBits
-> (Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> Bool)
-> (TypeFlagBits -> Maybe Int)
-> (TypeFlagBits -> Int)
-> (TypeFlagBits -> Bool)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int -> TypeFlagBits)
-> (TypeFlagBits -> Int)
-> Bits TypeFlagBits
Int -> TypeFlagBits
TypeFlagBits -> Bool
TypeFlagBits -> Int
TypeFlagBits -> Maybe Int
TypeFlagBits -> TypeFlagBits
TypeFlagBits -> Int -> Bool
TypeFlagBits -> Int -> TypeFlagBits
TypeFlagBits -> TypeFlagBits -> TypeFlagBits
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
$c.&. :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
.&. :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
$c.|. :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
.|. :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
$cxor :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
xor :: TypeFlagBits -> TypeFlagBits -> TypeFlagBits
$ccomplement :: TypeFlagBits -> TypeFlagBits
complement :: TypeFlagBits -> TypeFlagBits
$cshift :: TypeFlagBits -> Int -> TypeFlagBits
shift :: TypeFlagBits -> Int -> TypeFlagBits
$crotate :: TypeFlagBits -> Int -> TypeFlagBits
rotate :: TypeFlagBits -> Int -> TypeFlagBits
$czeroBits :: TypeFlagBits
zeroBits :: TypeFlagBits
$cbit :: Int -> TypeFlagBits
bit :: Int -> TypeFlagBits
$csetBit :: TypeFlagBits -> Int -> TypeFlagBits
setBit :: TypeFlagBits -> Int -> TypeFlagBits
$cclearBit :: TypeFlagBits -> Int -> TypeFlagBits
clearBit :: TypeFlagBits -> Int -> TypeFlagBits
$ccomplementBit :: TypeFlagBits -> Int -> TypeFlagBits
complementBit :: TypeFlagBits -> Int -> TypeFlagBits
$ctestBit :: TypeFlagBits -> Int -> Bool
testBit :: TypeFlagBits -> Int -> Bool
$cbitSizeMaybe :: TypeFlagBits -> Maybe Int
bitSizeMaybe :: TypeFlagBits -> Maybe Int
$cbitSize :: TypeFlagBits -> Int
bitSize :: TypeFlagBits -> Int
$cisSigned :: TypeFlagBits -> Bool
isSigned :: TypeFlagBits -> Bool
$cshiftL :: TypeFlagBits -> Int -> TypeFlagBits
shiftL :: TypeFlagBits -> Int -> TypeFlagBits
$cunsafeShiftL :: TypeFlagBits -> Int -> TypeFlagBits
unsafeShiftL :: TypeFlagBits -> Int -> TypeFlagBits
$cshiftR :: TypeFlagBits -> Int -> TypeFlagBits
shiftR :: TypeFlagBits -> Int -> TypeFlagBits
$cunsafeShiftR :: TypeFlagBits -> Int -> TypeFlagBits
unsafeShiftR :: TypeFlagBits -> Int -> TypeFlagBits
$crotateL :: TypeFlagBits -> Int -> TypeFlagBits
rotateL :: TypeFlagBits -> Int -> TypeFlagBits
$crotateR :: TypeFlagBits -> Int -> TypeFlagBits
rotateR :: TypeFlagBits -> Int -> TypeFlagBits
$cpopCount :: TypeFlagBits -> Int
popCount :: TypeFlagBits -> Int
Bits, Bits TypeFlagBits
Bits TypeFlagBits =>
(TypeFlagBits -> Int)
-> (TypeFlagBits -> Int)
-> (TypeFlagBits -> Int)
-> FiniteBits TypeFlagBits
TypeFlagBits -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: TypeFlagBits -> Int
finiteBitSize :: TypeFlagBits -> Int
$ccountLeadingZeros :: TypeFlagBits -> Int
countLeadingZeros :: TypeFlagBits -> Int
$ccountTrailingZeros :: TypeFlagBits -> Int
countTrailingZeros :: TypeFlagBits -> Int
FiniteBits)

pattern TYPE_FLAG_UNDEFINED :: TypeFlagBits
pattern $mTYPE_FLAG_UNDEFINED :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_UNDEFINED :: TypeFlagBits
TYPE_FLAG_UNDEFINED = TypeFlagBits 0x00000000

pattern TYPE_FLAG_VOID :: TypeFlagBits
pattern $mTYPE_FLAG_VOID :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_VOID :: TypeFlagBits
TYPE_FLAG_VOID = TypeFlagBits 0x00000001

pattern TYPE_FLAG_BOOL :: TypeFlagBits
pattern $mTYPE_FLAG_BOOL :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_BOOL :: TypeFlagBits
TYPE_FLAG_BOOL = TypeFlagBits 0x00000002

pattern TYPE_FLAG_INT :: TypeFlagBits
pattern $mTYPE_FLAG_INT :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_INT :: TypeFlagBits
TYPE_FLAG_INT = TypeFlagBits 0x00000004

pattern TYPE_FLAG_FLOAT :: TypeFlagBits
pattern $mTYPE_FLAG_FLOAT :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_FLOAT :: TypeFlagBits
TYPE_FLAG_FLOAT = TypeFlagBits 0x00000008

pattern TYPE_FLAG_VECTOR :: TypeFlagBits
pattern $mTYPE_FLAG_VECTOR :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_VECTOR :: TypeFlagBits
TYPE_FLAG_VECTOR = TypeFlagBits 0x00000100

pattern TYPE_FLAG_MATRIX :: TypeFlagBits
pattern $mTYPE_FLAG_MATRIX :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_MATRIX :: TypeFlagBits
TYPE_FLAG_MATRIX = TypeFlagBits 0x00000200

pattern TYPE_FLAG_EXTERNAL_IMAGE :: TypeFlagBits
pattern $mTYPE_FLAG_EXTERNAL_IMAGE :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_EXTERNAL_IMAGE :: TypeFlagBits
TYPE_FLAG_EXTERNAL_IMAGE = TypeFlagBits 0x00010000

pattern TYPE_FLAG_EXTERNAL_SAMPLER :: TypeFlagBits
pattern $mTYPE_FLAG_EXTERNAL_SAMPLER :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_EXTERNAL_SAMPLER :: TypeFlagBits
TYPE_FLAG_EXTERNAL_SAMPLER = TypeFlagBits 0x00020000

pattern TYPE_FLAG_EXTERNAL_SAMPLED_IMAGE :: TypeFlagBits
pattern $mTYPE_FLAG_EXTERNAL_SAMPLED_IMAGE :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_EXTERNAL_SAMPLED_IMAGE :: TypeFlagBits
TYPE_FLAG_EXTERNAL_SAMPLED_IMAGE = TypeFlagBits 0x00040000

pattern TYPE_FLAG_EXTERNAL_BLOCK :: TypeFlagBits
pattern $mTYPE_FLAG_EXTERNAL_BLOCK :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_EXTERNAL_BLOCK :: TypeFlagBits
TYPE_FLAG_EXTERNAL_BLOCK = TypeFlagBits 0x00080000

pattern TYPE_FLAG_EXTERNAL_ACCELERATION_STRUCTURE :: TypeFlagBits
pattern $mTYPE_FLAG_EXTERNAL_ACCELERATION_STRUCTURE :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_EXTERNAL_ACCELERATION_STRUCTURE :: TypeFlagBits
TYPE_FLAG_EXTERNAL_ACCELERATION_STRUCTURE = TypeFlagBits 0x00100000

pattern TYPE_FLAG_EXTERNAL_MASK :: TypeFlagBits
pattern $mTYPE_FLAG_EXTERNAL_MASK :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_EXTERNAL_MASK :: TypeFlagBits
TYPE_FLAG_EXTERNAL_MASK = TypeFlagBits 0x00FF0000

pattern TYPE_FLAG_STRUCT :: TypeFlagBits
pattern $mTYPE_FLAG_STRUCT :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_STRUCT :: TypeFlagBits
TYPE_FLAG_STRUCT = TypeFlagBits 0x10000000

pattern TYPE_FLAG_ARRAY :: TypeFlagBits
pattern $mTYPE_FLAG_ARRAY :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_ARRAY :: TypeFlagBits
TYPE_FLAG_ARRAY = TypeFlagBits 0x20000000

pattern TYPE_FLAG_REF :: TypeFlagBits
pattern $mTYPE_FLAG_REF :: forall {r}. TypeFlagBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_REF :: TypeFlagBits
TYPE_FLAG_REF = TypeFlagBits 0x40000000

typeFlagBitNames :: IsString label => [(TypeFlagBits, label)]
typeFlagBitNames :: forall label. IsString label => [(TypeFlagBits, label)]
typeFlagBitNames =
  [ (TypeFlagBits
TYPE_FLAG_UNDEFINED, label
"UNDEFINED")
  , (TypeFlagBits
TYPE_FLAG_VOID, label
"VOID")
  , (TypeFlagBits
TYPE_FLAG_BOOL, label
"BOOL")
  , (TypeFlagBits
TYPE_FLAG_INT, label
"INT")
  , (TypeFlagBits
TYPE_FLAG_FLOAT, label
"FLOAT")
  , (TypeFlagBits
TYPE_FLAG_VECTOR, label
"VECTOR")
  , (TypeFlagBits
TYPE_FLAG_MATRIX, label
"MATRIX")
  , (TypeFlagBits
TYPE_FLAG_EXTERNAL_IMAGE, label
"EXTERNAL_IMAGE")
  , (TypeFlagBits
TYPE_FLAG_EXTERNAL_SAMPLER, label
"EXTERNAL_SAMPLER")
  , (TypeFlagBits
TYPE_FLAG_EXTERNAL_SAMPLED_IMAGE, label
"EXTERNAL_SAMPLED_IMAGE")
  , (TypeFlagBits
TYPE_FLAG_EXTERNAL_BLOCK, label
"EXTERNAL_BLOCK")
  , (TypeFlagBits
TYPE_FLAG_EXTERNAL_ACCELERATION_STRUCTURE, label
"EXTERNAL_ACCELERATION_STRUCTURE")
  , (TypeFlagBits
TYPE_FLAG_EXTERNAL_MASK, label
"EXTERNAL_MASK")
  , (TypeFlagBits
TYPE_FLAG_STRUCT, label
"STRUCT")
  , (TypeFlagBits
TYPE_FLAG_ARRAY, label
"ARRAY")
  , (TypeFlagBits
TYPE_FLAG_ARRAY, label
"REF")
  ]

typeFlagsNames :: IsString label => TypeFlags -> [label]
typeFlagsNames :: forall label. IsString label => TypeFlagBits -> [label]
typeFlagsNames TypeFlagBits
bits = do
  (TypeFlagBits
flag, label
name) <- Int -> [(TypeFlagBits, label)] -> [(TypeFlagBits, label)]
forall a. Int -> [a] -> [a]
drop Int
1 [(TypeFlagBits, label)]
forall label. IsString label => [(TypeFlagBits, label)]
typeFlagBitNames
  Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ TypeFlagBits
bits TypeFlagBits -> TypeFlagBits -> Bool
forall a. Bits a => a -> a -> Bool
.&&. TypeFlagBits
flag
  pure label
name