{-# language CPP #-}
module Vulkan.Core11.Promoted_From_VK_KHR_maintenance1 ( trimCommandPool
, CommandPoolTrimFlags(..)
, Result(..)
, ImageCreateFlagBits(..)
, ImageCreateFlags
, FormatFeatureFlagBits(..)
, FormatFeatureFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Control.Monad.IO.Class (MonadIO)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Vulkan.Core10.Handles (CommandPool)
import Vulkan.Core10.Handles (CommandPool(..))
import Vulkan.Core11.Enums.CommandPoolTrimFlags (CommandPoolTrimFlags)
import Vulkan.Core11.Enums.CommandPoolTrimFlags (CommandPoolTrimFlags(..))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkTrimCommandPool))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core11.Enums.CommandPoolTrimFlags (CommandPoolTrimFlags(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlagBits(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.Result (Result(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkTrimCommandPool
:: FunPtr (Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ()) -> Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ()
trimCommandPool :: forall io
. (MonadIO io)
=>
Device
->
CommandPool
->
CommandPoolTrimFlags
-> io ()
trimCommandPool :: forall (io :: * -> *).
MonadIO io =>
Device -> CommandPool -> CommandPoolTrimFlags -> io ()
trimCommandPool Device
device CommandPool
commandPool CommandPoolTrimFlags
flags = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkTrimCommandPoolPtr :: FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ())
vkTrimCommandPoolPtr = DeviceCmds
-> FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ())
pVkTrimCommandPool (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ())
vkTrimCommandPoolPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkTrimCommandPool is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkTrimCommandPool' :: Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ()
vkTrimCommandPool' = FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ())
-> Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ()
mkVkTrimCommandPool FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ())
vkTrimCommandPoolPtr
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkTrimCommandPool" (Ptr Device_T -> CommandPool -> CommandPoolTrimFlags -> IO ()
vkTrimCommandPool'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(CommandPool
commandPool)
(CommandPoolTrimFlags
flags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()