Skip to content

Commit b59f1b3

Browse files
dpwizdpwiz
authored
Fix builds on 8.10 and 9.6 (#564)
* Fix building examples with GHC 9.6 * Add patched autoapply to cabal.project * Fix generate-new on 8.10 * Update stack.yaml
1 parent 5896dcb commit b59f1b3

23 files changed

Lines changed: 138 additions & 87 deletions

File tree

‎cabal.project‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,3 +8,8 @@ packages:
88

99
constraints:
1010
nothunks +vector,
11+
12+
source-repository-package
13+
type: git
14+
location: https://github.com/dpwiz/autoapply.git
15+
tag: 640ed1a689484fc307e1bab7c06db1027b28c87c

‎examples/compute/Main.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,9 @@ import Vulkan.Core10 as Vk
4141
hiding ( withBuffer
4242
, withImage
4343
)
44+
import qualified Vulkan.Core10 as CommandBufferBeginInfo (CommandBufferBeginInfo(..))
45+
import qualified Vulkan.Core10 as CommandPoolCreateInfo (CommandPoolCreateInfo(..))
46+
import qualified Vulkan.Core10 as PipelineLayoutCreateInfo (PipelineLayoutCreateInfo(..))
4447
import qualified Vulkan.Core10.DeviceInitialization as DI
4548
import Vulkan.Dynamic ( DeviceCmds
4649
( DeviceCmds
@@ -58,6 +61,7 @@ import Vulkan.Utils.ShaderQQ.GLSL.Glslang
5861
import Vulkan.Zero
5962
import VulkanMemoryAllocator as VMA
6063
hiding ( getPhysicalDeviceProperties )
64+
import qualified VulkanMemoryAllocator as AllocationCreateInfo (AllocationCreateInfo(..))
6165

6266
----------------------------------------------------------------
6367
-- Define the monad in which most of the program will run
@@ -205,7 +209,7 @@ render = do
205209
zero { size = fromIntegral $ width * height * 4 * sizeOf (0 :: Float)
206210
, usage = BUFFER_USAGE_STORAGE_BUFFER_BIT
207211
}
208-
zero { flags = ALLOCATION_CREATE_MAPPED_BIT
212+
zero { AllocationCreateInfo.flags = ALLOCATION_CREATE_MAPPED_BIT
209213
, usage = MEMORY_USAGE_GPU_TO_CPU
210214
}
211215

@@ -249,9 +253,7 @@ render = do
249253

250254
-- Create our shader and compute pipeline
251255
shader <- createShader
252-
(_, pipelineLayout) <- withPipelineLayout' zero
253-
{ setLayouts = [descriptorSetLayout]
254-
}
256+
(_, pipelineLayout) <- withPipelineLayout' zero { PipelineLayoutCreateInfo.setLayouts = [descriptorSetLayout] }
255257
let pipelineCreateInfo :: ComputePipelineCreateInfo '[]
256258
pipelineCreateInfo = zero { layout = pipelineLayout
257259
, stage = shader
@@ -263,9 +265,7 @@ render = do
263265

264266
-- Create a command buffer
265267
computeQueueFamilyIndex <- getComputeQueueFamilyIndex
266-
let commandPoolCreateInfo :: CommandPoolCreateInfo
267-
commandPoolCreateInfo =
268-
zero { queueFamilyIndex = computeQueueFamilyIndex }
268+
let commandPoolCreateInfo = zero { CommandPoolCreateInfo.queueFamilyIndex = computeQueueFamilyIndex }
269269
(_, commandPool) <- withCommandPool' commandPoolCreateInfo
270270
let commandBufferAllocateInfo = zero { commandPool = commandPool
271271
, level = COMMAND_BUFFER_LEVEL_PRIMARY
@@ -275,7 +275,7 @@ render = do
275275

276276
-- Fill command buffer
277277
useCommandBuffer commandBuffer
278-
zero { flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
278+
zero { CommandBufferBeginInfo.flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
279279
$ do
280280
-- Set up our state, pipeline and descriptor set
281281
cmdBindPipeline commandBuffer

‎examples/hlsl/Frame.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,10 @@ import Swapchain
3131
import UnliftIO.Exception ( throwString )
3232
import Vulkan.CStruct.Extends
3333
import Vulkan.Core10
34+
import qualified Vulkan.Core10 as CommandPoolCreateInfo (CommandPoolCreateInfo(..))
3435
import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore
3536
import Vulkan.Extensions.VK_KHR_surface
37+
import Vulkan.Extensions.VK_KHR_surface as SurfaceFormatKHR (SurfaceFormatKHR(..))
3638
import Vulkan.Utils.QueueAssignment
3739
import Vulkan.Zero
3840

@@ -77,7 +79,7 @@ initialRecycledResources = do
7779

7880
graphicsQueueFamilyIndex <- getGraphicsQueueFamilyIndex
7981
(_, fCommandPool) <- withCommandPool' zero
80-
{ queueFamilyIndex = unQueueFamilyIndex graphicsQueueFamilyIndex
82+
{ CommandPoolCreateInfo.queueFamilyIndex = unQueueFamilyIndex graphicsQueueFamilyIndex
8183
}
8284

8385
pure RecycledResources { .. }
@@ -93,7 +95,7 @@ initialFrame fWindow fSurface = do
9395
fSurface
9496

9597
(_, fRenderPass) <- RenderPass.createRenderPass
96-
(format (siSurfaceFormat (srInfo fSwapchainResources) :: SurfaceFormatKHR))
98+
(SurfaceFormatKHR.format (siSurfaceFormat (srInfo fSwapchainResources)))
9799

98100
(fReleaseFramebuffers, fFramebuffers) <- createFramebuffers
99101
fRenderPass

‎examples/hlsl/Init.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,8 @@ import Vulkan.Core10 as Vk
3535
hiding ( withBuffer
3636
, withImage
3737
)
38+
import qualified Vulkan.Core10 as CommandPoolCreateInfo (CommandPoolCreateInfo(..))
39+
import qualified Vulkan.Core10 as MemoryHeap (MemoryHeap(..))
3840
import Vulkan.Dynamic ( DeviceCmds(DeviceCmds, pVkGetDeviceProcAddr)
3941
, InstanceCmds(InstanceCmds, pVkGetInstanceProcAddr)
4042
)
@@ -155,7 +157,7 @@ physicalDeviceInfo surf phys = runMaybeT $ do
155157
--
156158
pdiTotalMemory <- do
157159
heaps <- memoryHeaps <$> getPhysicalDeviceMemoryProperties phys
158-
pure $ sum ((size :: MemoryHeap -> DeviceSize) <$> heaps)
160+
pure $ sum (MemoryHeap.size <$> heaps)
159161

160162
pure PhysicalDeviceInfo { .. }
161163

@@ -234,8 +236,7 @@ createCommandPools
234236
-- ^ Queue family for the pools
235237
-> m (Vector CommandPool)
236238
createCommandPools dev n (QueueFamilyIndex queueFamilyIndex) = do
237-
let commandPoolCreateInfo :: CommandPoolCreateInfo
238-
commandPoolCreateInfo = zero { queueFamilyIndex = queueFamilyIndex }
239+
let commandPoolCreateInfo = zero { CommandPoolCreateInfo.queueFamilyIndex = queueFamilyIndex }
239240
V.replicateM
240241
n
241242
( snd

‎examples/hlsl/Render.hs‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@ import UnliftIO ( MonadUnliftIO )
2020
import UnliftIO.Exception ( throwString )
2121
import Vulkan.CStruct.Extends
2222
import Vulkan.Core10 as Core10
23+
import qualified Vulkan.Core10 as CommandBufferBeginInfo (CommandBufferBeginInfo(..))
24+
import qualified Vulkan.Core10 as Extent2D (Extent2D(..))
2325
import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore
2426
import Vulkan.Extensions.VK_KHR_swapchain
2527
as Swap
@@ -56,7 +58,7 @@ renderFrame = do
5658
}
5759
(_, ~[commandBuffer]) <- withCommandBuffers' commandBufferAllocateInfo
5860
useCommandBuffer' commandBuffer
59-
zero { flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
61+
zero { CommandBufferBeginInfo.flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
6062
$ myRecordCommandBuffer f imageIndex
6163

6264
-- Submit the work
@@ -108,8 +110,8 @@ myRecordCommandBuffer Frame {..} imageIndex = do
108110
0
109111
[ Viewport { x = 0
110112
, y = 0
111-
, width = realToFrac (width (siImageExtent :: Extent2D))
112-
, height = realToFrac (height (siImageExtent :: Extent2D))
113+
, width = realToFrac (Extent2D.width siImageExtent)
114+
, height = realToFrac (Extent2D.height siImageExtent)
113115
, minDepth = 0
114116
, maxDepth = 1
115117
}

‎examples/lib/Framebuffer.hs‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,8 @@ import Vulkan.Core10 as Vk
1313
hiding ( withBuffer
1414
, withImage
1515
)
16+
import Vulkan.Core10 as Extent2D (Extent2D(..))
17+
import Vulkan.Core10 as ImageViewCreateInfo (ImageViewCreateInfo(..))
1618
import Vulkan.Zero
1719

1820
autoapplyDecs
@@ -41,8 +43,8 @@ createFramebuffer renderPass imageView imageSize = do
4143
let framebufferCreateInfo :: FramebufferCreateInfo '[]
4244
framebufferCreateInfo = zero { renderPass = renderPass
4345
, attachments = [imageView]
44-
, width = width (imageSize :: Extent2D)
45-
, height = height (imageSize :: Extent2D)
46+
, width = Extent2D.width imageSize
47+
, height = Extent2D.height imageSize
4648
, layers = 1
4749
}
4850
withFramebuffer' framebufferCreateInfo
@@ -54,7 +56,7 @@ createImageView
5456
-> Image
5557
-> m (ReleaseKey, ImageView)
5658
createImageView format = \image ->
57-
withImageView' imageViewCreateInfo { image = image }
59+
withImageView' imageViewCreateInfo { ImageViewCreateInfo.image = image }
5860
where
5961
imageViewCreateInfo = zero
6062
{ viewType = IMAGE_VIEW_TYPE_2D

‎examples/lib/Swapchain.hs‎

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,8 @@ import UnliftIO.Exception ( throwString
3838
import Vulkan.Core10
3939
import Vulkan.Exception
4040
import Vulkan.Extensions.VK_KHR_surface
41+
import Vulkan.Extensions.VK_KHR_surface as SurfaceCapabilitiesKHR (SurfaceCapabilitiesKHR(..))
42+
import Vulkan.Extensions.VK_KHR_surface as SurfaceFormatKHR (SurfaceFormatKHR(..))
4143
import Vulkan.Extensions.VK_KHR_swapchain
4244
import Vulkan.Utils.Misc
4345
import Vulkan.Zero
@@ -98,7 +100,7 @@ allocSwapchainResources oldSwapchain windowSize surface = do
98100
(imageViewKeys, imageViews) <-
99101
fmap V.unzip . V.forM swapchainImages $ \image ->
100102
Framebuffer.createImageView
101-
(format (siSurfaceFormat :: SurfaceFormatKHR))
103+
(SurfaceFormatKHR.format siSurfaceFormat)
102104
image
103105

104106
-- This refcount is released in 'recreateSwapchainResources'
@@ -174,7 +176,7 @@ createSwapchain oldSwapchain explicitSize surf = do
174176
-- the driver to finish
175177
buffer = 1
176178
desired =
177-
buffer + minImageCount (surfaceCaps :: SurfaceCapabilitiesKHR)
179+
buffer + SurfaceCapabilitiesKHR.minImageCount surfaceCaps
178180
in
179181
min limit desired
180182

@@ -190,13 +192,13 @@ createSwapchain oldSwapchain explicitSize surf = do
190192
, flags = zero
191193
, queueFamilyIndices = mempty -- No need to specify when not using concurrent access
192194
, minImageCount = imageCount
193-
, imageFormat = format (surfaceFormat :: SurfaceFormatKHR)
195+
, imageFormat = SurfaceFormatKHR.format surfaceFormat
194196
, imageColorSpace = colorSpace surfaceFormat
195197
, imageExtent = imageExtent
196198
, imageArrayLayers = 1
197199
, imageUsage = foldr (.|.) zero requiredUsageFlags
198200
, imageSharingMode = SHARING_MODE_EXCLUSIVE
199-
, preTransform = currentTransform (surfaceCaps :: SurfaceCapabilitiesKHR)
201+
, preTransform = SurfaceCapabilitiesKHR.currentTransform surfaceCaps
200202
, compositeAlpha = compositeAlphaMode
201203
, presentMode = presentMode
202204
, clipped = True

‎examples/offscreen/Main.hs‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,8 @@ import qualified Language.C.Types as C
4646
import Vulkan.CStruct.Extends
4747
import Vulkan.Core10 as Vk
4848
hiding ( withImage )
49+
import qualified Vulkan.Core10 as CommandBufferBeginInfo (CommandBufferBeginInfo(..))
50+
import qualified Vulkan.Core10 as CommandPoolCreateInfo (CommandPoolCreateInfo(..))
4951
import qualified Vulkan.Core10.DeviceInitialization as DI
5052
import qualified Vulkan.Core10.Image as SL
5153
import Vulkan.Dynamic ( DeviceCmds
@@ -64,6 +66,7 @@ import Vulkan.Utils.ShaderQQ.GLSL.Glslang
6466
import Vulkan.Zero
6567
import VulkanMemoryAllocator as VMA
6668
hiding ( getPhysicalDeviceProperties )
69+
import qualified VulkanMemoryAllocator as AllocationCreateInfo (AllocationCreateInfo(..))
6770

6871
#if defined(RENDERDOC)
6972
data RENDERDOC_API_1_1_2
@@ -269,8 +272,7 @@ render = do
269272
.|. IMAGE_USAGE_TRANSFER_SRC_BIT
270273
, initialLayout = IMAGE_LAYOUT_UNDEFINED
271274
}
272-
allocationCreateInfo :: AllocationCreateInfo
273-
allocationCreateInfo = zero { flags = ALLOCATION_CREATE_MAPPED_BIT
275+
allocationCreateInfo = zero { AllocationCreateInfo.flags = ALLOCATION_CREATE_MAPPED_BIT
274276
, usage = MEMORY_USAGE_GPU_ONLY
275277
}
276278
-- Allocate the image with VMA
@@ -288,8 +290,7 @@ render = do
288290
, usage = IMAGE_USAGE_TRANSFER_DST_BIT
289291
, initialLayout = IMAGE_LAYOUT_UNDEFINED
290292
}
291-
cpuAllocationCreateInfo :: AllocationCreateInfo
292-
cpuAllocationCreateInfo = zero { flags = ALLOCATION_CREATE_MAPPED_BIT
293+
cpuAllocationCreateInfo = zero { AllocationCreateInfo.flags = ALLOCATION_CREATE_MAPPED_BIT
293294
, usage = MEMORY_USAGE_GPU_TO_CPU
294295
}
295296
(_, (cpuImage, cpuImageAllocation, cpuImageAllocationInfo)) <- withImage'
@@ -432,9 +433,7 @@ render = do
432433

433434
-- Create a command buffer
434435
graphicsQueueFamilyIndex <- getGraphicsQueueFamilyIndex
435-
let commandPoolCreateInfo :: CommandPoolCreateInfo
436-
commandPoolCreateInfo =
437-
zero { queueFamilyIndex = graphicsQueueFamilyIndex }
436+
let commandPoolCreateInfo = zero { CommandPoolCreateInfo.queueFamilyIndex = graphicsQueueFamilyIndex }
438437
(_, commandPool) <- withCommandPool' commandPoolCreateInfo
439438
let commandBufferAllocateInfo = zero { commandPool = commandPool
440439
, level = COMMAND_BUFFER_LEVEL_PRIMARY
@@ -448,7 +447,7 @@ render = do
448447
-- - Transition the images to be able to perform the copy
449448
-- - Copy the image to CPU mapped memory
450449
useCommandBuffer commandBuffer
451-
zero { flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
450+
zero { CommandBufferBeginInfo.flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
452451
$ do
453452
let renderPassBeginInfo = zero
454453
{ renderPass = renderPass

‎examples/rays/Init.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,8 @@ import Vulkan.Core10 as Vk
3636
hiding ( withBuffer
3737
, withImage
3838
)
39+
import qualified Vulkan.Core10 as MemoryHeap (MemoryHeap(..))
40+
import qualified Vulkan.Core10 as CommandPoolCreateInfo (CommandPoolCreateInfo(..))
3941
import Vulkan.Core11 ( pattern API_VERSION_1_1 )
4042
import Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address
4143
import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore
@@ -197,7 +199,7 @@ physicalDeviceInfo surf phys = runMaybeT $ do
197199
--
198200
pdiTotalMemory <- do
199201
heaps <- memoryHeaps <$> getPhysicalDeviceMemoryProperties phys
200-
pure $ sum ((size :: MemoryHeap -> DeviceSize) <$> heaps)
202+
pure $ sum (MemoryHeap.size <$> heaps)
201203

202204
pure (PhysicalDeviceInfo { .. }, SomeStruct dci)
203205

@@ -261,8 +263,7 @@ createCommandPools
261263
-- ^ Queue family for the pools
262264
-> m (Vector CommandPool)
263265
createCommandPools dev n (QueueFamilyIndex queueFamilyIndex) = do
264-
let commandPoolCreateInfo :: CommandPoolCreateInfo
265-
commandPoolCreateInfo = zero { queueFamilyIndex = queueFamilyIndex }
266+
let commandPoolCreateInfo = zero { CommandPoolCreateInfo.queueFamilyIndex = queueFamilyIndex }
266267
V.replicateM
267268
n
268269
( snd

‎examples/rays/Render.hs‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ import Swapchain
2727
import UnliftIO.Exception ( throwString )
2828
import Vulkan.CStruct.Extends
2929
import Vulkan.Core10 as Core10
30+
import qualified Vulkan.Core10 as Extent2D (Extent2D(..))
31+
import qualified Vulkan.Core10 as CommandBufferBeginInfo (CommandBufferBeginInfo(..))
3032
import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore
3133
import Vulkan.Extensions.VK_KHR_ray_tracing_pipeline
3234
import Vulkan.Extensions.VK_KHR_swapchain
@@ -113,7 +115,7 @@ renderFrame = withSpan_ "renderFrame" $ do
113115
withSpan_ "record"
114116
$ useCommandBuffer'
115117
commandBuffer
116-
zero { flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
118+
zero { CommandBufferBeginInfo.flags = COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT }
117119
$ myRecordCommandBuffer f imageIndex
118120

119121
-- Submit the work
@@ -160,8 +162,8 @@ myRecordCommandBuffer Frame {..} imageIndex = do
160162
SwapchainResources {..} = fSwapchainResources
161163
SwapchainInfo {..} = srInfo
162164
image = srImages ! fromIntegral imageIndex
163-
imageWidth = width (siImageExtent :: Extent2D)
164-
imageHeight = height (siImageExtent :: Extent2D)
165+
imageWidth = Extent2D.width siImageExtent
166+
imageHeight = Extent2D.height siImageExtent
165167
imageSubresourceRange = ImageSubresourceRange
166168
{ aspectMask = IMAGE_ASPECT_COLOR_BIT
167169
, baseMipLevel = 0

0 commit comments

Comments
 (0)