From 6ad4598f35f8648cb86618ccb10f7799a7162e8c Mon Sep 17 00:00:00 2001 From: Joe Hermaszewski Date: Sun, 26 Apr 2020 20:37:19 +0800 Subject: [PATCH] Change type of bracketing functions They can now be used with more exception/resource libraries They now take as their first argument a function with the shape of "bracket" or "allocate" --- generate-new/src/Bracket.hs | 102 +++++++++--------- generate-new/src/Render/Command.hs | 5 + src/Graphics/Vulkan/Core10/Buffer.hs | 16 +-- src/Graphics/Vulkan/Core10/BufferView.hs | 19 ++-- src/Graphics/Vulkan/Core10/CommandBuffer.hs | 36 ++++--- .../Vulkan/Core10/CommandBufferBuilding.hs | 36 ++++--- src/Graphics/Vulkan/Core10/CommandPool.hs | 19 ++-- src/Graphics/Vulkan/Core10/DescriptorSet.hs | 53 +++++---- src/Graphics/Vulkan/Core10/Device.hs | 16 +-- .../Vulkan/Core10/DeviceInitialization.hs | 19 ++-- src/Graphics/Vulkan/Core10/Event.hs | 16 +-- src/Graphics/Vulkan/Core10/Fence.hs | 16 +-- src/Graphics/Vulkan/Core10/Image.hs | 16 +-- src/Graphics/Vulkan/Core10/ImageView.hs | 19 ++-- src/Graphics/Vulkan/Core10/Memory.hs | 32 +++--- src/Graphics/Vulkan/Core10/Pass.hs | 38 ++++--- src/Graphics/Vulkan/Core10/Pipeline.hs | 36 ++++--- src/Graphics/Vulkan/Core10/PipelineCache.hs | 19 ++-- src/Graphics/Vulkan/Core10/PipelineLayout.hs | 19 ++-- src/Graphics/Vulkan/Core10/Query.hs | 19 ++-- src/Graphics/Vulkan/Core10/QueueSemaphore.hs | 19 ++-- src/Graphics/Vulkan/Core10/Sampler.hs | 16 +-- src/Graphics/Vulkan/Core10/Shader.hs | 19 ++-- ..._From_VK_KHR_descriptor_update_template.hs | 19 ++-- ...ed_From_VK_KHR_sampler_ycbcr_conversion.hs | 19 ++-- ...Promoted_From_VK_KHR_create_renderpass2.hs | 19 ++-- .../VK_EXT_conditional_rendering.hs | 19 ++-- .../Vulkan/Extensions/VK_EXT_debug_report.hs | 19 ++-- .../Vulkan/Extensions/VK_EXT_debug_utils.hs | 36 ++++--- .../Extensions/VK_EXT_transform_feedback.hs | 37 ++++--- .../Extensions/VK_EXT_validation_cache.hs | 19 ++-- .../Vulkan/Extensions/VK_KHR_swapchain.hs | 19 ++-- .../VK_NVX_device_generated_commands.hs | 53 +++++---- .../Vulkan/Extensions/VK_NV_ray_tracing.hs | 19 ++-- 34 files changed, 522 insertions(+), 361 deletions(-) diff --git a/generate-new/src/Bracket.hs b/generate-new/src/Bracket.hs index 363b6d0c5..1e3c76d15 100644 --- a/generate-new/src/Bracket.hs +++ b/generate-new/src/Bracket.hs @@ -1,34 +1,32 @@ module Bracket where -import Relude hiding ( Handle - , Type - ) -import Data.List.Extra ( nubOrd - , elemIndex +import Data.List.Extra ( elemIndex + , nubOrd ) import qualified Data.Text.Extra as T -import Language.Haskell.TH ( mkName ) import Data.Text.Prettyprint.Doc hiding ( brackets , plural ) +import Language.Haskell.TH ( mkName ) import Polysemy import Polysemy.Input +import Relude hiding ( Handle + , Type + ) -import qualified Control.Exception - -import Render.Element -import Render.Utils -import Render.SpecInfo -import Render.Command -import Render.Names -import Spec.Parse -import Haskell as H import Error -import Marshal.Scheme +import Haskell as H import Marshal.Command +import Marshal.Scheme +import Render.Command +import Render.Element +import Render.Names import Render.Scheme +import Render.SpecInfo +import Render.Utils +import Spec.Parse data Bracket = Bracket { bInnerTypes :: [MarshalScheme Parameter] @@ -163,7 +161,8 @@ renderBracket paramName b@Bracket {..} = <=< schemeTypeNegative ) [ t | Provided _ t <- arguments ] - let argHsVars = [ pretty (paramName v) | Provided v _ <- arguments ] + let argHsVars = + "b" : [ pretty (paramName v) | Provided v _ <- arguments ] innerHsType <- do ts <- traverse ( note "Inner type has no representation in a negative position" @@ -171,23 +170,24 @@ renderBracket paramName b@Bracket {..} = ) bInnerTypes pure $ foldl' (:@) (TupleT (length ts)) ts - let noDestructorResource = not (any isResource bDestroyArguments) - noResource = null bInnerTypes && noDestructorResource - cont = if noResource - then ConT ''IO :@ VarT (mkName "r") - else innerHsType ~> ConT ''IO :@ VarT (mkName "r") - wrapperType = foldr (~>) - (ConT ''IO :@ VarT (mkName "r")) - (argHsTypes ++ [cont]) - constrainedType <- constrainStructVariables wrapperType - wrapperTDoc <- renderType constrainedType - bracketDoc <- if noResource - then do - tellImport 'Control.Exception.bracket_ - pure "bracket_" - else do - tellImport 'Control.Exception.bracket - pure "bracket" + let + noDestructorResource = not (any isResource bDestroyArguments) + noResource = null bInnerTypes && noDestructorResource + ioVar = VarT (mkName "io") + rVar = VarT (mkName "r") + bracketTy = if noResource + then (ioVar :@ innerHsType ~> (ioVar :@ ConT ''()) ~> rVar) + else + ( ioVar + :@ innerHsType + ~> (innerHsType ~> ioVar :@ ConT ''()) + ~> rVar + ) + wrapperType = foldr (~>) rVar (bracketTy : argHsTypes) + bracketSuffix = bool "" "_" noResource + constrainedType <- addConstraints [ConT ''MonadIO :@ ioVar] + <$> constrainStructVariables wrapperType + wrapperTDoc <- renderType constrainedType -- -- The actual function @@ -197,29 +197,27 @@ renderBracket paramName b@Bracket {..} = tellDoc $ vsep [ comment (T.unlines - ( [ "A safe wrapper for '" - <> unName create - <> "' and '" - <> unName destroy - <> "' using '" - <> bracketDoc - <> "'" - ] - <> bool - [ "" - , "The allocated value must not be returned from the provided computation" - ] - [] - noResource + ([ "A convenience wrapper to make a compatible pair of calls to '" + <> unName create + <> "' and '" + <> unName destroy + <> "'" + , "" + , "To ensure that '" + <> unName destroy + <> "' is always called: pass 'Control.Exception.bracket" + <> bracketSuffix + <> "' (or the allocate function from your favourite resource management library) as the first argument." + , "To just extract the pair pass '(,)' as the first argument." + , "" + ] + <> [ "Note that there is no inner resource" | noResource ] ) ) , pretty wrapperName <+> "::" <+> wrapperTDoc , pretty wrapperName <+> sep argHsVars <+> "=" <> line <> indent 2 - (pretty bracketDoc <> line <> indent - 2 - (vsep [parens createCall, parens destroyCall]) - ) + ("b" <+> indent 0 (vsep [parens createCall, parens destroyCall])) ] renderCreate diff --git a/generate-new/src/Render/Command.hs b/generate-new/src/Render/Command.hs index 3536e7b93..de1fdfb0b 100644 --- a/generate-new/src/Render/Command.hs +++ b/generate-new/src/Render/Command.hs @@ -2,6 +2,7 @@ module Render.Command ( renderCommand , constrainStructVariables + , addConstraints ) where import Relude hiding ( Type @@ -764,6 +765,8 @@ addMonadIO = addConstraints ioVar :: Name ioVar = mkName "io" +-- | Any extensible structs have 'PokeChain' or 'PeekChain' constraints added +-- depending on their position polarity. constrainStructVariables :: (HasErr r, HasRenderParams r, HasRenderElem r, HasRenderedNames r) => Type @@ -778,6 +781,8 @@ constrainStructVariables t = do ) t +-- | Add constraints to a type, folding them into an existing forall if +-- possible addConstraints :: [Pred] -> Type -> Type addConstraints new = quantifyType . \case ForallT vs ctx ty -> ForallT vs (ctx <> new) ty diff --git a/src/Graphics/Vulkan/Core10/Buffer.hs b/src/Graphics/Vulkan/Core10/Buffer.hs index 39b067f3e..b5da7a9ce 100644 --- a/src/Graphics/Vulkan/Core10/Buffer.hs +++ b/src/Graphics/Vulkan/Core10/Buffer.hs @@ -148,13 +148,17 @@ createBuffer device createInfo allocator = liftIO . evalContT $ do pBuffer <- lift $ peek @Buffer pPBuffer pure $ (pBuffer) --- | A safe wrapper for 'createBuffer' and 'destroyBuffer' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'createBuffer' and +-- 'destroyBuffer' -- --- The allocated value must not be returned from the provided computation -withBuffer :: forall a r . PokeChain a => Device -> BufferCreateInfo a -> Maybe AllocationCallbacks -> ((Buffer) -> IO r) -> IO r -withBuffer device pCreateInfo pAllocator = - bracket - (createBuffer device pCreateInfo pAllocator) +-- To ensure that 'destroyBuffer' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withBuffer :: forall a io r . (PokeChain a, MonadIO io) => (io (Buffer) -> ((Buffer) -> io ()) -> r) -> Device -> BufferCreateInfo a -> Maybe AllocationCallbacks -> r +withBuffer b device pCreateInfo pAllocator = + b (createBuffer device pCreateInfo pAllocator) (\(o0) -> destroyBuffer device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/BufferView.hs b/src/Graphics/Vulkan/Core10/BufferView.hs index 25c1a7a46..e1edf47d9 100644 --- a/src/Graphics/Vulkan/Core10/BufferView.hs +++ b/src/Graphics/Vulkan/Core10/BufferView.hs @@ -120,14 +120,17 @@ createBufferView device createInfo allocator = liftIO . evalContT $ do pView <- lift $ peek @BufferView pPView pure $ (pView) --- | A safe wrapper for 'createBufferView' and 'destroyBufferView' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withBufferView :: forall r . Device -> BufferViewCreateInfo -> Maybe AllocationCallbacks -> ((BufferView) -> IO r) -> IO r -withBufferView device pCreateInfo pAllocator = - bracket - (createBufferView device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createBufferView' +-- and 'destroyBufferView' +-- +-- To ensure that 'destroyBufferView' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withBufferView :: forall io r . MonadIO io => (io (BufferView) -> ((BufferView) -> io ()) -> r) -> Device -> BufferViewCreateInfo -> Maybe AllocationCallbacks -> r +withBufferView b device pCreateInfo pAllocator = + b (createBufferView device pCreateInfo pAllocator) (\(o0) -> destroyBufferView device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/CommandBuffer.hs b/src/Graphics/Vulkan/Core10/CommandBuffer.hs index 36b0f42ef..68dd988f5 100644 --- a/src/Graphics/Vulkan/Core10/CommandBuffer.hs +++ b/src/Graphics/Vulkan/Core10/CommandBuffer.hs @@ -12,7 +12,6 @@ module Graphics.Vulkan.Core10.CommandBuffer ( allocateCommandBuffers ) where import Control.Exception.Base (bracket) -import Control.Exception.Base (bracket_) import Control.Monad.IO.Class (liftIO) import Data.Typeable (eqT) import Foreign.Marshal.Alloc (allocaBytesAligned) @@ -180,14 +179,17 @@ allocateCommandBuffers device allocateInfo = liftIO . evalContT $ do pure $ (\h -> CommandBuffer h cmds ) pCommandBuffersElem) pure $ (pCommandBuffers) --- | A safe wrapper for 'allocateCommandBuffers' and 'freeCommandBuffers' --- using 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'allocateCommandBuffers' and 'freeCommandBuffers' -- --- The allocated value must not be returned from the provided computation -withCommandBuffers :: forall r . Device -> CommandBufferAllocateInfo -> ((Vector CommandBuffer) -> IO r) -> IO r -withCommandBuffers device pAllocateInfo = - bracket - (allocateCommandBuffers device pAllocateInfo) +-- To ensure that 'freeCommandBuffers' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withCommandBuffers :: forall io r . MonadIO io => (io (Vector CommandBuffer) -> ((Vector CommandBuffer) -> io ()) -> r) -> Device -> CommandBufferAllocateInfo -> r +withCommandBuffers b device pAllocateInfo = + b (allocateCommandBuffers device pAllocateInfo) (\(o0) -> freeCommandBuffers device (commandPool (pAllocateInfo :: CommandBufferAllocateInfo)) o0) @@ -351,12 +353,18 @@ beginCommandBuffer commandBuffer beginInfo = liftIO . evalContT $ do r <- lift $ vkBeginCommandBuffer' (commandBufferHandle (commandBuffer)) pBeginInfo lift $ when (r < SUCCESS) (throwIO (VulkanException r)) --- | A safe wrapper for 'beginCommandBuffer' and 'endCommandBuffer' using --- 'bracket_' -useCommandBuffer :: forall a r . PokeChain a => CommandBuffer -> CommandBufferBeginInfo a -> IO r -> IO r -useCommandBuffer commandBuffer pBeginInfo = - bracket_ - (beginCommandBuffer commandBuffer pBeginInfo) +-- | A convenience wrapper to make a compatible pair of 'beginCommandBuffer' +-- and 'endCommandBuffer' +-- +-- To ensure that 'endCommandBuffer' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +useCommandBuffer :: forall a io r . (PokeChain a, MonadIO io) => (io () -> io () -> r) -> CommandBuffer -> CommandBufferBeginInfo a -> r +useCommandBuffer b commandBuffer pBeginInfo = + b (beginCommandBuffer commandBuffer pBeginInfo) (endCommandBuffer commandBuffer) diff --git a/src/Graphics/Vulkan/Core10/CommandBufferBuilding.hs b/src/Graphics/Vulkan/Core10/CommandBufferBuilding.hs index 309979419..c28896d93 100644 --- a/src/Graphics/Vulkan/Core10/CommandBufferBuilding.hs +++ b/src/Graphics/Vulkan/Core10/CommandBufferBuilding.hs @@ -57,7 +57,6 @@ module Graphics.Vulkan.Core10.CommandBufferBuilding ( cmdBindPipeline , ClearAttachment(..) ) where -import Control.Exception.Base (bracket_) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Data.Typeable (eqT) @@ -6618,11 +6617,18 @@ cmdBeginQuery commandBuffer queryPool query flags = liftIO $ do vkCmdBeginQuery' (commandBufferHandle (commandBuffer)) (queryPool) (query) (flags) pure $ () --- | A safe wrapper for 'cmdBeginQuery' and 'cmdEndQuery' using 'bracket_' -cmdWithQuery :: forall r . CommandBuffer -> QueryPool -> Word32 -> QueryControlFlags -> IO r -> IO r -cmdWithQuery commandBuffer queryPool query flags = - bracket_ - (cmdBeginQuery commandBuffer queryPool query flags) +-- | A convenience wrapper to make a compatible pair of 'cmdBeginQuery' and +-- 'cmdEndQuery' +-- +-- To ensure that 'cmdEndQuery' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithQuery :: forall io r . MonadIO io => (io () -> io () -> r) -> CommandBuffer -> QueryPool -> Word32 -> QueryControlFlags -> r +cmdWithQuery b commandBuffer queryPool query flags = + b (cmdBeginQuery commandBuffer queryPool query flags) (cmdEndQuery commandBuffer queryPool query) @@ -7555,12 +7561,18 @@ cmdBeginRenderPass commandBuffer renderPassBegin contents = liftIO . evalContT $ lift $ vkCmdBeginRenderPass' (commandBufferHandle (commandBuffer)) pRenderPassBegin (contents) pure $ () --- | A safe wrapper for 'cmdBeginRenderPass' and 'cmdEndRenderPass' using --- 'bracket_' -cmdWithRenderPass :: forall a r . PokeChain a => CommandBuffer -> RenderPassBeginInfo a -> SubpassContents -> IO r -> IO r -cmdWithRenderPass commandBuffer pRenderPassBegin contents = - bracket_ - (cmdBeginRenderPass commandBuffer pRenderPassBegin contents) +-- | A convenience wrapper to make a compatible pair of 'cmdBeginRenderPass' +-- and 'cmdEndRenderPass' +-- +-- To ensure that 'cmdEndRenderPass' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithRenderPass :: forall a io r . (PokeChain a, MonadIO io) => (io () -> io () -> r) -> CommandBuffer -> RenderPassBeginInfo a -> SubpassContents -> r +cmdWithRenderPass b commandBuffer pRenderPassBegin contents = + b (cmdBeginRenderPass commandBuffer pRenderPassBegin contents) (cmdEndRenderPass commandBuffer) diff --git a/src/Graphics/Vulkan/Core10/CommandPool.hs b/src/Graphics/Vulkan/Core10/CommandPool.hs index 4b7b5db09..7c8ea44a5 100644 --- a/src/Graphics/Vulkan/Core10/CommandPool.hs +++ b/src/Graphics/Vulkan/Core10/CommandPool.hs @@ -127,14 +127,17 @@ createCommandPool device createInfo allocator = liftIO . evalContT $ do pCommandPool <- lift $ peek @CommandPool pPCommandPool pure $ (pCommandPool) --- | A safe wrapper for 'createCommandPool' and 'destroyCommandPool' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withCommandPool :: forall r . Device -> CommandPoolCreateInfo -> Maybe AllocationCallbacks -> ((CommandPool) -> IO r) -> IO r -withCommandPool device pCreateInfo pAllocator = - bracket - (createCommandPool device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createCommandPool' +-- and 'destroyCommandPool' +-- +-- To ensure that 'destroyCommandPool' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withCommandPool :: forall io r . MonadIO io => (io (CommandPool) -> ((CommandPool) -> io ()) -> r) -> Device -> CommandPoolCreateInfo -> Maybe AllocationCallbacks -> r +withCommandPool b device pCreateInfo pAllocator = + b (createCommandPool device pCreateInfo pAllocator) (\(o0) -> destroyCommandPool device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/DescriptorSet.hs b/src/Graphics/Vulkan/Core10/DescriptorSet.hs index d8db27d18..6fd997251 100644 --- a/src/Graphics/Vulkan/Core10/DescriptorSet.hs +++ b/src/Graphics/Vulkan/Core10/DescriptorSet.hs @@ -185,14 +185,17 @@ createDescriptorSetLayout device createInfo allocator = liftIO . evalContT $ do pSetLayout <- lift $ peek @DescriptorSetLayout pPSetLayout pure $ (pSetLayout) --- | A safe wrapper for 'createDescriptorSetLayout' and --- 'destroyDescriptorSetLayout' using 'bracket' --- --- The allocated value must not be returned from the provided computation -withDescriptorSetLayout :: forall a r . PokeChain a => Device -> DescriptorSetLayoutCreateInfo a -> Maybe AllocationCallbacks -> ((DescriptorSetLayout) -> IO r) -> IO r -withDescriptorSetLayout device pCreateInfo pAllocator = - bracket - (createDescriptorSetLayout device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createDescriptorSetLayout' and 'destroyDescriptorSetLayout' +-- +-- To ensure that 'destroyDescriptorSetLayout' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withDescriptorSetLayout :: forall a io r . (PokeChain a, MonadIO io) => (io (DescriptorSetLayout) -> ((DescriptorSetLayout) -> io ()) -> r) -> Device -> DescriptorSetLayoutCreateInfo a -> Maybe AllocationCallbacks -> r +withDescriptorSetLayout b device pCreateInfo pAllocator = + b (createDescriptorSetLayout device pCreateInfo pAllocator) (\(o0) -> destroyDescriptorSetLayout device o0 pAllocator) @@ -345,14 +348,17 @@ createDescriptorPool device createInfo allocator = liftIO . evalContT $ do pDescriptorPool <- lift $ peek @DescriptorPool pPDescriptorPool pure $ (pDescriptorPool) --- | A safe wrapper for 'createDescriptorPool' and 'destroyDescriptorPool' --- using 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'createDescriptorPool' and 'destroyDescriptorPool' -- --- The allocated value must not be returned from the provided computation -withDescriptorPool :: forall a r . PokeChain a => Device -> DescriptorPoolCreateInfo a -> Maybe AllocationCallbacks -> ((DescriptorPool) -> IO r) -> IO r -withDescriptorPool device pCreateInfo pAllocator = - bracket - (createDescriptorPool device pCreateInfo pAllocator) +-- To ensure that 'destroyDescriptorPool' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withDescriptorPool :: forall a io r . (PokeChain a, MonadIO io) => (io (DescriptorPool) -> ((DescriptorPool) -> io ()) -> r) -> Device -> DescriptorPoolCreateInfo a -> Maybe AllocationCallbacks -> r +withDescriptorPool b device pCreateInfo pAllocator = + b (createDescriptorPool device pCreateInfo pAllocator) (\(o0) -> destroyDescriptorPool device o0 pAllocator) @@ -630,14 +636,17 @@ allocateDescriptorSets device allocateInfo = liftIO . evalContT $ do pDescriptorSets <- lift $ generateM (fromIntegral . Data.Vector.length . setLayouts $ (allocateInfo)) (\i -> peek @DescriptorSet ((pPDescriptorSets `advancePtrBytes` (8 * (i)) :: Ptr DescriptorSet))) pure $ (pDescriptorSets) --- | A safe wrapper for 'allocateDescriptorSets' and 'freeDescriptorSets' --- using 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'allocateDescriptorSets' and 'freeDescriptorSets' +-- +-- To ensure that 'freeDescriptorSets' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. -- --- The allocated value must not be returned from the provided computation -withDescriptorSets :: forall a r . PokeChain a => Device -> DescriptorSetAllocateInfo a -> DescriptorPool -> ((Vector DescriptorSet) -> IO r) -> IO r -withDescriptorSets device pAllocateInfo descriptorPool = - bracket - (allocateDescriptorSets device pAllocateInfo) +withDescriptorSets :: forall a io r . (PokeChain a, MonadIO io) => (io (Vector DescriptorSet) -> ((Vector DescriptorSet) -> io ()) -> r) -> Device -> DescriptorSetAllocateInfo a -> DescriptorPool -> r +withDescriptorSets b device pAllocateInfo descriptorPool = + b (allocateDescriptorSets device pAllocateInfo) (\(o0) -> freeDescriptorSets device descriptorPool o0) diff --git a/src/Graphics/Vulkan/Core10/Device.hs b/src/Graphics/Vulkan/Core10/Device.hs index a67cded46..34a8a9139 100644 --- a/src/Graphics/Vulkan/Core10/Device.hs +++ b/src/Graphics/Vulkan/Core10/Device.hs @@ -259,13 +259,17 @@ createDevice physicalDevice createInfo allocator = liftIO . evalContT $ do pDevice' <- lift $ (\h -> Device h <$> initDeviceCmds cmds h) pDevice pure $ (pDevice') --- | A safe wrapper for 'createDevice' and 'destroyDevice' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'createDevice' and +-- 'destroyDevice' -- --- The allocated value must not be returned from the provided computation -withDevice :: forall a r . PokeChain a => PhysicalDevice -> DeviceCreateInfo a -> Maybe AllocationCallbacks -> ((Device) -> IO r) -> IO r -withDevice physicalDevice pCreateInfo pAllocator = - bracket - (createDevice physicalDevice pCreateInfo pAllocator) +-- To ensure that 'destroyDevice' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withDevice :: forall a io r . (PokeChain a, MonadIO io) => (io (Device) -> ((Device) -> io ()) -> r) -> PhysicalDevice -> DeviceCreateInfo a -> Maybe AllocationCallbacks -> r +withDevice b physicalDevice pCreateInfo pAllocator = + b (createDevice physicalDevice pCreateInfo pAllocator) (\(o0) -> destroyDevice o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/DeviceInitialization.hs b/src/Graphics/Vulkan/Core10/DeviceInitialization.hs index f52c5b532..97f755a0c 100644 --- a/src/Graphics/Vulkan/Core10/DeviceInitialization.hs +++ b/src/Graphics/Vulkan/Core10/DeviceInitialization.hs @@ -250,14 +250,17 @@ createInstance createInfo allocator = liftIO . evalContT $ do pInstance' <- lift $ (\h -> Instance h <$> initInstanceCmds h) pInstance pure $ (pInstance') --- | A safe wrapper for 'createInstance' and 'destroyInstance' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withInstance :: forall a r . PokeChain a => InstanceCreateInfo a -> Maybe AllocationCallbacks -> ((Instance) -> IO r) -> IO r -withInstance pCreateInfo pAllocator = - bracket - (createInstance pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createInstance' and +-- 'destroyInstance' +-- +-- To ensure that 'destroyInstance' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withInstance :: forall a io r . (PokeChain a, MonadIO io) => (io (Instance) -> ((Instance) -> io ()) -> r) -> InstanceCreateInfo a -> Maybe AllocationCallbacks -> r +withInstance b pCreateInfo pAllocator = + b (createInstance pCreateInfo pAllocator) (\(o0) -> destroyInstance o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Event.hs b/src/Graphics/Vulkan/Core10/Event.hs index ad96c3b95..475f313c9 100644 --- a/src/Graphics/Vulkan/Core10/Event.hs +++ b/src/Graphics/Vulkan/Core10/Event.hs @@ -126,13 +126,17 @@ createEvent device createInfo allocator = liftIO . evalContT $ do pEvent <- lift $ peek @Event pPEvent pure $ (pEvent) --- | A safe wrapper for 'createEvent' and 'destroyEvent' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'createEvent' and +-- 'destroyEvent' -- --- The allocated value must not be returned from the provided computation -withEvent :: forall r . Device -> EventCreateInfo -> Maybe AllocationCallbacks -> ((Event) -> IO r) -> IO r -withEvent device pCreateInfo pAllocator = - bracket - (createEvent device pCreateInfo pAllocator) +-- To ensure that 'destroyEvent' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withEvent :: forall io r . MonadIO io => (io (Event) -> ((Event) -> io ()) -> r) -> Device -> EventCreateInfo -> Maybe AllocationCallbacks -> r +withEvent b device pCreateInfo pAllocator = + b (createEvent device pCreateInfo pAllocator) (\(o0) -> destroyEvent device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Fence.hs b/src/Graphics/Vulkan/Core10/Fence.hs index 73340b310..1160cb567 100644 --- a/src/Graphics/Vulkan/Core10/Fence.hs +++ b/src/Graphics/Vulkan/Core10/Fence.hs @@ -140,13 +140,17 @@ createFence device createInfo allocator = liftIO . evalContT $ do pFence <- lift $ peek @Fence pPFence pure $ (pFence) --- | A safe wrapper for 'createFence' and 'destroyFence' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'createFence' and +-- 'destroyFence' -- --- The allocated value must not be returned from the provided computation -withFence :: forall a r . PokeChain a => Device -> FenceCreateInfo a -> Maybe AllocationCallbacks -> ((Fence) -> IO r) -> IO r -withFence device pCreateInfo pAllocator = - bracket - (createFence device pCreateInfo pAllocator) +-- To ensure that 'destroyFence' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withFence :: forall a io r . (PokeChain a, MonadIO io) => (io (Fence) -> ((Fence) -> io ()) -> r) -> Device -> FenceCreateInfo a -> Maybe AllocationCallbacks -> r +withFence b device pCreateInfo pAllocator = + b (createFence device pCreateInfo pAllocator) (\(o0) -> destroyFence device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Image.hs b/src/Graphics/Vulkan/Core10/Image.hs index 0bb807c93..82a7bcf15 100644 --- a/src/Graphics/Vulkan/Core10/Image.hs +++ b/src/Graphics/Vulkan/Core10/Image.hs @@ -164,13 +164,17 @@ createImage device createInfo allocator = liftIO . evalContT $ do pImage <- lift $ peek @Image pPImage pure $ (pImage) --- | A safe wrapper for 'createImage' and 'destroyImage' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'createImage' and +-- 'destroyImage' -- --- The allocated value must not be returned from the provided computation -withImage :: forall a r . PokeChain a => Device -> ImageCreateInfo a -> Maybe AllocationCallbacks -> ((Image) -> IO r) -> IO r -withImage device pCreateInfo pAllocator = - bracket - (createImage device pCreateInfo pAllocator) +-- To ensure that 'destroyImage' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withImage :: forall a io r . (PokeChain a, MonadIO io) => (io (Image) -> ((Image) -> io ()) -> r) -> Device -> ImageCreateInfo a -> Maybe AllocationCallbacks -> r +withImage b device pCreateInfo pAllocator = + b (createImage device pCreateInfo pAllocator) (\(o0) -> destroyImage device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/ImageView.hs b/src/Graphics/Vulkan/Core10/ImageView.hs index a0c2225a7..08b3a7353 100644 --- a/src/Graphics/Vulkan/Core10/ImageView.hs +++ b/src/Graphics/Vulkan/Core10/ImageView.hs @@ -135,14 +135,17 @@ createImageView device createInfo allocator = liftIO . evalContT $ do pView <- lift $ peek @ImageView pPView pure $ (pView) --- | A safe wrapper for 'createImageView' and 'destroyImageView' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withImageView :: forall a r . PokeChain a => Device -> ImageViewCreateInfo a -> Maybe AllocationCallbacks -> ((ImageView) -> IO r) -> IO r -withImageView device pCreateInfo pAllocator = - bracket - (createImageView device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createImageView' and +-- 'destroyImageView' +-- +-- To ensure that 'destroyImageView' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withImageView :: forall a io r . (PokeChain a, MonadIO io) => (io (ImageView) -> ((ImageView) -> io ()) -> r) -> Device -> ImageViewCreateInfo a -> Maybe AllocationCallbacks -> r +withImageView b device pCreateInfo pAllocator = + b (createImageView device pCreateInfo pAllocator) (\(o0) -> destroyImageView device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Memory.hs b/src/Graphics/Vulkan/Core10/Memory.hs index 3ad6c8ac9..fbc058381 100644 --- a/src/Graphics/Vulkan/Core10/Memory.hs +++ b/src/Graphics/Vulkan/Core10/Memory.hs @@ -241,13 +241,17 @@ allocateMemory device allocateInfo allocator = liftIO . evalContT $ do pMemory <- lift $ peek @DeviceMemory pPMemory pure $ (pMemory) --- | A safe wrapper for 'allocateMemory' and 'freeMemory' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'allocateMemory' and +-- 'freeMemory' -- --- The allocated value must not be returned from the provided computation -withMemory :: forall a r . PokeChain a => Device -> MemoryAllocateInfo a -> Maybe AllocationCallbacks -> ((DeviceMemory) -> IO r) -> IO r -withMemory device pAllocateInfo pAllocator = - bracket - (allocateMemory device pAllocateInfo pAllocator) +-- To ensure that 'freeMemory' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withMemory :: forall a io r . (PokeChain a, MonadIO io) => (io (DeviceMemory) -> ((DeviceMemory) -> io ()) -> r) -> Device -> MemoryAllocateInfo a -> Maybe AllocationCallbacks -> r +withMemory b device pAllocateInfo pAllocator = + b (allocateMemory device pAllocateInfo pAllocator) (\(o0) -> freeMemory device o0 pAllocator) @@ -485,13 +489,17 @@ mapMemory device memory offset size flags = liftIO . evalContT $ do ppData <- lift $ peek @(Ptr ()) pPpData pure $ (ppData) --- | A safe wrapper for 'mapMemory' and 'unmapMemory' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'mapMemory' and +-- 'unmapMemory' +-- +-- To ensure that 'unmapMemory' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. -- --- The allocated value must not be returned from the provided computation -withMappedMemory :: forall r . Device -> DeviceMemory -> DeviceSize -> DeviceSize -> MemoryMapFlags -> ((Ptr ()) -> IO r) -> IO r -withMappedMemory device memory offset size flags = - bracket - (mapMemory device memory offset size flags) +withMappedMemory :: forall io r . MonadIO io => (io (Ptr ()) -> ((Ptr ()) -> io ()) -> r) -> Device -> DeviceMemory -> DeviceSize -> DeviceSize -> MemoryMapFlags -> r +withMappedMemory b device memory offset size flags = + b (mapMemory device memory offset size flags) (\(_) -> unmapMemory device memory) diff --git a/src/Graphics/Vulkan/Core10/Pass.hs b/src/Graphics/Vulkan/Core10/Pass.hs index 053d059a1..c145e833e 100644 --- a/src/Graphics/Vulkan/Core10/Pass.hs +++ b/src/Graphics/Vulkan/Core10/Pass.hs @@ -179,14 +179,17 @@ createFramebuffer device createInfo allocator = liftIO . evalContT $ do pFramebuffer <- lift $ peek @Framebuffer pPFramebuffer pure $ (pFramebuffer) --- | A safe wrapper for 'createFramebuffer' and 'destroyFramebuffer' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withFramebuffer :: forall a r . PokeChain a => Device -> FramebufferCreateInfo a -> Maybe AllocationCallbacks -> ((Framebuffer) -> IO r) -> IO r -withFramebuffer device pCreateInfo pAllocator = - bracket - (createFramebuffer device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createFramebuffer' +-- and 'destroyFramebuffer' +-- +-- To ensure that 'destroyFramebuffer' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withFramebuffer :: forall a io r . (PokeChain a, MonadIO io) => (io (Framebuffer) -> ((Framebuffer) -> io ()) -> r) -> Device -> FramebufferCreateInfo a -> Maybe AllocationCallbacks -> r +withFramebuffer b device pCreateInfo pAllocator = + b (createFramebuffer device pCreateInfo pAllocator) (\(o0) -> destroyFramebuffer device o0 pAllocator) @@ -330,14 +333,17 @@ createRenderPass device createInfo allocator = liftIO . evalContT $ do pRenderPass <- lift $ peek @RenderPass pPRenderPass pure $ (pRenderPass) --- | A safe wrapper for 'createRenderPass' and 'destroyRenderPass' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withRenderPass :: forall a r . PokeChain a => Device -> RenderPassCreateInfo a -> Maybe AllocationCallbacks -> ((RenderPass) -> IO r) -> IO r -withRenderPass device pCreateInfo pAllocator = - bracket - (createRenderPass device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createRenderPass' +-- and 'destroyRenderPass' +-- +-- To ensure that 'destroyRenderPass' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withRenderPass :: forall a io r . (PokeChain a, MonadIO io) => (io (RenderPass) -> ((RenderPass) -> io ()) -> r) -> Device -> RenderPassCreateInfo a -> Maybe AllocationCallbacks -> r +withRenderPass b device pCreateInfo pAllocator = + b (createRenderPass device pCreateInfo pAllocator) (\(o0) -> destroyRenderPass device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Pipeline.hs b/src/Graphics/Vulkan/Core10/Pipeline.hs index f9d2ae484..755a357ca 100644 --- a/src/Graphics/Vulkan/Core10/Pipeline.hs +++ b/src/Graphics/Vulkan/Core10/Pipeline.hs @@ -293,14 +293,17 @@ createGraphicsPipelines device pipelineCache createInfos allocator = liftIO . ev pPipelines <- lift $ generateM (fromIntegral ((fromIntegral (Data.Vector.length $ (createInfos)) :: Word32))) (\i -> peek @Pipeline ((pPPipelines `advancePtrBytes` (8 * (i)) :: Ptr Pipeline))) pure $ (pPipelines) --- | A safe wrapper for 'createGraphicsPipelines' and 'destroyPipeline' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withGraphicsPipelines :: forall a r . PokeChain a => Device -> PipelineCache -> Vector (GraphicsPipelineCreateInfo a) -> Maybe AllocationCallbacks -> ((Vector Pipeline) -> IO r) -> IO r -withGraphicsPipelines device pipelineCache pCreateInfos pAllocator = - bracket - (createGraphicsPipelines device pipelineCache pCreateInfos pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createGraphicsPipelines' and 'destroyPipeline' +-- +-- To ensure that 'destroyPipeline' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withGraphicsPipelines :: forall a io r . (PokeChain a, MonadIO io) => (io (Vector Pipeline) -> ((Vector Pipeline) -> io ()) -> r) -> Device -> PipelineCache -> Vector (GraphicsPipelineCreateInfo a) -> Maybe AllocationCallbacks -> r +withGraphicsPipelines b device pipelineCache pCreateInfos pAllocator = + b (createGraphicsPipelines device pipelineCache pCreateInfos pAllocator) (\(o0) -> traverse_ (\o0Elem -> destroyPipeline device o0Elem pAllocator) o0) @@ -412,14 +415,17 @@ createComputePipelines device pipelineCache createInfos allocator = liftIO . eva pPipelines <- lift $ generateM (fromIntegral ((fromIntegral (Data.Vector.length $ (createInfos)) :: Word32))) (\i -> peek @Pipeline ((pPPipelines `advancePtrBytes` (8 * (i)) :: Ptr Pipeline))) pure $ (pPipelines) --- | A safe wrapper for 'createComputePipelines' and 'destroyPipeline' using --- 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'createComputePipelines' and 'destroyPipeline' +-- +-- To ensure that 'destroyPipeline' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. -- --- The allocated value must not be returned from the provided computation -withComputePipelines :: forall a r . PokeChain a => Device -> PipelineCache -> Vector (ComputePipelineCreateInfo a) -> Maybe AllocationCallbacks -> ((Vector Pipeline) -> IO r) -> IO r -withComputePipelines device pipelineCache pCreateInfos pAllocator = - bracket - (createComputePipelines device pipelineCache pCreateInfos pAllocator) +withComputePipelines :: forall a io r . (PokeChain a, MonadIO io) => (io (Vector Pipeline) -> ((Vector Pipeline) -> io ()) -> r) -> Device -> PipelineCache -> Vector (ComputePipelineCreateInfo a) -> Maybe AllocationCallbacks -> r +withComputePipelines b device pipelineCache pCreateInfos pAllocator = + b (createComputePipelines device pipelineCache pCreateInfos pAllocator) (\(o0) -> traverse_ (\o0Elem -> destroyPipeline device o0Elem pAllocator) o0) diff --git a/src/Graphics/Vulkan/Core10/PipelineCache.hs b/src/Graphics/Vulkan/Core10/PipelineCache.hs index f57e9a969..e4e0d110a 100644 --- a/src/Graphics/Vulkan/Core10/PipelineCache.hs +++ b/src/Graphics/Vulkan/Core10/PipelineCache.hs @@ -164,14 +164,17 @@ createPipelineCache device createInfo allocator = liftIO . evalContT $ do pPipelineCache <- lift $ peek @PipelineCache pPPipelineCache pure $ (pPipelineCache) --- | A safe wrapper for 'createPipelineCache' and 'destroyPipelineCache' --- using 'bracket' --- --- The allocated value must not be returned from the provided computation -withPipelineCache :: forall r . Device -> PipelineCacheCreateInfo -> Maybe AllocationCallbacks -> ((PipelineCache) -> IO r) -> IO r -withPipelineCache device pCreateInfo pAllocator = - bracket - (createPipelineCache device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createPipelineCache' +-- and 'destroyPipelineCache' +-- +-- To ensure that 'destroyPipelineCache' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withPipelineCache :: forall io r . MonadIO io => (io (PipelineCache) -> ((PipelineCache) -> io ()) -> r) -> Device -> PipelineCacheCreateInfo -> Maybe AllocationCallbacks -> r +withPipelineCache b device pCreateInfo pAllocator = + b (createPipelineCache device pCreateInfo pAllocator) (\(o0) -> destroyPipelineCache device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/PipelineLayout.hs b/src/Graphics/Vulkan/Core10/PipelineLayout.hs index 3e9164b7a..746119f7e 100644 --- a/src/Graphics/Vulkan/Core10/PipelineLayout.hs +++ b/src/Graphics/Vulkan/Core10/PipelineLayout.hs @@ -127,14 +127,17 @@ createPipelineLayout device createInfo allocator = liftIO . evalContT $ do pPipelineLayout <- lift $ peek @PipelineLayout pPPipelineLayout pure $ (pPipelineLayout) --- | A safe wrapper for 'createPipelineLayout' and 'destroyPipelineLayout' --- using 'bracket' --- --- The allocated value must not be returned from the provided computation -withPipelineLayout :: forall r . Device -> PipelineLayoutCreateInfo -> Maybe AllocationCallbacks -> ((PipelineLayout) -> IO r) -> IO r -withPipelineLayout device pCreateInfo pAllocator = - bracket - (createPipelineLayout device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createPipelineLayout' and 'destroyPipelineLayout' +-- +-- To ensure that 'destroyPipelineLayout' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withPipelineLayout :: forall io r . MonadIO io => (io (PipelineLayout) -> ((PipelineLayout) -> io ()) -> r) -> Device -> PipelineLayoutCreateInfo -> Maybe AllocationCallbacks -> r +withPipelineLayout b device pCreateInfo pAllocator = + b (createPipelineLayout device pCreateInfo pAllocator) (\(o0) -> destroyPipelineLayout device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Query.hs b/src/Graphics/Vulkan/Core10/Query.hs index 3b408d500..c15d0532d 100644 --- a/src/Graphics/Vulkan/Core10/Query.hs +++ b/src/Graphics/Vulkan/Core10/Query.hs @@ -139,14 +139,17 @@ createQueryPool device createInfo allocator = liftIO . evalContT $ do pQueryPool <- lift $ peek @QueryPool pPQueryPool pure $ (pQueryPool) --- | A safe wrapper for 'createQueryPool' and 'destroyQueryPool' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withQueryPool :: forall a r . PokeChain a => Device -> QueryPoolCreateInfo a -> Maybe AllocationCallbacks -> ((QueryPool) -> IO r) -> IO r -withQueryPool device pCreateInfo pAllocator = - bracket - (createQueryPool device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createQueryPool' and +-- 'destroyQueryPool' +-- +-- To ensure that 'destroyQueryPool' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withQueryPool :: forall a io r . (PokeChain a, MonadIO io) => (io (QueryPool) -> ((QueryPool) -> io ()) -> r) -> Device -> QueryPoolCreateInfo a -> Maybe AllocationCallbacks -> r +withQueryPool b device pCreateInfo pAllocator = + b (createQueryPool device pCreateInfo pAllocator) (\(o0) -> destroyQueryPool device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/QueueSemaphore.hs b/src/Graphics/Vulkan/Core10/QueueSemaphore.hs index db3d78f65..7427a2d62 100644 --- a/src/Graphics/Vulkan/Core10/QueueSemaphore.hs +++ b/src/Graphics/Vulkan/Core10/QueueSemaphore.hs @@ -127,14 +127,17 @@ createSemaphore device createInfo allocator = liftIO . evalContT $ do pSemaphore <- lift $ peek @Semaphore pPSemaphore pure $ (pSemaphore) --- | A safe wrapper for 'createSemaphore' and 'destroySemaphore' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withSemaphore :: forall a r . PokeChain a => Device -> SemaphoreCreateInfo a -> Maybe AllocationCallbacks -> ((Semaphore) -> IO r) -> IO r -withSemaphore device pCreateInfo pAllocator = - bracket - (createSemaphore device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createSemaphore' and +-- 'destroySemaphore' +-- +-- To ensure that 'destroySemaphore' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withSemaphore :: forall a io r . (PokeChain a, MonadIO io) => (io (Semaphore) -> ((Semaphore) -> io ()) -> r) -> Device -> SemaphoreCreateInfo a -> Maybe AllocationCallbacks -> r +withSemaphore b device pCreateInfo pAllocator = + b (createSemaphore device pCreateInfo pAllocator) (\(o0) -> destroySemaphore device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Sampler.hs b/src/Graphics/Vulkan/Core10/Sampler.hs index 4eab31366..9eb4fbf28 100644 --- a/src/Graphics/Vulkan/Core10/Sampler.hs +++ b/src/Graphics/Vulkan/Core10/Sampler.hs @@ -139,13 +139,17 @@ createSampler device createInfo allocator = liftIO . evalContT $ do pSampler <- lift $ peek @Sampler pPSampler pure $ (pSampler) --- | A safe wrapper for 'createSampler' and 'destroySampler' using 'bracket' +-- | A convenience wrapper to make a compatible pair of 'createSampler' and +-- 'destroySampler' -- --- The allocated value must not be returned from the provided computation -withSampler :: forall a r . PokeChain a => Device -> SamplerCreateInfo a -> Maybe AllocationCallbacks -> ((Sampler) -> IO r) -> IO r -withSampler device pCreateInfo pAllocator = - bracket - (createSampler device pCreateInfo pAllocator) +-- To ensure that 'destroySampler' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withSampler :: forall a io r . (PokeChain a, MonadIO io) => (io (Sampler) -> ((Sampler) -> io ()) -> r) -> Device -> SamplerCreateInfo a -> Maybe AllocationCallbacks -> r +withSampler b device pCreateInfo pAllocator = + b (createSampler device pCreateInfo pAllocator) (\(o0) -> destroySampler device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core10/Shader.hs b/src/Graphics/Vulkan/Core10/Shader.hs index f8a710704..1126b1d03 100644 --- a/src/Graphics/Vulkan/Core10/Shader.hs +++ b/src/Graphics/Vulkan/Core10/Shader.hs @@ -156,14 +156,17 @@ createShaderModule device createInfo allocator = liftIO . evalContT $ do pShaderModule <- lift $ peek @ShaderModule pPShaderModule pure $ (pShaderModule) --- | A safe wrapper for 'createShaderModule' and 'destroyShaderModule' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withShaderModule :: forall a r . PokeChain a => Device -> ShaderModuleCreateInfo a -> Maybe AllocationCallbacks -> ((ShaderModule) -> IO r) -> IO r -withShaderModule device pCreateInfo pAllocator = - bracket - (createShaderModule device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createShaderModule' +-- and 'destroyShaderModule' +-- +-- To ensure that 'destroyShaderModule' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withShaderModule :: forall a io r . (PokeChain a, MonadIO io) => (io (ShaderModule) -> ((ShaderModule) -> io ()) -> r) -> Device -> ShaderModuleCreateInfo a -> Maybe AllocationCallbacks -> r +withShaderModule b device pCreateInfo pAllocator = + b (createShaderModule device pCreateInfo pAllocator) (\(o0) -> destroyShaderModule device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_descriptor_update_template.hs b/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_descriptor_update_template.hs index 85ff806b3..73b7bcdb1 100644 --- a/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_descriptor_update_template.hs +++ b/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_descriptor_update_template.hs @@ -152,14 +152,17 @@ createDescriptorUpdateTemplate device createInfo allocator = liftIO . evalContT pDescriptorUpdateTemplate <- lift $ peek @DescriptorUpdateTemplate pPDescriptorUpdateTemplate pure $ (pDescriptorUpdateTemplate) --- | A safe wrapper for 'createDescriptorUpdateTemplate' and --- 'destroyDescriptorUpdateTemplate' using 'bracket' --- --- The allocated value must not be returned from the provided computation -withDescriptorUpdateTemplate :: forall r . Device -> DescriptorUpdateTemplateCreateInfo -> Maybe AllocationCallbacks -> ((DescriptorUpdateTemplate) -> IO r) -> IO r -withDescriptorUpdateTemplate device pCreateInfo pAllocator = - bracket - (createDescriptorUpdateTemplate device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createDescriptorUpdateTemplate' and 'destroyDescriptorUpdateTemplate' +-- +-- To ensure that 'destroyDescriptorUpdateTemplate' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withDescriptorUpdateTemplate :: forall io r . MonadIO io => (io (DescriptorUpdateTemplate) -> ((DescriptorUpdateTemplate) -> io ()) -> r) -> Device -> DescriptorUpdateTemplateCreateInfo -> Maybe AllocationCallbacks -> r +withDescriptorUpdateTemplate b device pCreateInfo pAllocator = + b (createDescriptorUpdateTemplate device pCreateInfo pAllocator) (\(o0) -> destroyDescriptorUpdateTemplate device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_sampler_ycbcr_conversion.hs b/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_sampler_ycbcr_conversion.hs index bec21bc4f..559ce716d 100644 --- a/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_sampler_ycbcr_conversion.hs +++ b/src/Graphics/Vulkan/Core11/Promoted_From_VK_KHR_sampler_ycbcr_conversion.hs @@ -191,14 +191,17 @@ createSamplerYcbcrConversion device createInfo allocator = liftIO . evalContT $ pYcbcrConversion <- lift $ peek @SamplerYcbcrConversion pPYcbcrConversion pure $ (pYcbcrConversion) --- | A safe wrapper for 'createSamplerYcbcrConversion' and --- 'destroySamplerYcbcrConversion' using 'bracket' --- --- The allocated value must not be returned from the provided computation -withSamplerYcbcrConversion :: forall a r . PokeChain a => Device -> SamplerYcbcrConversionCreateInfo a -> Maybe AllocationCallbacks -> ((SamplerYcbcrConversion) -> IO r) -> IO r -withSamplerYcbcrConversion device pCreateInfo pAllocator = - bracket - (createSamplerYcbcrConversion device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createSamplerYcbcrConversion' and 'destroySamplerYcbcrConversion' +-- +-- To ensure that 'destroySamplerYcbcrConversion' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withSamplerYcbcrConversion :: forall a io r . (PokeChain a, MonadIO io) => (io (SamplerYcbcrConversion) -> ((SamplerYcbcrConversion) -> io ()) -> r) -> Device -> SamplerYcbcrConversionCreateInfo a -> Maybe AllocationCallbacks -> r +withSamplerYcbcrConversion b device pCreateInfo pAllocator = + b (createSamplerYcbcrConversion device pCreateInfo pAllocator) (\(o0) -> destroySamplerYcbcrConversion device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Core12/Promoted_From_VK_KHR_create_renderpass2.hs b/src/Graphics/Vulkan/Core12/Promoted_From_VK_KHR_create_renderpass2.hs index f333328df..b9c441699 100644 --- a/src/Graphics/Vulkan/Core12/Promoted_From_VK_KHR_create_renderpass2.hs +++ b/src/Graphics/Vulkan/Core12/Promoted_From_VK_KHR_create_renderpass2.hs @@ -15,7 +15,6 @@ module Graphics.Vulkan.Core12.Promoted_From_VK_KHR_create_renderpass2 ( createR ) where import Control.Exception.Base (bracket) -import Control.Exception.Base (bracket_) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Data.Typeable (eqT) @@ -405,12 +404,18 @@ cmdBeginRenderPass2 commandBuffer renderPassBegin subpassBeginInfo = liftIO . ev lift $ vkCmdBeginRenderPass2' (commandBufferHandle (commandBuffer)) pRenderPassBegin pSubpassBeginInfo pure $ () --- | A safe wrapper for 'cmdBeginRenderPass2' and 'cmdEndRenderPass2' using --- 'bracket_' -cmdWithRenderPass2 :: forall a r . PokeChain a => CommandBuffer -> RenderPassBeginInfo a -> SubpassBeginInfo -> SubpassEndInfo -> IO r -> IO r -cmdWithRenderPass2 commandBuffer pRenderPassBegin pSubpassBeginInfo pSubpassEndInfo = - bracket_ - (cmdBeginRenderPass2 commandBuffer pRenderPassBegin pSubpassBeginInfo) +-- | A convenience wrapper to make a compatible pair of 'cmdBeginRenderPass2' +-- and 'cmdEndRenderPass2' +-- +-- To ensure that 'cmdEndRenderPass2' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithRenderPass2 :: forall a io r . (PokeChain a, MonadIO io) => (io () -> io () -> r) -> CommandBuffer -> RenderPassBeginInfo a -> SubpassBeginInfo -> SubpassEndInfo -> r +cmdWithRenderPass2 b commandBuffer pRenderPassBegin pSubpassBeginInfo pSubpassEndInfo = + b (cmdBeginRenderPass2 commandBuffer pRenderPassBegin pSubpassBeginInfo) (cmdEndRenderPass2 commandBuffer pSubpassEndInfo) diff --git a/src/Graphics/Vulkan/Extensions/VK_EXT_conditional_rendering.hs b/src/Graphics/Vulkan/Extensions/VK_EXT_conditional_rendering.hs index 5c767bb9d..315182529 100644 --- a/src/Graphics/Vulkan/Extensions/VK_EXT_conditional_rendering.hs +++ b/src/Graphics/Vulkan/Extensions/VK_EXT_conditional_rendering.hs @@ -15,7 +15,6 @@ module Graphics.Vulkan.Extensions.VK_EXT_conditional_rendering ( cmdBeginCondit , pattern EXT_CONDITIONAL_RENDERING_EXTENSION_NAME ) where -import Control.Exception.Base (bracket_) import Control.Monad.IO.Class (liftIO) import Foreign.Marshal.Alloc (allocaBytesAligned) import Foreign.Ptr (nullPtr) @@ -134,12 +133,18 @@ cmdBeginConditionalRenderingEXT commandBuffer conditionalRenderingBegin = liftIO lift $ vkCmdBeginConditionalRenderingEXT' (commandBufferHandle (commandBuffer)) pConditionalRenderingBegin pure $ () --- | A safe wrapper for 'cmdBeginConditionalRenderingEXT' and --- 'cmdEndConditionalRenderingEXT' using 'bracket_' -cmdWithConditionalRenderingEXT :: forall r . CommandBuffer -> ConditionalRenderingBeginInfoEXT -> IO r -> IO r -cmdWithConditionalRenderingEXT commandBuffer pConditionalRenderingBegin = - bracket_ - (cmdBeginConditionalRenderingEXT commandBuffer pConditionalRenderingBegin) +-- | A convenience wrapper to make a compatible pair of +-- 'cmdBeginConditionalRenderingEXT' and 'cmdEndConditionalRenderingEXT' +-- +-- To ensure that 'cmdEndConditionalRenderingEXT' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithConditionalRenderingEXT :: forall io r . MonadIO io => (io () -> io () -> r) -> CommandBuffer -> ConditionalRenderingBeginInfoEXT -> r +cmdWithConditionalRenderingEXT b commandBuffer pConditionalRenderingBegin = + b (cmdBeginConditionalRenderingEXT commandBuffer pConditionalRenderingBegin) (cmdEndConditionalRenderingEXT commandBuffer) diff --git a/src/Graphics/Vulkan/Extensions/VK_EXT_debug_report.hs b/src/Graphics/Vulkan/Extensions/VK_EXT_debug_report.hs index 589a2d368..a9256e735 100644 --- a/src/Graphics/Vulkan/Extensions/VK_EXT_debug_report.hs +++ b/src/Graphics/Vulkan/Extensions/VK_EXT_debug_report.hs @@ -200,14 +200,17 @@ createDebugReportCallbackEXT instance' createInfo allocator = liftIO . evalContT pCallback <- lift $ peek @DebugReportCallbackEXT pPCallback pure $ (pCallback) --- | A safe wrapper for 'createDebugReportCallbackEXT' and --- 'destroyDebugReportCallbackEXT' using 'bracket' --- --- The allocated value must not be returned from the provided computation -withDebugReportCallbackEXT :: forall r . Instance -> DebugReportCallbackCreateInfoEXT -> Maybe AllocationCallbacks -> ((DebugReportCallbackEXT) -> IO r) -> IO r -withDebugReportCallbackEXT instance' pCreateInfo pAllocator = - bracket - (createDebugReportCallbackEXT instance' pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createDebugReportCallbackEXT' and 'destroyDebugReportCallbackEXT' +-- +-- To ensure that 'destroyDebugReportCallbackEXT' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withDebugReportCallbackEXT :: forall io r . MonadIO io => (io (DebugReportCallbackEXT) -> ((DebugReportCallbackEXT) -> io ()) -> r) -> Instance -> DebugReportCallbackCreateInfoEXT -> Maybe AllocationCallbacks -> r +withDebugReportCallbackEXT b instance' pCreateInfo pAllocator = + b (createDebugReportCallbackEXT instance' pCreateInfo pAllocator) (\(o0) -> destroyDebugReportCallbackEXT instance' o0 pAllocator) diff --git a/src/Graphics/Vulkan/Extensions/VK_EXT_debug_utils.hs b/src/Graphics/Vulkan/Extensions/VK_EXT_debug_utils.hs index a58000ddb..9b5dc8676 100644 --- a/src/Graphics/Vulkan/Extensions/VK_EXT_debug_utils.hs +++ b/src/Graphics/Vulkan/Extensions/VK_EXT_debug_utils.hs @@ -42,7 +42,6 @@ module Graphics.Vulkan.Extensions.VK_EXT_debug_utils ( setDebugUtilsObjectNameE ) where import Control.Exception.Base (bracket) -import Control.Exception.Base (bracket_) import Control.Monad.IO.Class (liftIO) import Foreign.Marshal.Alloc (allocaBytesAligned) import Foreign.Marshal.Alloc (callocBytes) @@ -434,12 +433,18 @@ cmdBeginDebugUtilsLabelEXT commandBuffer labelInfo = liftIO . evalContT $ do lift $ vkCmdBeginDebugUtilsLabelEXT' (commandBufferHandle (commandBuffer)) pLabelInfo pure $ () --- | A safe wrapper for 'cmdBeginDebugUtilsLabelEXT' and --- 'cmdEndDebugUtilsLabelEXT' using 'bracket_' -cmdWithDebugUtilsLabelEXT :: forall r . CommandBuffer -> DebugUtilsLabelEXT -> IO r -> IO r -cmdWithDebugUtilsLabelEXT commandBuffer pLabelInfo = - bracket_ - (cmdBeginDebugUtilsLabelEXT commandBuffer pLabelInfo) +-- | A convenience wrapper to make a compatible pair of +-- 'cmdBeginDebugUtilsLabelEXT' and 'cmdEndDebugUtilsLabelEXT' +-- +-- To ensure that 'cmdEndDebugUtilsLabelEXT' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithDebugUtilsLabelEXT :: forall io r . MonadIO io => (io () -> io () -> r) -> CommandBuffer -> DebugUtilsLabelEXT -> r +cmdWithDebugUtilsLabelEXT b commandBuffer pLabelInfo = + b (cmdBeginDebugUtilsLabelEXT commandBuffer pLabelInfo) (cmdEndDebugUtilsLabelEXT commandBuffer) @@ -648,14 +653,17 @@ createDebugUtilsMessengerEXT instance' createInfo allocator = liftIO . evalContT pMessenger <- lift $ peek @DebugUtilsMessengerEXT pPMessenger pure $ (pMessenger) --- | A safe wrapper for 'createDebugUtilsMessengerEXT' and --- 'destroyDebugUtilsMessengerEXT' using 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'createDebugUtilsMessengerEXT' and 'destroyDebugUtilsMessengerEXT' +-- +-- To ensure that 'destroyDebugUtilsMessengerEXT' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. -- --- The allocated value must not be returned from the provided computation -withDebugUtilsMessengerEXT :: forall r . Instance -> DebugUtilsMessengerCreateInfoEXT -> Maybe AllocationCallbacks -> ((DebugUtilsMessengerEXT) -> IO r) -> IO r -withDebugUtilsMessengerEXT instance' pCreateInfo pAllocator = - bracket - (createDebugUtilsMessengerEXT instance' pCreateInfo pAllocator) +withDebugUtilsMessengerEXT :: forall io r . MonadIO io => (io (DebugUtilsMessengerEXT) -> ((DebugUtilsMessengerEXT) -> io ()) -> r) -> Instance -> DebugUtilsMessengerCreateInfoEXT -> Maybe AllocationCallbacks -> r +withDebugUtilsMessengerEXT b instance' pCreateInfo pAllocator = + b (createDebugUtilsMessengerEXT instance' pCreateInfo pAllocator) (\(o0) -> destroyDebugUtilsMessengerEXT instance' o0 pAllocator) diff --git a/src/Graphics/Vulkan/Extensions/VK_EXT_transform_feedback.hs b/src/Graphics/Vulkan/Extensions/VK_EXT_transform_feedback.hs index 260ea219e..96a1cae2c 100644 --- a/src/Graphics/Vulkan/Extensions/VK_EXT_transform_feedback.hs +++ b/src/Graphics/Vulkan/Extensions/VK_EXT_transform_feedback.hs @@ -17,7 +17,6 @@ module Graphics.Vulkan.Extensions.VK_EXT_transform_feedback ( cmdBindTransformF , pattern EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME ) where -import Control.Exception.Base (bracket_) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Foreign.Marshal.Alloc (allocaBytesAligned) @@ -396,12 +395,18 @@ cmdBeginTransformFeedbackEXT commandBuffer firstCounterBuffer counterBuffers cou lift $ vkCmdBeginTransformFeedbackEXT' (commandBufferHandle (commandBuffer)) (firstCounterBuffer) ((fromIntegral pCounterBuffersLength :: Word32)) (pPCounterBuffers) pCounterBufferOffsets pure $ () --- | A safe wrapper for 'cmdBeginTransformFeedbackEXT' and --- 'cmdEndTransformFeedbackEXT' using 'bracket_' -cmdWithTransformFeedbackEXT :: forall r . CommandBuffer -> Word32 -> Vector Buffer -> Either Word32 (Vector DeviceSize) -> IO r -> IO r -cmdWithTransformFeedbackEXT commandBuffer firstCounterBuffer pCounterBuffers pCounterBufferOffsets = - bracket_ - (cmdBeginTransformFeedbackEXT commandBuffer firstCounterBuffer pCounterBuffers pCounterBufferOffsets) +-- | A convenience wrapper to make a compatible pair of +-- 'cmdBeginTransformFeedbackEXT' and 'cmdEndTransformFeedbackEXT' +-- +-- To ensure that 'cmdEndTransformFeedbackEXT' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithTransformFeedbackEXT :: forall io r . MonadIO io => (io () -> io () -> r) -> CommandBuffer -> Word32 -> Vector Buffer -> Either Word32 (Vector DeviceSize) -> r +cmdWithTransformFeedbackEXT b commandBuffer firstCounterBuffer pCounterBuffers pCounterBufferOffsets = + b (cmdBeginTransformFeedbackEXT commandBuffer firstCounterBuffer pCounterBuffers pCounterBufferOffsets) (cmdEndTransformFeedbackEXT commandBuffer firstCounterBuffer pCounterBuffers pCounterBufferOffsets) @@ -737,12 +742,18 @@ cmdBeginQueryIndexedEXT commandBuffer queryPool query flags index = liftIO $ do vkCmdBeginQueryIndexedEXT' (commandBufferHandle (commandBuffer)) (queryPool) (query) (flags) (index) pure $ () --- | A safe wrapper for 'cmdBeginQueryIndexedEXT' and 'cmdEndQueryIndexedEXT' --- using 'bracket_' -cmdWithQueryIndexedEXT :: forall r . CommandBuffer -> QueryPool -> Word32 -> QueryControlFlags -> Word32 -> IO r -> IO r -cmdWithQueryIndexedEXT commandBuffer queryPool query flags index = - bracket_ - (cmdBeginQueryIndexedEXT commandBuffer queryPool query flags index) +-- | A convenience wrapper to make a compatible pair of +-- 'cmdBeginQueryIndexedEXT' and 'cmdEndQueryIndexedEXT' +-- +-- To ensure that 'cmdEndQueryIndexedEXT' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +cmdWithQueryIndexedEXT :: forall io r . MonadIO io => (io () -> io () -> r) -> CommandBuffer -> QueryPool -> Word32 -> QueryControlFlags -> Word32 -> r +cmdWithQueryIndexedEXT b commandBuffer queryPool query flags index = + b (cmdBeginQueryIndexedEXT commandBuffer queryPool query flags index) (cmdEndQueryIndexedEXT commandBuffer queryPool query index) diff --git a/src/Graphics/Vulkan/Extensions/VK_EXT_validation_cache.hs b/src/Graphics/Vulkan/Extensions/VK_EXT_validation_cache.hs index 57829a398..0c18d4b8a 100644 --- a/src/Graphics/Vulkan/Extensions/VK_EXT_validation_cache.hs +++ b/src/Graphics/Vulkan/Extensions/VK_EXT_validation_cache.hs @@ -193,14 +193,17 @@ createValidationCacheEXT device createInfo allocator = liftIO . evalContT $ do pValidationCache <- lift $ peek @ValidationCacheEXT pPValidationCache pure $ (pValidationCache) --- | A safe wrapper for 'createValidationCacheEXT' and --- 'destroyValidationCacheEXT' using 'bracket' --- --- The allocated value must not be returned from the provided computation -withValidationCacheEXT :: forall r . Device -> ValidationCacheCreateInfoEXT -> Maybe AllocationCallbacks -> ((ValidationCacheEXT) -> IO r) -> IO r -withValidationCacheEXT device pCreateInfo pAllocator = - bracket - (createValidationCacheEXT device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createValidationCacheEXT' and 'destroyValidationCacheEXT' +-- +-- To ensure that 'destroyValidationCacheEXT' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withValidationCacheEXT :: forall io r . MonadIO io => (io (ValidationCacheEXT) -> ((ValidationCacheEXT) -> io ()) -> r) -> Device -> ValidationCacheCreateInfoEXT -> Maybe AllocationCallbacks -> r +withValidationCacheEXT b device pCreateInfo pAllocator = + b (createValidationCacheEXT device pCreateInfo pAllocator) (\(o0) -> destroyValidationCacheEXT device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Extensions/VK_KHR_swapchain.hs b/src/Graphics/Vulkan/Extensions/VK_KHR_swapchain.hs index 1e2315d0c..b5af484fb 100644 --- a/src/Graphics/Vulkan/Extensions/VK_KHR_swapchain.hs +++ b/src/Graphics/Vulkan/Extensions/VK_KHR_swapchain.hs @@ -297,14 +297,17 @@ createSwapchainKHR device createInfo allocator = liftIO . evalContT $ do pSwapchain <- lift $ peek @SwapchainKHR pPSwapchain pure $ (pSwapchain) --- | A safe wrapper for 'createSwapchainKHR' and 'destroySwapchainKHR' using --- 'bracket' --- --- The allocated value must not be returned from the provided computation -withSwapchainKHR :: forall a r . PokeChain a => Device -> SwapchainCreateInfoKHR a -> Maybe AllocationCallbacks -> ((SwapchainKHR) -> IO r) -> IO r -withSwapchainKHR device pCreateInfo pAllocator = - bracket - (createSwapchainKHR device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of 'createSwapchainKHR' +-- and 'destroySwapchainKHR' +-- +-- To ensure that 'destroySwapchainKHR' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withSwapchainKHR :: forall a io r . (PokeChain a, MonadIO io) => (io (SwapchainKHR) -> ((SwapchainKHR) -> io ()) -> r) -> Device -> SwapchainCreateInfoKHR a -> Maybe AllocationCallbacks -> r +withSwapchainKHR b device pCreateInfo pAllocator = + b (createSwapchainKHR device pCreateInfo pAllocator) (\(o0) -> destroySwapchainKHR device o0 pAllocator) diff --git a/src/Graphics/Vulkan/Extensions/VK_NVX_device_generated_commands.hs b/src/Graphics/Vulkan/Extensions/VK_NVX_device_generated_commands.hs index 64bfc587a..e43b94fff 100644 --- a/src/Graphics/Vulkan/Extensions/VK_NVX_device_generated_commands.hs +++ b/src/Graphics/Vulkan/Extensions/VK_NVX_device_generated_commands.hs @@ -63,7 +63,6 @@ module Graphics.Vulkan.Extensions.VK_NVX_device_generated_commands ( cmdProcess ) where import Control.Exception.Base (bracket) -import Control.Exception.Base (bracket_) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Foreign.Marshal.Alloc (allocaBytesAligned) @@ -382,14 +381,17 @@ createIndirectCommandsLayoutNVX device createInfo allocator = liftIO . evalContT pIndirectCommandsLayout <- lift $ peek @IndirectCommandsLayoutNVX pPIndirectCommandsLayout pure $ (pIndirectCommandsLayout) --- | A safe wrapper for 'createIndirectCommandsLayoutNVX' and --- 'destroyIndirectCommandsLayoutNVX' using 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'createIndirectCommandsLayoutNVX' and 'destroyIndirectCommandsLayoutNVX' -- --- The allocated value must not be returned from the provided computation -withIndirectCommandsLayoutNVX :: forall r . Device -> IndirectCommandsLayoutCreateInfoNVX -> Maybe AllocationCallbacks -> ((IndirectCommandsLayoutNVX) -> IO r) -> IO r -withIndirectCommandsLayoutNVX device pCreateInfo pAllocator = - bracket - (createIndirectCommandsLayoutNVX device pCreateInfo pAllocator) +-- To ensure that 'destroyIndirectCommandsLayoutNVX' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withIndirectCommandsLayoutNVX :: forall io r . MonadIO io => (io (IndirectCommandsLayoutNVX) -> ((IndirectCommandsLayoutNVX) -> io ()) -> r) -> Device -> IndirectCommandsLayoutCreateInfoNVX -> Maybe AllocationCallbacks -> r +withIndirectCommandsLayoutNVX b device pCreateInfo pAllocator = + b (createIndirectCommandsLayoutNVX device pCreateInfo pAllocator) (\(o0) -> destroyIndirectCommandsLayoutNVX device o0 pAllocator) @@ -528,14 +530,17 @@ createObjectTableNVX device createInfo allocator = liftIO . evalContT $ do pObjectTable <- lift $ peek @ObjectTableNVX pPObjectTable pure $ (pObjectTable) --- | A safe wrapper for 'createObjectTableNVX' and 'destroyObjectTableNVX' --- using 'bracket' +-- | A convenience wrapper to make a compatible pair of +-- 'createObjectTableNVX' and 'destroyObjectTableNVX' +-- +-- To ensure that 'destroyObjectTableNVX' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. -- --- The allocated value must not be returned from the provided computation -withObjectTableNVX :: forall r . Device -> ObjectTableCreateInfoNVX -> Maybe AllocationCallbacks -> ((ObjectTableNVX) -> IO r) -> IO r -withObjectTableNVX device pCreateInfo pAllocator = - bracket - (createObjectTableNVX device pCreateInfo pAllocator) +withObjectTableNVX :: forall io r . MonadIO io => (io (ObjectTableNVX) -> ((ObjectTableNVX) -> io ()) -> r) -> Device -> ObjectTableCreateInfoNVX -> Maybe AllocationCallbacks -> r +withObjectTableNVX b device pCreateInfo pAllocator = + b (createObjectTableNVX device pCreateInfo pAllocator) (\(o0) -> destroyObjectTableNVX device o0 pAllocator) @@ -700,12 +705,18 @@ registerObjectsNVX device objectTable objectTableEntries objectIndices = liftIO r <- lift $ vkRegisterObjectsNVX' (deviceHandle (device)) (objectTable) ((fromIntegral ppObjectTableEntriesLength :: Word32)) (pPpObjectTableEntries) (pPObjectIndices) lift $ when (r < SUCCESS) (throwIO (VulkanException r)) --- | A safe wrapper for 'registerObjectsNVX' and 'unregisterObjectsNVX' using --- 'bracket_' -withRegisteredObjectsNVX :: forall r . Device -> ObjectTableNVX -> Vector ObjectTableEntryNVX -> Vector Word32 -> Vector ObjectEntryTypeNVX -> IO r -> IO r -withRegisteredObjectsNVX device objectTable ppObjectTableEntries pObjectIndices pObjectEntryTypes = - bracket_ - (registerObjectsNVX device objectTable ppObjectTableEntries pObjectIndices) +-- | A convenience wrapper to make a compatible pair of 'registerObjectsNVX' +-- and 'unregisterObjectsNVX' +-- +-- To ensure that 'unregisterObjectsNVX' is always called: pass +-- 'Control.Exception.bracket_' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +-- Note that there is no inner resource +withRegisteredObjectsNVX :: forall io r . MonadIO io => (io () -> io () -> r) -> Device -> ObjectTableNVX -> Vector ObjectTableEntryNVX -> Vector Word32 -> Vector ObjectEntryTypeNVX -> r +withRegisteredObjectsNVX b device objectTable ppObjectTableEntries pObjectIndices pObjectEntryTypes = + b (registerObjectsNVX device objectTable ppObjectTableEntries pObjectIndices) (unregisterObjectsNVX device objectTable pObjectEntryTypes pObjectIndices) diff --git a/src/Graphics/Vulkan/Extensions/VK_NV_ray_tracing.hs b/src/Graphics/Vulkan/Extensions/VK_NV_ray_tracing.hs index 9c4c96f3f..87b78d161 100644 --- a/src/Graphics/Vulkan/Extensions/VK_NV_ray_tracing.hs +++ b/src/Graphics/Vulkan/Extensions/VK_NV_ray_tracing.hs @@ -331,14 +331,17 @@ createAccelerationStructureNV device createInfo allocator = liftIO . evalContT $ pAccelerationStructure <- lift $ peek @AccelerationStructureNV pPAccelerationStructure pure $ (pAccelerationStructure) --- | A safe wrapper for 'createAccelerationStructureNV' and --- 'destroyAccelerationStructureNV' using 'bracket' --- --- The allocated value must not be returned from the provided computation -withAccelerationStructureNV :: forall r . Device -> AccelerationStructureCreateInfoNV -> Maybe AllocationCallbacks -> ((AccelerationStructureNV) -> IO r) -> IO r -withAccelerationStructureNV device pCreateInfo pAllocator = - bracket - (createAccelerationStructureNV device pCreateInfo pAllocator) +-- | A convenience wrapper to make a compatible pair of +-- 'createAccelerationStructureNV' and 'destroyAccelerationStructureNV' +-- +-- To ensure that 'destroyAccelerationStructureNV' is always called: pass +-- 'Control.Exception.bracket' (or the allocate function from your +-- favourite resource management library) as the first argument. +-- To just extract the pair pass '(,)' as the first argument. +-- +withAccelerationStructureNV :: forall io r . MonadIO io => (io (AccelerationStructureNV) -> ((AccelerationStructureNV) -> io ()) -> r) -> Device -> AccelerationStructureCreateInfoNV -> Maybe AllocationCallbacks -> r +withAccelerationStructureNV b device pCreateInfo pAllocator = + b (createAccelerationStructureNV device pCreateInfo pAllocator) (\(o0) -> destroyAccelerationStructureNV device o0 pAllocator)