{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE Strict                     #-}
module Graphics.Vulkan.Types.Enum.InternalAllocationType
       (VkInternalAllocationType(VkInternalAllocationType,
                                 VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE))
       where
import           Data.Data                       (Data)
import           Foreign.Storable                (Storable)
import           GHC.Generics                    (Generic)
import           GHC.Read                        (choose, expectP)
import           Graphics.Vulkan.Marshal         (Int32)
import           Text.ParserCombinators.ReadPrec (prec, step, (+++))
import           Text.Read                       (Read (..), parens)
import           Text.Read.Lex                   (Lexeme (..))

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkInternalAllocationType VkInternalAllocationType registry at www.khronos.org>
newtype VkInternalAllocationType = VkInternalAllocationType Int32
                                     deriving (VkInternalAllocationType -> VkInternalAllocationType -> Bool
(VkInternalAllocationType -> VkInternalAllocationType -> Bool)
-> (VkInternalAllocationType -> VkInternalAllocationType -> Bool)
-> Eq VkInternalAllocationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
$c/= :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
== :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
$c== :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
Eq, Eq VkInternalAllocationType
Eq VkInternalAllocationType
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> Ordering)
-> (VkInternalAllocationType -> VkInternalAllocationType -> Bool)
-> (VkInternalAllocationType -> VkInternalAllocationType -> Bool)
-> (VkInternalAllocationType -> VkInternalAllocationType -> Bool)
-> (VkInternalAllocationType -> VkInternalAllocationType -> Bool)
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> VkInternalAllocationType)
-> Ord VkInternalAllocationType
VkInternalAllocationType -> VkInternalAllocationType -> Bool
VkInternalAllocationType -> VkInternalAllocationType -> Ordering
VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
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 :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
$cmin :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
max :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
$cmax :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
>= :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
$c>= :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
> :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
$c> :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
<= :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
$c<= :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
< :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
$c< :: VkInternalAllocationType -> VkInternalAllocationType -> Bool
compare :: VkInternalAllocationType -> VkInternalAllocationType -> Ordering
$ccompare :: VkInternalAllocationType -> VkInternalAllocationType -> Ordering
$cp1Ord :: Eq VkInternalAllocationType
Ord, Integer -> VkInternalAllocationType
VkInternalAllocationType -> VkInternalAllocationType
VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
(VkInternalAllocationType
 -> VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType -> VkInternalAllocationType)
-> (Integer -> VkInternalAllocationType)
-> Num VkInternalAllocationType
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VkInternalAllocationType
$cfromInteger :: Integer -> VkInternalAllocationType
signum :: VkInternalAllocationType -> VkInternalAllocationType
$csignum :: VkInternalAllocationType -> VkInternalAllocationType
abs :: VkInternalAllocationType -> VkInternalAllocationType
$cabs :: VkInternalAllocationType -> VkInternalAllocationType
negate :: VkInternalAllocationType -> VkInternalAllocationType
$cnegate :: VkInternalAllocationType -> VkInternalAllocationType
* :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
$c* :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
- :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
$c- :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
+ :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
$c+ :: VkInternalAllocationType
-> VkInternalAllocationType -> VkInternalAllocationType
Num, VkInternalAllocationType
VkInternalAllocationType
-> VkInternalAllocationType -> Bounded VkInternalAllocationType
forall a. a -> a -> Bounded a
maxBound :: VkInternalAllocationType
$cmaxBound :: VkInternalAllocationType
minBound :: VkInternalAllocationType
$cminBound :: VkInternalAllocationType
Bounded, Ptr b -> Int -> IO VkInternalAllocationType
Ptr b -> Int -> VkInternalAllocationType -> IO ()
Ptr VkInternalAllocationType -> IO VkInternalAllocationType
Ptr VkInternalAllocationType -> Int -> IO VkInternalAllocationType
Ptr VkInternalAllocationType
-> Int -> VkInternalAllocationType -> IO ()
Ptr VkInternalAllocationType -> VkInternalAllocationType -> IO ()
VkInternalAllocationType -> Int
(VkInternalAllocationType -> Int)
-> (VkInternalAllocationType -> Int)
-> (Ptr VkInternalAllocationType
    -> Int -> IO VkInternalAllocationType)
-> (Ptr VkInternalAllocationType
    -> Int -> VkInternalAllocationType -> IO ())
-> (forall b. Ptr b -> Int -> IO VkInternalAllocationType)
-> (forall b. Ptr b -> Int -> VkInternalAllocationType -> IO ())
-> (Ptr VkInternalAllocationType -> IO VkInternalAllocationType)
-> (Ptr VkInternalAllocationType
    -> VkInternalAllocationType -> IO ())
-> Storable VkInternalAllocationType
forall b. Ptr b -> Int -> IO VkInternalAllocationType
forall b. Ptr b -> Int -> VkInternalAllocationType -> 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 VkInternalAllocationType -> VkInternalAllocationType -> IO ()
$cpoke :: Ptr VkInternalAllocationType -> VkInternalAllocationType -> IO ()
peek :: Ptr VkInternalAllocationType -> IO VkInternalAllocationType
$cpeek :: Ptr VkInternalAllocationType -> IO VkInternalAllocationType
pokeByteOff :: Ptr b -> Int -> VkInternalAllocationType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkInternalAllocationType -> IO ()
peekByteOff :: Ptr b -> Int -> IO VkInternalAllocationType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkInternalAllocationType
pokeElemOff :: Ptr VkInternalAllocationType
-> Int -> VkInternalAllocationType -> IO ()
$cpokeElemOff :: Ptr VkInternalAllocationType
-> Int -> VkInternalAllocationType -> IO ()
peekElemOff :: Ptr VkInternalAllocationType -> Int -> IO VkInternalAllocationType
$cpeekElemOff :: Ptr VkInternalAllocationType -> Int -> IO VkInternalAllocationType
alignment :: VkInternalAllocationType -> Int
$calignment :: VkInternalAllocationType -> Int
sizeOf :: VkInternalAllocationType -> Int
$csizeOf :: VkInternalAllocationType -> Int
Storable, Int -> VkInternalAllocationType
VkInternalAllocationType -> Int
VkInternalAllocationType -> [VkInternalAllocationType]
VkInternalAllocationType -> VkInternalAllocationType
VkInternalAllocationType
-> VkInternalAllocationType -> [VkInternalAllocationType]
VkInternalAllocationType
-> VkInternalAllocationType
-> VkInternalAllocationType
-> [VkInternalAllocationType]
(VkInternalAllocationType -> VkInternalAllocationType)
-> (VkInternalAllocationType -> VkInternalAllocationType)
-> (Int -> VkInternalAllocationType)
-> (VkInternalAllocationType -> Int)
-> (VkInternalAllocationType -> [VkInternalAllocationType])
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> [VkInternalAllocationType])
-> (VkInternalAllocationType
    -> VkInternalAllocationType -> [VkInternalAllocationType])
-> (VkInternalAllocationType
    -> VkInternalAllocationType
    -> VkInternalAllocationType
    -> [VkInternalAllocationType])
-> Enum VkInternalAllocationType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkInternalAllocationType
-> VkInternalAllocationType
-> VkInternalAllocationType
-> [VkInternalAllocationType]
$cenumFromThenTo :: VkInternalAllocationType
-> VkInternalAllocationType
-> VkInternalAllocationType
-> [VkInternalAllocationType]
enumFromTo :: VkInternalAllocationType
-> VkInternalAllocationType -> [VkInternalAllocationType]
$cenumFromTo :: VkInternalAllocationType
-> VkInternalAllocationType -> [VkInternalAllocationType]
enumFromThen :: VkInternalAllocationType
-> VkInternalAllocationType -> [VkInternalAllocationType]
$cenumFromThen :: VkInternalAllocationType
-> VkInternalAllocationType -> [VkInternalAllocationType]
enumFrom :: VkInternalAllocationType -> [VkInternalAllocationType]
$cenumFrom :: VkInternalAllocationType -> [VkInternalAllocationType]
fromEnum :: VkInternalAllocationType -> Int
$cfromEnum :: VkInternalAllocationType -> Int
toEnum :: Int -> VkInternalAllocationType
$ctoEnum :: Int -> VkInternalAllocationType
pred :: VkInternalAllocationType -> VkInternalAllocationType
$cpred :: VkInternalAllocationType -> VkInternalAllocationType
succ :: VkInternalAllocationType -> VkInternalAllocationType
$csucc :: VkInternalAllocationType -> VkInternalAllocationType
Enum, Typeable VkInternalAllocationType
DataType
Constr
Typeable VkInternalAllocationType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VkInternalAllocationType
    -> c VkInternalAllocationType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VkInternalAllocationType)
-> (VkInternalAllocationType -> Constr)
-> (VkInternalAllocationType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c VkInternalAllocationType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VkInternalAllocationType))
-> ((forall b. Data b => b -> b)
    -> VkInternalAllocationType -> VkInternalAllocationType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VkInternalAllocationType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VkInternalAllocationType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VkInternalAllocationType -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> VkInternalAllocationType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VkInternalAllocationType -> m VkInternalAllocationType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VkInternalAllocationType -> m VkInternalAllocationType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VkInternalAllocationType -> m VkInternalAllocationType)
-> Data VkInternalAllocationType
VkInternalAllocationType -> DataType
VkInternalAllocationType -> Constr
(forall b. Data b => b -> b)
-> VkInternalAllocationType -> VkInternalAllocationType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkInternalAllocationType
-> c VkInternalAllocationType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkInternalAllocationType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> VkInternalAllocationType -> u
forall u.
(forall d. Data d => d -> u) -> VkInternalAllocationType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VkInternalAllocationType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VkInternalAllocationType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkInternalAllocationType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkInternalAllocationType
-> c VkInternalAllocationType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkInternalAllocationType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkInternalAllocationType)
$cVkInternalAllocationType :: Constr
$tVkInternalAllocationType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
gmapMp :: (forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
gmapM :: (forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VkInternalAllocationType -> m VkInternalAllocationType
gmapQi :: Int
-> (forall d. Data d => d -> u) -> VkInternalAllocationType -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> VkInternalAllocationType -> u
gmapQ :: (forall d. Data d => d -> u) -> VkInternalAllocationType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VkInternalAllocationType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VkInternalAllocationType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VkInternalAllocationType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VkInternalAllocationType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VkInternalAllocationType
-> r
gmapT :: (forall b. Data b => b -> b)
-> VkInternalAllocationType -> VkInternalAllocationType
$cgmapT :: (forall b. Data b => b -> b)
-> VkInternalAllocationType -> VkInternalAllocationType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkInternalAllocationType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VkInternalAllocationType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VkInternalAllocationType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VkInternalAllocationType)
dataTypeOf :: VkInternalAllocationType -> DataType
$cdataTypeOf :: VkInternalAllocationType -> DataType
toConstr :: VkInternalAllocationType -> Constr
$ctoConstr :: VkInternalAllocationType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkInternalAllocationType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VkInternalAllocationType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkInternalAllocationType
-> c VkInternalAllocationType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VkInternalAllocationType
-> c VkInternalAllocationType
$cp1Data :: Typeable VkInternalAllocationType
Data, (forall x.
 VkInternalAllocationType -> Rep VkInternalAllocationType x)
-> (forall x.
    Rep VkInternalAllocationType x -> VkInternalAllocationType)
-> Generic VkInternalAllocationType
forall x.
Rep VkInternalAllocationType x -> VkInternalAllocationType
forall x.
VkInternalAllocationType -> Rep VkInternalAllocationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep VkInternalAllocationType x -> VkInternalAllocationType
$cfrom :: forall x.
VkInternalAllocationType -> Rep VkInternalAllocationType x
Generic)

instance Show VkInternalAllocationType where
        showsPrec :: Int -> VkInternalAllocationType -> ShowS
showsPrec Int
_ VkInternalAllocationType
VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE
          = String -> ShowS
showString String
"VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE"
        showsPrec Int
p (VkInternalAllocationType Int32
x)
          = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
              (String -> ShowS
showString String
"VkInternalAllocationType " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int32
x)

instance Read VkInternalAllocationType where
        readPrec :: ReadPrec VkInternalAllocationType
readPrec
          = ReadPrec VkInternalAllocationType
-> ReadPrec VkInternalAllocationType
forall a. ReadPrec a -> ReadPrec a
parens
              ([(String, ReadPrec VkInternalAllocationType)]
-> ReadPrec VkInternalAllocationType
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
                 [(String
"VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE",
                   VkInternalAllocationType -> ReadPrec VkInternalAllocationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkInternalAllocationType
VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE)]
                 ReadPrec VkInternalAllocationType
-> ReadPrec VkInternalAllocationType
-> ReadPrec VkInternalAllocationType
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                 Int
-> ReadPrec VkInternalAllocationType
-> ReadPrec VkInternalAllocationType
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
                   (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkInternalAllocationType") ReadPrec ()
-> ReadPrec VkInternalAllocationType
-> ReadPrec VkInternalAllocationType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                      (Int32 -> VkInternalAllocationType
VkInternalAllocationType (Int32 -> VkInternalAllocationType)
-> ReadPrec Int32 -> ReadPrec VkInternalAllocationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE ::
        VkInternalAllocationType

pattern $bVK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE :: VkInternalAllocationType
$mVK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE :: forall r.
VkInternalAllocationType -> (Void# -> r) -> (Void# -> r) -> r
VK_INTERNAL_ALLOCATION_TYPE_EXECUTABLE =
        VkInternalAllocationType 0