From 08d4b423adc698fbd91ef58eb9ad176ebb8dc24e Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Mon, 28 Mar 2022 16:04:22 +0300 Subject: [PATCH] Fix GHC-9.2 build (#145) --- examples/vulkan/Backend.hs | 38 ++++++++++++++------------------ examples/vulkan/Main.hs | 27 ++++++++++------------- generator/DearImGui/Generator.hs | 6 ++++- 3 files changed, 34 insertions(+), 37 deletions(-) diff --git a/examples/vulkan/Backend.hs b/examples/vulkan/Backend.hs index 9707c99..d9dbbed 100644 --- a/examples/vulkan/Backend.hs +++ b/examples/vulkan/Backend.hs @@ -190,9 +190,9 @@ initialiseVulkanContext instanceType appName ( VulkanRequirements { instanceRequ device <- logDebug "Creating logical device" *> Vulkan.Utils.createDeviceFromRequirements swapchainDeviceRequirements [] physicalDevice deviceCreateInfo queue <- Vulkan.getDeviceQueue device ( fromIntegral queueFamily ) 0 - + pure ( VulkanContext { .. } ) - + vulkanInstanceInfo @@ -206,7 +206,7 @@ vulkanInstanceInfo appName = do let validationLayer :: Maybe ValidationLayerName validationLayer - = coerce + = coerce . foldMap ( ( Vulkan.layerName :: Vulkan.LayerProperties -> ByteString ) >>> \case @@ -374,11 +374,10 @@ chooseSwapchainFormat case sortOn ( Down . score ) ( Boxed.Vector.toList surfaceFormats ) of [] -> error "No formats found." - ( best : _ ) - | Vulkan.FORMAT_UNDEFINED <- ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) best - -> pure preferredFormat - | otherwise - -> pure best + Vulkan.SurfaceFormatKHR{format=Vulkan.FORMAT_UNDEFINED} : _rest -> + pure preferredFormat + best : _rest + -> pure best where match :: Eq a => a -> a -> Int @@ -406,20 +405,17 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface ) ( _, presentModes ) <- Vulkan.getPhysicalDeviceSurfacePresentModesKHR physicalDevice ( Vulkan.SurfaceKHR surface ) - + let presentMode :: Vulkan.PresentModeKHR - presentMode + presentMode | Vulkan.PRESENT_MODE_MAILBOX_KHR `elem` presentModes = Vulkan.PRESENT_MODE_MAILBOX_KHR | otherwise = Vulkan.PRESENT_MODE_FIFO_KHR - currentExtent :: Vulkan.Extent2D - currentExtent = ( Vulkan.currentExtent :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.Extent2D ) surfaceCapabilities - - currentTransform :: Vulkan.SurfaceTransformFlagBitsKHR - currentTransform = ( Vulkan.currentTransform :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.SurfaceTransformFlagBitsKHR ) surfaceCapabilities + Vulkan.SurfaceCapabilitiesKHR{currentExtent, currentTransform} = surfaceCapabilities + Vulkan.SurfaceFormatKHR{format=fmt, colorSpace=csp} = surfaceFormat swapchainCreateInfo :: Vulkan.SwapchainCreateInfoKHR '[] swapchainCreateInfo = @@ -428,8 +424,8 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun , Vulkan.flags = Vulkan.zero , Vulkan.surface = Vulkan.SurfaceKHR surface , Vulkan.minImageCount = imageCount - , Vulkan.imageFormat = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat - , Vulkan.imageColorSpace = ( Vulkan.colorSpace :: Vulkan.SurfaceFormatKHR -> Vulkan.ColorSpaceKHR ) surfaceFormat + , Vulkan.imageFormat = fmt + , Vulkan.imageColorSpace = csp , Vulkan.imageExtent = currentExtent , Vulkan.imageArrayLayers = 1 , Vulkan.imageUsage = imageUsage @@ -494,7 +490,7 @@ simpleRenderPass dev attachments = Vulkan.withRenderPass dev createInfo Nothing { Vulkan.next = () , Vulkan.flags = Vulkan.zero , Vulkan.attachments = Boxed.Vector.fromList attachmentDescriptions - , Vulkan.subpasses = Boxed.Vector.singleton subpass + , Vulkan.subpasses = Boxed.Vector.singleton subpass , Vulkan.dependencies = Boxed.Vector.fromList [ dependency1, dependency2 ] } @@ -591,7 +587,7 @@ createFramebuffer -> Vulkan.Extent2D -> f Vulkan.ImageView -> m ( ResourceT.ReleaseKey, Vulkan.Framebuffer ) -createFramebuffer dev renderPass extent attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate +createFramebuffer dev renderPass Vulkan.Extent2D{width, height} attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate where createInfo :: Vulkan.FramebufferCreateInfo '[] createInfo = @@ -600,8 +596,8 @@ createFramebuffer dev renderPass extent attachments = Vulkan.withFramebuffer dev , Vulkan.flags = Vulkan.zero , Vulkan.renderPass = renderPass , Vulkan.attachments = Boxed.Vector.fromList . toList $ attachments - , Vulkan.width = ( Vulkan.width :: Vulkan.Extent2D -> Word32 ) extent - , Vulkan.height = ( Vulkan.height :: Vulkan.Extent2D -> Word32 ) extent + , Vulkan.width = width + , Vulkan.height = height , Vulkan.layers = 1 } diff --git a/examples/vulkan/Main.hs b/examples/vulkan/Main.hs index 7e799bf..6c0ffd6 100644 --- a/examples/vulkan/Main.hs +++ b/examples/vulkan/Main.hs @@ -201,9 +201,7 @@ app = do surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface ) let - minImageCount, maxImageCount, imageCount :: Word32 - minImageCount = ( Vulkan.minImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities - maxImageCount = ( Vulkan.maxImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities + Vulkan.SurfaceCapabilitiesKHR{minImageCount, maxImageCount} = surfaceCapabilities imageCount | maxImageCount == 0 = minImageCount + 1 | otherwise = ( minImageCount + 1 ) `min` maxImageCount @@ -213,31 +211,30 @@ app = do swapchainResources :: Maybe SwapchainResources -> m ( m (), SwapchainResources ) swapchainResources mbOldResources = do - ( surfaceFormat, imGuiRenderPass ) <- case mbOldResources of + ( colFmt, surfaceFormat, imGuiRenderPass ) <- case mbOldResources of Nothing -> do logDebug "Choosing swapchain format & color space" surfaceFormat <- chooseSwapchainFormat preferredFormat physicalDevice surface - let - colFmt :: Vulkan.Format - colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat + let Vulkan.SurfaceFormatKHR{format=colFmt} = surfaceFormat logDebug "Creating Dear ImGui render pass" ( _, imGuiRenderPass ) <- simpleRenderPass device ( noAttachments { colorAttachments = Boxed.Vector.singleton $ presentableColorAttachmentDescription colFmt } ) - pure ( surfaceFormat, imGuiRenderPass ) - Just oldResources -> pure ( surfaceFormat oldResources, imGuiRenderPass oldResources ) - - let - colFmt :: Vulkan.Format - colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat + pure ( colFmt, surfaceFormat, imGuiRenderPass ) + Just oldResources -> do + let surFmt = surfaceFormat oldResources + let Vulkan.SurfaceFormatKHR{format=colFmt} = surFmt + pure ( colFmt, surFmt, imGuiRenderPass oldResources ) logDebug "Creating swapchain" ( swapchainKey, swapchain, swapchainExtent ) <- createSwapchain - physicalDevice device - surface surfaceFormat + physicalDevice + device + surface + surfaceFormat surfaceUsage imageCount ( swapchain <$> mbOldResources ) diff --git a/generator/DearImGui/Generator.hs b/generator/DearImGui/Generator.hs index b9657dd..394af46 100644 --- a/generator/DearImGui/Generator.hs +++ b/generator/DearImGui/Generator.hs @@ -24,6 +24,10 @@ import Data.Traversable ( for ) import Foreign.Storable ( Storable ) +#if MIN_VERSION_template_haskell(2,18,0) +import Data.Coerce + ( coerce ) +#endif -- containers import Data.Map.Strict @@ -171,7 +175,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do else \ nm args dir pat -> TH.patSynD_doc nm args dir pat - ( Just $ Text.unpack patDoc ) [] + ( Just $ Text.unpack _patDoc ) [] ) #else TH.patSynD