{-# language CPP #-}
module Vulkan.Core10.Enums.QueueFlagBits  ( QueueFlagBits( QUEUE_GRAPHICS_BIT
                                                         , QUEUE_COMPUTE_BIT
                                                         , QUEUE_TRANSFER_BIT
                                                         , QUEUE_SPARSE_BINDING_BIT
                                                         , QUEUE_PROTECTED_BIT
                                                         , ..
                                                         )
                                          , QueueFlags
                                          ) where

import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.Bits (Bits)
import Foreign.Storable (Storable)
import GHC.Read (Read(readPrec))
import Text.Read.Lex (Lexeme(Ident))
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Zero (Zero)
-- | VkQueueFlagBits - Bitmask specifying capabilities of queues in a queue
-- family
--
-- = Description
--
-- -   'QUEUE_GRAPHICS_BIT' specifies that queues in this queue family
--     support graphics operations.
--
-- -   'QUEUE_COMPUTE_BIT' specifies that queues in this queue family
--     support compute operations.
--
-- -   'QUEUE_TRANSFER_BIT' specifies that queues in this queue family
--     support transfer operations.
--
-- -   'QUEUE_SPARSE_BINDING_BIT' specifies that queues in this queue
--     family support sparse memory management operations (see
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#sparsememory Sparse Resources>).
--     If any of the sparse resource features are enabled, then at least
--     one queue family /must/ support this bit.
--
-- -   if 'QUEUE_PROTECTED_BIT' is set, then the queues in this queue
--     family support the
--     'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DEVICE_QUEUE_CREATE_PROTECTED_BIT'
--     bit. (see
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-protected-memory Protected Memory>).
--     If the physical device supports the @protectedMemory@ feature, at
--     least one of its queue families /must/ support this bit.
--
-- If an implementation exposes any queue family that supports graphics
-- operations, at least one queue family of at least one physical device
-- exposed by the implementation /must/ support both graphics and compute
-- operations.
--
-- Furthermore, if the protected memory physical device feature is
-- supported, then at least one queue family of at least one physical
-- device exposed by the implementation /must/ support graphics operations,
-- compute operations, and protected memory operations.
--
-- Note
--
-- All commands that are allowed on a queue that supports transfer
-- operations are also allowed on a queue that supports either graphics or
-- compute operations. Thus, if the capabilities of a queue family include
-- 'QUEUE_GRAPHICS_BIT' or 'QUEUE_COMPUTE_BIT', then reporting the
-- 'QUEUE_TRANSFER_BIT' capability separately for that queue family is
-- /optional/.
--
-- For further details see
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#devsandqueues-queues Queues>.
--
-- = See Also
--
-- 'QueueFlags'
newtype QueueFlagBits = QueueFlagBits Flags
  deriving newtype (QueueFlagBits -> QueueFlagBits -> Bool
(QueueFlagBits -> QueueFlagBits -> Bool)
-> (QueueFlagBits -> QueueFlagBits -> Bool) -> Eq QueueFlagBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueueFlagBits -> QueueFlagBits -> Bool
$c/= :: QueueFlagBits -> QueueFlagBits -> Bool
== :: QueueFlagBits -> QueueFlagBits -> Bool
$c== :: QueueFlagBits -> QueueFlagBits -> Bool
Eq, Eq QueueFlagBits
Eq QueueFlagBits =>
(QueueFlagBits -> QueueFlagBits -> Ordering)
-> (QueueFlagBits -> QueueFlagBits -> Bool)
-> (QueueFlagBits -> QueueFlagBits -> Bool)
-> (QueueFlagBits -> QueueFlagBits -> Bool)
-> (QueueFlagBits -> QueueFlagBits -> Bool)
-> (QueueFlagBits -> QueueFlagBits -> QueueFlagBits)
-> (QueueFlagBits -> QueueFlagBits -> QueueFlagBits)
-> Ord QueueFlagBits
QueueFlagBits -> QueueFlagBits -> Bool
QueueFlagBits -> QueueFlagBits -> Ordering
QueueFlagBits -> QueueFlagBits -> QueueFlagBits
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 :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
$cmin :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
max :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
$cmax :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
>= :: QueueFlagBits -> QueueFlagBits -> Bool
$c>= :: QueueFlagBits -> QueueFlagBits -> Bool
> :: QueueFlagBits -> QueueFlagBits -> Bool
$c> :: QueueFlagBits -> QueueFlagBits -> Bool
<= :: QueueFlagBits -> QueueFlagBits -> Bool
$c<= :: QueueFlagBits -> QueueFlagBits -> Bool
< :: QueueFlagBits -> QueueFlagBits -> Bool
$c< :: QueueFlagBits -> QueueFlagBits -> Bool
compare :: QueueFlagBits -> QueueFlagBits -> Ordering
$ccompare :: QueueFlagBits -> QueueFlagBits -> Ordering
$cp1Ord :: Eq QueueFlagBits
Ord, Ptr b -> Int -> IO QueueFlagBits
Ptr b -> Int -> QueueFlagBits -> IO ()
Ptr QueueFlagBits -> IO QueueFlagBits
Ptr QueueFlagBits -> Int -> IO QueueFlagBits
Ptr QueueFlagBits -> Int -> QueueFlagBits -> IO ()
Ptr QueueFlagBits -> QueueFlagBits -> IO ()
QueueFlagBits -> Int
(QueueFlagBits -> Int)
-> (QueueFlagBits -> Int)
-> (Ptr QueueFlagBits -> Int -> IO QueueFlagBits)
-> (Ptr QueueFlagBits -> Int -> QueueFlagBits -> IO ())
-> (forall b. Ptr b -> Int -> IO QueueFlagBits)
-> (forall b. Ptr b -> Int -> QueueFlagBits -> IO ())
-> (Ptr QueueFlagBits -> IO QueueFlagBits)
-> (Ptr QueueFlagBits -> QueueFlagBits -> IO ())
-> Storable QueueFlagBits
forall b. Ptr b -> Int -> IO QueueFlagBits
forall b. Ptr b -> Int -> QueueFlagBits -> 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 QueueFlagBits -> QueueFlagBits -> IO ()
$cpoke :: Ptr QueueFlagBits -> QueueFlagBits -> IO ()
peek :: Ptr QueueFlagBits -> IO QueueFlagBits
$cpeek :: Ptr QueueFlagBits -> IO QueueFlagBits
pokeByteOff :: Ptr b -> Int -> QueueFlagBits -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> QueueFlagBits -> IO ()
peekByteOff :: Ptr b -> Int -> IO QueueFlagBits
$cpeekByteOff :: forall b. Ptr b -> Int -> IO QueueFlagBits
pokeElemOff :: Ptr QueueFlagBits -> Int -> QueueFlagBits -> IO ()
$cpokeElemOff :: Ptr QueueFlagBits -> Int -> QueueFlagBits -> IO ()
peekElemOff :: Ptr QueueFlagBits -> Int -> IO QueueFlagBits
$cpeekElemOff :: Ptr QueueFlagBits -> Int -> IO QueueFlagBits
alignment :: QueueFlagBits -> Int
$calignment :: QueueFlagBits -> Int
sizeOf :: QueueFlagBits -> Int
$csizeOf :: QueueFlagBits -> Int
Storable, QueueFlagBits
QueueFlagBits -> Zero QueueFlagBits
forall a. a -> Zero a
zero :: QueueFlagBits
$czero :: QueueFlagBits
Zero, Eq QueueFlagBits
QueueFlagBits
Eq QueueFlagBits =>
(QueueFlagBits -> QueueFlagBits -> QueueFlagBits)
-> (QueueFlagBits -> QueueFlagBits -> QueueFlagBits)
-> (QueueFlagBits -> QueueFlagBits -> QueueFlagBits)
-> (QueueFlagBits -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> QueueFlagBits
-> (Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> Bool)
-> (QueueFlagBits -> Maybe Int)
-> (QueueFlagBits -> Int)
-> (QueueFlagBits -> Bool)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int -> QueueFlagBits)
-> (QueueFlagBits -> Int)
-> Bits QueueFlagBits
Int -> QueueFlagBits
QueueFlagBits -> Bool
QueueFlagBits -> Int
QueueFlagBits -> Maybe Int
QueueFlagBits -> QueueFlagBits
QueueFlagBits -> Int -> Bool
QueueFlagBits -> Int -> QueueFlagBits
QueueFlagBits -> QueueFlagBits -> QueueFlagBits
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 :: QueueFlagBits -> Int
$cpopCount :: QueueFlagBits -> Int
rotateR :: QueueFlagBits -> Int -> QueueFlagBits
$crotateR :: QueueFlagBits -> Int -> QueueFlagBits
rotateL :: QueueFlagBits -> Int -> QueueFlagBits
$crotateL :: QueueFlagBits -> Int -> QueueFlagBits
unsafeShiftR :: QueueFlagBits -> Int -> QueueFlagBits
$cunsafeShiftR :: QueueFlagBits -> Int -> QueueFlagBits
shiftR :: QueueFlagBits -> Int -> QueueFlagBits
$cshiftR :: QueueFlagBits -> Int -> QueueFlagBits
unsafeShiftL :: QueueFlagBits -> Int -> QueueFlagBits
$cunsafeShiftL :: QueueFlagBits -> Int -> QueueFlagBits
shiftL :: QueueFlagBits -> Int -> QueueFlagBits
$cshiftL :: QueueFlagBits -> Int -> QueueFlagBits
isSigned :: QueueFlagBits -> Bool
$cisSigned :: QueueFlagBits -> Bool
bitSize :: QueueFlagBits -> Int
$cbitSize :: QueueFlagBits -> Int
bitSizeMaybe :: QueueFlagBits -> Maybe Int
$cbitSizeMaybe :: QueueFlagBits -> Maybe Int
testBit :: QueueFlagBits -> Int -> Bool
$ctestBit :: QueueFlagBits -> Int -> Bool
complementBit :: QueueFlagBits -> Int -> QueueFlagBits
$ccomplementBit :: QueueFlagBits -> Int -> QueueFlagBits
clearBit :: QueueFlagBits -> Int -> QueueFlagBits
$cclearBit :: QueueFlagBits -> Int -> QueueFlagBits
setBit :: QueueFlagBits -> Int -> QueueFlagBits
$csetBit :: QueueFlagBits -> Int -> QueueFlagBits
bit :: Int -> QueueFlagBits
$cbit :: Int -> QueueFlagBits
zeroBits :: QueueFlagBits
$czeroBits :: QueueFlagBits
rotate :: QueueFlagBits -> Int -> QueueFlagBits
$crotate :: QueueFlagBits -> Int -> QueueFlagBits
shift :: QueueFlagBits -> Int -> QueueFlagBits
$cshift :: QueueFlagBits -> Int -> QueueFlagBits
complement :: QueueFlagBits -> QueueFlagBits
$ccomplement :: QueueFlagBits -> QueueFlagBits
xor :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
$cxor :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
.|. :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
$c.|. :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
.&. :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
$c.&. :: QueueFlagBits -> QueueFlagBits -> QueueFlagBits
$cp1Bits :: Eq QueueFlagBits
Bits)

-- No documentation found for Nested "VkQueueFlagBits" "VK_QUEUE_GRAPHICS_BIT"
pattern $bQUEUE_GRAPHICS_BIT :: QueueFlagBits
$mQUEUE_GRAPHICS_BIT :: forall r. QueueFlagBits -> (Void# -> r) -> (Void# -> r) -> r
QUEUE_GRAPHICS_BIT = QueueFlagBits 0x00000001
-- No documentation found for Nested "VkQueueFlagBits" "VK_QUEUE_COMPUTE_BIT"
pattern $bQUEUE_COMPUTE_BIT :: QueueFlagBits
$mQUEUE_COMPUTE_BIT :: forall r. QueueFlagBits -> (Void# -> r) -> (Void# -> r) -> r
QUEUE_COMPUTE_BIT = QueueFlagBits 0x00000002
-- No documentation found for Nested "VkQueueFlagBits" "VK_QUEUE_TRANSFER_BIT"
pattern $bQUEUE_TRANSFER_BIT :: QueueFlagBits
$mQUEUE_TRANSFER_BIT :: forall r. QueueFlagBits -> (Void# -> r) -> (Void# -> r) -> r
QUEUE_TRANSFER_BIT = QueueFlagBits 0x00000004
-- No documentation found for Nested "VkQueueFlagBits" "VK_QUEUE_SPARSE_BINDING_BIT"
pattern $bQUEUE_SPARSE_BINDING_BIT :: QueueFlagBits
$mQUEUE_SPARSE_BINDING_BIT :: forall r. QueueFlagBits -> (Void# -> r) -> (Void# -> r) -> r
QUEUE_SPARSE_BINDING_BIT = QueueFlagBits 0x00000008
-- No documentation found for Nested "VkQueueFlagBits" "VK_QUEUE_PROTECTED_BIT"
pattern $bQUEUE_PROTECTED_BIT :: QueueFlagBits
$mQUEUE_PROTECTED_BIT :: forall r. QueueFlagBits -> (Void# -> r) -> (Void# -> r) -> r
QUEUE_PROTECTED_BIT = QueueFlagBits 0x00000010

type QueueFlags = QueueFlagBits

instance Show QueueFlagBits where
  showsPrec :: Int -> QueueFlagBits -> ShowS
showsPrec p :: Int
p = \case
    QUEUE_GRAPHICS_BIT -> String -> ShowS
showString "QUEUE_GRAPHICS_BIT"
    QUEUE_COMPUTE_BIT -> String -> ShowS
showString "QUEUE_COMPUTE_BIT"
    QUEUE_TRANSFER_BIT -> String -> ShowS
showString "QUEUE_TRANSFER_BIT"
    QUEUE_SPARSE_BINDING_BIT -> String -> ShowS
showString "QUEUE_SPARSE_BINDING_BIT"
    QUEUE_PROTECTED_BIT -> String -> ShowS
showString "QUEUE_PROTECTED_BIT"
    QueueFlagBits x :: Flags
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "QueueFlagBits 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read QueueFlagBits where
  readPrec :: ReadPrec QueueFlagBits
readPrec = ReadPrec QueueFlagBits -> ReadPrec QueueFlagBits
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec QueueFlagBits)] -> ReadPrec QueueFlagBits
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("QUEUE_GRAPHICS_BIT", QueueFlagBits -> ReadPrec QueueFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueFlagBits
QUEUE_GRAPHICS_BIT)
                            , ("QUEUE_COMPUTE_BIT", QueueFlagBits -> ReadPrec QueueFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueFlagBits
QUEUE_COMPUTE_BIT)
                            , ("QUEUE_TRANSFER_BIT", QueueFlagBits -> ReadPrec QueueFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueFlagBits
QUEUE_TRANSFER_BIT)
                            , ("QUEUE_SPARSE_BINDING_BIT", QueueFlagBits -> ReadPrec QueueFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueFlagBits
QUEUE_SPARSE_BINDING_BIT)
                            , ("QUEUE_PROTECTED_BIT", QueueFlagBits -> ReadPrec QueueFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueFlagBits
QUEUE_PROTECTED_BIT)]
                     ReadPrec QueueFlagBits
-> ReadPrec QueueFlagBits -> ReadPrec QueueFlagBits
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int -> ReadPrec QueueFlagBits -> ReadPrec QueueFlagBits
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "QueueFlagBits")
                       Flags
v <- ReadPrec Flags -> ReadPrec Flags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Flags
forall a. Read a => ReadPrec a
readPrec
                       QueueFlagBits -> ReadPrec QueueFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flags -> QueueFlagBits
QueueFlagBits Flags
v)))