wgpu-hs 0.2.0.1 → 0.3.0.0

raw patch · 26 files changed

+2095/−647 lines, 26 filesdep +containersdep +data-hasdep +lensdep ~data-defaultdep ~textdep ~transformersnew-component:exe:triangle-glfwnew-component:exe:triangle-sdlPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, data-has, lens, mtl, resourcet, safe-exceptions, sdl2, string-qq

Dependency ranges changed: data-default, text, transformers, vector, wgpu-raw-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• examples/triangle-glfw/TriangleGLFW.hs +246/−0
• examples/triangle-sdl/TriangleSDL.hs +268/−0
• examples/triangle/Main.hs +0/−219
• src-internal/WGPU/Internal/Adapter.hs +211/−22
• src-internal/WGPU/Internal/Binding.hs +20/−15
• src-internal/WGPU/Internal/ChainedStruct.hs +2/−0
• src-internal/WGPU/Internal/Color.hs +6/−4
• src-internal/WGPU/Internal/CommandEncoder.hs +26/−20
• src-internal/WGPU/Internal/Device.hs +35/−23
• src-internal/WGPU/Internal/GLFW/Surface.hs +33/−0
• src-internal/WGPU/Internal/Instance.hs +41/−116
• src-internal/WGPU/Internal/Memory.hs +135/−50
• src-internal/WGPU/Internal/Pipeline.hs +30/−24
• src-internal/WGPU/Internal/Queue.hs +13/−20
• src-internal/WGPU/Internal/RenderPass.hs +46/−27
• src-internal/WGPU/Internal/SDL/Surface.hs +23/−0
• src-internal/WGPU/Internal/Shader.hs +22/−15
• src-internal/WGPU/Internal/Surface.hs +1/−25
• src-internal/WGPU/Internal/SwapChain.hs +45/−35
• src/WGPU.hs +23/−21
• src/WGPU/BoneYard/SimpleSDL.hs +407/−0
• src/WGPU/Classy.hs +362/−0
• src/WGPU/GLFW/Surface.hs +10/−0
• src/WGPU/SDL/Surface.hs +10/−0
• wgpu-hs.cabal +70/−11

@@ -1,5 +1,15 @@ # Revision history for wgpu-hs +## 0.3.0.0 -- 2021-08-30++- Add Classy interface - supply parameters from `ReaderT`.+- Add SDL surfaces.+- Add `BoneYard` package for helpful application skeleton code.+- Switch to using `MonadIO` instead of plain `IO` when possible.+- Supply bracketing functions for `withXXX`.+- Add extra `{-# INLINABLE #-}` pragmas.+- Add ability to query Adapter properties.+ ## 0.2.0.1 -- 2021-08-24  - Added Linux support for surfaces and DLL loading.

@@ -0,0 +1,246 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Let's draw a triangle!+module Main (main) where++import Control.Concurrent+  ( MVar,+    newEmptyMVar,+    putMVar,+    tryReadMVar,+    tryTakeMVar,+  )+import Control.Exception (bracket)+import Control.Monad (unless)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (runExceptT)+import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT)+import Data.Default (def)+import Data.Maybe (isNothing)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as TextIO+import qualified Graphics.UI.GLFW as GLFW+import System.Exit (exitFailure)+import WGPU (SwapChain)+import qualified WGPU+import qualified WGPU.GLFW.Surface++main :: IO ()+main = do+  TextIO.putStrLn "GLFW Triangle Example"++  -- start GLFW+  initResult <- GLFW.init+  unless initResult $ do+    TextIO.putStrLn "Failed to initialize GLFW"+    exitFailure++  -- create the GLFW window without a "client API"+  GLFW.windowHint (GLFW.WindowHint'ClientAPI GLFW.ClientAPI'NoAPI)+  window <- do+    mWin <- GLFW.createWindow 640 480 "GLFW Triangle Example" Nothing Nothing+    case mWin of+      Just w -> pure w+      Nothing -> do+        TextIO.putStrLn "Failed to create GLFW window"+        exitFailure++  WGPU.withPlatformInstance bracket $ \inst -> do+    -- attach the logger and set the logging level+    WGPU.connectLog inst+    WGPU.setLogLevel inst WGPU.Warn++    -- print the version of the WGPU library+    version <- WGPU.getVersion inst+    TextIO.putStrLn $ "WGPU version: " <> WGPU.versionToText version++    -- fetch resources (surface, adpater, device)+    Resources {..} <- getResources inst window >>= getOrFail++    shader <- WGPU.createShaderModuleWGSL device "shader" shaderSrc+    swapChainFormat <- WGPU.getSwapChainPreferredFormat surface adapter+    swapChainMVar <- newEmptyMVar+    _ <- updateSwapChain device surface window swapChainFormat swapChainMVar++    pipelineLayout <-+      WGPU.createPipelineLayout+        device+        (WGPU.PipelineLayoutDescriptor "Pipeline" [])+    pipeline <-+      WGPU.createRenderPipeline+        device+        WGPU.RenderPipelineDescriptor+          { renderPipelineLabel = "Render Pipeline",+            layout = WGPU.SJust pipelineLayout,+            vertex = WGPU.VertexState shader "vs_main" [],+            primitive = def,+            depthStencil = WGPU.SNothing,+            multisample = WGPU.MultisampleState 1 0xFFFFFFFF False,+            fragment =+              WGPU.SJust $+                WGPU.FragmentState+                  shader+                  "fs_main"+                  [ WGPU.ColorTargetState+                      swapChainFormat+                      (WGPU.SJust (WGPU.BlendState def def))+                      WGPU.colorWriteMaskAll+                  ]+          }++    let doDraw =+          draw+            device+            surface+            window+            pipeline+            queue+            swapChainFormat+            swapChainMVar++    let loop = do+          doDraw++          -- handle GLFW quit event+          GLFW.pollEvents+          shouldClose <- GLFW.windowShouldClose window+          unless shouldClose loop++    loop++  -- close down GLFW+  GLFW.destroyWindow window+  GLFW.terminate++newtype Error = Error Text deriving (Eq, Show)++getOrFail :: Either Error a -> IO a+getOrFail ma =+  case ma of+    Right x -> pure x+    Left err -> failWith err++failWith :: Error -> IO a+failWith (Error err) = do+  TextIO.putStrLn err+  exitFailure++data Resources = Resources+  { surface :: WGPU.Surface,+    adapter :: WGPU.Adapter,+    device :: WGPU.Device,+    queue :: WGPU.Queue+  }++getResources :: WGPU.Instance -> GLFW.Window -> IO (Either Error Resources)+getResources inst window = runExceptT $ do+  -- fetch a surface for the window+  surface <- lift $ WGPU.GLFW.Surface.createSurface inst window+  -- fetch an adapter for the surface+  adapter <-+    maybeToExceptT+      (Error "Failed to obtain WGPU Adapter")+      (MaybeT $ WGPU.requestAdapter surface)+  -- fetch a device for the adapter+  let deviceDescriptor :: WGPU.DeviceDescriptor+      deviceDescriptor = def {WGPU.limits = def {WGPU.maxBindGroups = 1}}+  device <-+    maybeToExceptT+      (Error "Failed to obtain WGPU Device")+      (MaybeT $ WGPU.requestDevice adapter deviceDescriptor)++  queue <- lift $ WGPU.getQueue device++  pure Resources {..}++updateSwapChain ::+  WGPU.Device ->+  WGPU.Surface ->+  GLFW.Window ->+  WGPU.TextureFormat ->+  MVar ((Int, Int), WGPU.SwapChain) ->+  IO WGPU.SwapChain+updateSwapChain device surface window textureFormat swapChainMVar = do+  mOldSwapChain <- fmap snd <$> tryReadMVar swapChainMVar+  oldSz <- maybe (0, 0) fst <$> tryReadMVar swapChainMVar+  curSz <- GLFW.getWindowSize window+  case (mOldSwapChain, curSz /= oldSz) of+    x | isNothing (fst x) || snd x -> do+      swapChain <-+        WGPU.createSwapChain+          device+          surface+          WGPU.SwapChainDescriptor+            { swapChainLabel = "SwapChain",+              usage = WGPU.TextureUsageRenderAttachment,+              swapChainFormat = textureFormat,+              width = fromIntegral . fst $ curSz,+              height = fromIntegral . snd $ curSz,+              presentMode = WGPU.PresentModeFifo+            }+      _ <- tryTakeMVar swapChainMVar+      putMVar swapChainMVar (curSz, swapChain)+      pure swapChain+    (Just swapChain, False) -> pure swapChain+    _ -> error "should not reach this case"++draw ::+  WGPU.Device ->+  WGPU.Surface ->+  GLFW.Window ->+  WGPU.RenderPipeline ->+  WGPU.Queue ->+  WGPU.TextureFormat ->+  MVar ((Int, Int), WGPU.SwapChain) ->+  IO ()+draw device surface window pipeline queue swapChainFormat swapChainMVar = do+  -- update swapchain if the window size is different+  swapChain <-+    updateSwapChain device surface window swapChainFormat swapChainMVar+  -- render+  nextTexture <- WGPU.getSwapChainCurrentTextureView swapChain+  encoder <- WGPU.createCommandEncoder device "Command Encoder"+  renderPass <-+    WGPU.beginRenderPass+      encoder+      ( WGPU.RenderPassDescriptor+          { renderPassLabel = "Render Pass",+            colorAttachments =+              [ WGPU.RenderPassColorAttachment+                  nextTexture+                  WGPU.SNothing+                  ( WGPU.Operations+                      (WGPU.LoadOpClear (WGPU.Color 0 0 0 1))+                      WGPU.StoreOpStore+                  )+              ],+            depthStencilAttachment = WGPU.SNothing+          }+      )+  WGPU.renderPassSetPipeline renderPass pipeline+  WGPU.renderPassDraw renderPass (WGPU.Range 0 3) (WGPU.Range 0 1)+  WGPU.endRenderPass renderPass+  commandBuffer <- WGPU.commandEncoderFinish encoder "Command Buffer"+  WGPU.queueSubmit queue [commandBuffer]+  WGPU.swapChainPresent swapChain++shaderSrc :: WGPU.WGSL+shaderSrc =+  WGPU.WGSL $+    Text.intercalate+      "\n"+      [ "[[stage(vertex)]]",+        "fn vs_main([[builtin(vertex_index)]] in_vertex_index: u32) -> [[builtin(position)]] vec4<f32> {",+        "  let x = f32(i32(in_vertex_index) - 1);",+        "  let y = f32(i32(in_vertex_index & 1u) * 2 - 1);",+        "  return vec4<f32>(x, y, 0.0, 1.0);",+        "}",+        "",+        "[[stage(fragment)]]",+        "fn fs_main([[builtin(position)]] in: vec4<f32>) -> [[location(0)]] vec4<f32> {",+        "  return vec4<f32>(in.x/640.0, in.y/480.0, 1.0, 1.0);",+        "}"+      ]

@@ -0,0 +1,268 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}++module Main (main) where++import Control.Exception.Safe (MonadThrow)+import Control.Lens (Lens', lens)+import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader, ReaderT (runReaderT))+import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)+import Data.Default (def)+import Data.Has (Has, hasLens)+import Data.Maybe (fromMaybe)+import qualified Data.String.QQ as SQQ+import Data.Text (Text)+import qualified Data.Text.IO as TextIO+import qualified SDL+import qualified WGPU+import qualified WGPU.BoneYard.SimpleSDL as SimpleSDL+import qualified WGPU.Classy as C+import Prelude hiding (putStrLn)++main :: IO ()+main = runResourceT $ do+  putStrLn "Start"++  -- Parameters for the static resource initialization+  let params =+        SimpleSDL.Params+          { title = "SDL Triangle Example",+            mDeviceDescriptor =+              WGPU.SJust $+                def {WGPU.limits = def {WGPU.maxBindGroups = 1}}+          }++  -- Initialize the app static resources. This creates the SDL window, the+  -- WGPU Instance, etc.+  resources <- SimpleSDL.loadResources params++  -- Create other state holders+  shaders <- SimpleSDL.emptyShaders+  renderPipelines <- SimpleSDL.emptyRenderPipelines+  swapChainState <- SimpleSDL.emptySwapChainState++  -- Run the app+  runApp Env {..} app++-- | The core application.+app :: App ()+app = do+  putStrLn "SDL Triangle Example"++  -- Dump some debugging stuff; set the WGPU log, etc.+  C.getVersion >>= \v -> putStrLn $ "WGPU version: " <> WGPU.versionToText v+  C.getAdapterProperties >>= \p -> putStrLn $ WGPU.adapterPropertiesToText p+  C.setLogLevel WGPU.Warn+  C.connectLog++  -- Create application-specific dynamic resources: shader and pipeline.+  initApp++  -- Application loop+  let appLoop :: App ()+      appLoop = do+        render+        events <- SDL.pollEvents+        let qPressed, windowClosed, shouldClose :: Bool+            qPressed = any eventIsQPress events+            windowClosed = any eventIsWindowClose events+            shouldClose = qPressed || windowClosed+        unless shouldClose appLoop+  appLoop++-- | The rendering action.+render :: App ()+render = do+  SimpleSDL.withSwapChain $ do+    nextTexture <- C.getSwapChainCurrentTextureView+    renderPipeline <- SimpleSDL.getRenderPipeline "renderPipeline"+    commandBuffer <-+      C.buildCommandBuffer "Command Encoder" "Command Buffer" $ do+        let renderPassDescriptor =+              WGPU.RenderPassDescriptor+                { renderPassLabel = "Render Pass",+                  colorAttachments =+                    [ WGPU.RenderPassColorAttachment+                        { colorView = nextTexture,+                          resolveTarget = WGPU.SNothing,+                          operations =+                            WGPU.Operations+                              { load = WGPU.LoadOpClear (WGPU.Color 0 0 0 1),+                                store = WGPU.StoreOpStore+                              }+                        }+                    ],+                  depthStencilAttachment = WGPU.SNothing+                }+        C.buildRenderPass renderPassDescriptor $ do+          C.renderPassSetPipeline renderPipeline+          C.renderPassDraw (WGPU.Range 0 3) (WGPU.Range 0 1)+    C.queueSubmit' [commandBuffer]+    C.swapChainPresent++-- | Application initialization+initApp :: App ()+initApp = do+  shaderModule <- SimpleSDL.compileWGSL "shader" shaderSrc++  let pipelineLayoutDescriptor = WGPU.PipelineLayoutDescriptor "Pipeline" []+  pipelineLayout <- C.createPipelineLayout pipelineLayoutDescriptor++  swapChainFormat <- C.getSwapChainPreferredFormat+  let renderPipelineDescriptor =+        WGPU.RenderPipelineDescriptor+          { renderPipelineLabel = "Render Pipeline",+            layout = WGPU.SJust pipelineLayout,+            vertex = WGPU.VertexState shaderModule "vs_main" [],+            primitive = def,+            depthStencil = WGPU.SNothing,+            multisample = WGPU.MultisampleState 1 0xFFFFFFFF False,+            fragment =+              WGPU.SJust $+                WGPU.FragmentState+                  shaderModule+                  "fs_main"+                  [ WGPU.ColorTargetState+                      swapChainFormat+                      (WGPU.SJust (WGPU.BlendState def def))+                      WGPU.colorWriteMaskAll+                  ]+          }+  _ <- SimpleSDL.createRenderPipeline "renderPipeline" renderPipelineDescriptor+  pure ()++shaderSrc :: WGPU.WGSL+shaderSrc =+  WGPU.WGSL+    [SQQ.s|+[[stage(vertex)]]+fn vs_main([[builtin(vertex_index)]] in_vertex_index: u32) -> [[builtin(position)]] vec4<f32> {+  let x = f32(i32(in_vertex_index) - 1);+  let y = f32(i32(in_vertex_index & 1u) * 2 - 1);+  return vec4<f32>(x, y, 0.0, 1.0);+}++[[stage(fragment)]]+fn fs_main([[builtin(position)]] in: vec4<f32>) -> [[location(0)]] vec4<f32> {+  return vec4<f32>(in.x/640.0, in.y/480.0, 1.0, 1.0);+}+|]++-------------------------------------------------------------------------------+-- Application Monad++-- | Run the application.+runApp ::+  -- | Environment for the application. This contains both static resources and+  -- 'MVar's that contain dynamic resources.+  Env ->+  -- | Application to run.+  App a ->+  -- | Resolved 'ResourceT' action. 'ResourceT' is used here so that portions of+  -- the app can be cleaned up automatically.+  ResourceT IO a+runApp env a = runReaderT (unApp a) env++-- | Application monad data type.+newtype App a = App {unApp :: ReaderT Env (ResourceT IO) a}+  deriving newtype+    ( Functor,+      Applicative,+      Monad,+      MonadThrow,+      MonadIO,+      MonadResource,+      MonadReader Env+    )++-- | Environment for the application.+--+-- The environment stores both static and dynamic data that the application+-- uses. This type can be customized at-will to add additional state, such as+-- game state or vizualisation state.+--+-- The 'Has' type class instances below describe how to access the components+-- of the environment that are required for the various operations.+data Env = Env+  { -- | Static resources (Instance, Window, Surface, Adapter, Device, Queue).+    resources :: !SimpleSDL.Resources,+    -- | Map of shaders. Shaders can be added to this map by compiling them,+    -- and then accessed as required. (See the 'SimpleSDL' module.)+    shaders :: !SimpleSDL.Shaders,+    -- | Map of render pipelines. Different render pipelines can be added here+    -- and then accessed as required. (See the 'SimpleSDL' module.)+    renderPipelines :: !SimpleSDL.RenderPipelines,+    -- | Swap chain state. When the app window is re-sized, the swap chain must+    -- be re-created. This type contains the current swap chain state.+    swapChainState :: !SimpleSDL.SwapChainState+  }++instance Has SimpleSDL.Resources Env where+  hasLens = lens resources (\s x -> s {resources = x})++instance Has SimpleSDL.Shaders Env where+  hasLens = lens shaders (\s x -> s {shaders = x})++instance Has SimpleSDL.RenderPipelines Env where+  hasLens = lens renderPipelines (\s x -> s {renderPipelines = x})++instance Has SimpleSDL.SwapChainState Env where+  hasLens = lens swapChainState (\s x -> s {swapChainState = x})++envResourcesL :: Lens' Env SimpleSDL.Resources+envResourcesL = hasLens++instance Has WGPU.Instance Env where hasLens = envResourcesL . hasLens++instance Has SDL.Window Env where hasLens = envResourcesL . hasLens++instance Has WGPU.Surface Env where hasLens = envResourcesL . hasLens++instance Has WGPU.Adapter Env where hasLens = envResourcesL . hasLens++instance Has WGPU.Device Env where hasLens = envResourcesL . hasLens++instance Has WGPU.Queue Env where hasLens = envResourcesL . hasLens++-------------------------------------------------------------------------------+-- SDL Event Helpers++mKeyEvent :: SDL.Event -> Maybe SDL.KeyboardEventData+mKeyEvent event =+  case SDL.eventPayload event of+    SDL.KeyboardEvent keyboardEventData -> Just keyboardEventData+    _ -> Nothing++mKeyPressed :: SDL.KeyboardEventData -> Maybe SDL.Keysym+mKeyPressed ed =+  case SDL.keyboardEventKeyMotion ed of+    SDL.Pressed -> Just (SDL.keyboardEventKeysym ed)+    _ -> Nothing++eventIsQPress :: SDL.Event -> Bool+eventIsQPress event =+  fromMaybe False $+    mKeyEvent event >>= mKeyPressed >>= \keySym -> do+      if SDL.keysymKeycode keySym == SDL.KeycodeQ+        then Just True+        else Nothing++eventIsWindowClose :: SDL.Event -> Bool+eventIsWindowClose event =+  case SDL.eventPayload event of+    SDL.WindowClosedEvent _ -> True+    _ -> False++-------------------------------------------------------------------------------+-- Miscellaneous++-- | Print text to the console.+putStrLn :: MonadIO m => Text -> m ()+putStrLn = liftIO . TextIO.putStrLn

@@ -1,219 +0,0 @@-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}---- | Let's draw a triangle!-module Main (main) where--import Control.Monad (unless, when)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Except (runExceptT)-import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT)-import Data.Default (def)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as TextIO-import qualified Graphics.UI.GLFW as GLFW-import System.Exit (exitFailure)-import qualified WGPU--main :: IO ()-main = do-  TextIO.putStrLn "Triangle Example"--  -- start GLFW-  initResult <- GLFW.init-  unless initResult $ do-    TextIO.putStrLn "Failed to initialize GLFW"-    exitFailure--  -- create the GLFW window without a "client API"-  windowSzRef <- newIORef (640, 480)-  GLFW.windowHint (GLFW.WindowHint'ClientAPI GLFW.ClientAPI'NoAPI)-  window <- do-    mWin <- GLFW.createWindow 640 480 "Triangle" Nothing Nothing-    case mWin of-      Just w -> pure w-      Nothing -> do-        TextIO.putStrLn "Failed to create GLFW window"-        exitFailure--  WGPU.withPlatformInstance (Just WGPU.logStdout) $ \inst -> do-    -- set the logging level-    WGPU.setLogLevel inst WGPU.Warn--    -- print the version of the WGPU library-    version <- WGPU.getVersion inst-    TextIO.putStrLn $ "WGPU version: " <> WGPU.versionToText version--    -- fetch resources (surface, adpater, device)-    Resources {..} <- getResources inst window >>= getOrFail--    shader <- WGPU.createShaderModuleWGSL device "shader" shaderSrc-    swapChainFormat <- WGPU.getSwapChainPreferredFormat surface adapter-    swapChain <--      WGPU.createSwapChain-        device-        surface-        WGPU.SwapChainDescriptor-          { swapChainLabel = "SwapChain",-            usage = WGPU.TextureUsageRenderAttachment,-            swapChainFormat = swapChainFormat,-            width = 640,-            height = 480,-            presentMode = WGPU.PresentModeFifo-          }-    swapChainRef <- newIORef swapChain-    pipelineLayout <--      WGPU.createPipelineLayout-        device-        (WGPU.PipelineLayoutDescriptor "Pipeline" [])-    pipeline <--      WGPU.createRenderPipeline-        device-        WGPU.RenderPipelineDescriptor-          { renderPipelineLabel = "Render Pipeline",-            layout = WGPU.SJust pipelineLayout,-            vertex = WGPU.VertexState shader "vs_main" [],-            primitive = def,-            depthStencil = WGPU.SNothing,-            multisample = WGPU.MultisampleState 1 0xFFFFFFFF False,-            fragment =-              WGPU.SJust $-                WGPU.FragmentState-                  shader-                  "fs_main"-                  [ WGPU.ColorTargetState-                      swapChainFormat-                      (WGPU.SJust (WGPU.BlendState def def))-                      WGPU.colorWriteMaskAll-                  ]-          }--    let loop = do-          -- update swapchain if the window size is different-          updateSwapChain device surface window swapChainFormat windowSzRef swapChainRef-          -- render-          nextTexture <- WGPU.getSwapChainCurrentTextureView swapChain-          encoder <- WGPU.createCommandEncoder device "Command Encoder"-          renderPass <--            WGPU.beginRenderPass-              encoder-              ( WGPU.RenderPassDescriptor-                  { renderPassLabel = "Render Pass",-                    colorAttachments =-                      [ WGPU.RenderPassColorAttachment-                          nextTexture-                          WGPU.SNothing-                          ( WGPU.Operations-                              (WGPU.LoadOpClear (WGPU.Color 0 0 0 1))-                              WGPU.StoreOpStore-                          )-                      ],-                    depthStencilAttachment = WGPU.SNothing-                  }-              )-          WGPU.renderPassSetPipeline renderPass pipeline-          WGPU.renderPassDraw renderPass (WGPU.Range 0 3) (WGPU.Range 0 1)-          WGPU.endRenderPass renderPass-          commandBuffer <- WGPU.commandEncoderFinish encoder "Command Buffer"-          WGPU.queueSubmit queue [commandBuffer]-          WGPU.swapChainPresent swapChain--          -- handle GLFW quit event-          GLFW.pollEvents-          shouldClose <- GLFW.windowShouldClose window-          unless shouldClose loop--    loop--  -- close down GLFW-  GLFW.destroyWindow window-  GLFW.terminate--newtype Error = Error Text deriving (Eq, Show)--getOrFail :: Either Error a -> IO a-getOrFail ma =-  case ma of-    Right x -> pure x-    Left err -> failWith err--failWith :: Error -> IO a-failWith (Error err) = do-  TextIO.putStrLn err-  exitFailure--data Resources = Resources-  { surface :: WGPU.Surface,-    adapter :: WGPU.Adapter,-    device :: WGPU.Device,-    queue :: WGPU.Queue-  }--getResources :: WGPU.Instance -> GLFW.Window -> IO (Either Error Resources)-getResources inst window = runExceptT $ do-  -- fetch a surface for the window-  surface <- lift $ WGPU.createGLFWSurface inst window-  -- fetch an adapter for the surface-  adapter <--    maybeToExceptT-      (Error "Failed to obtain WGPU Adapter")-      (MaybeT $ WGPU.requestAdapter surface)-  -- fetch a device for the adapter-  let deviceDescriptor :: WGPU.DeviceDescriptor-      deviceDescriptor = def {WGPU.limits = def {WGPU.maxBindGroups = 1}}-  device <--    maybeToExceptT-      (Error "Failed to obtain WGPU Device")-      (MaybeT $ WGPU.requestDevice adapter deviceDescriptor)--  queue <- lift $ WGPU.getQueue device--  pure Resources {..}--updateSwapChain ::-  WGPU.Device ->-  WGPU.Surface ->-  GLFW.Window ->-  WGPU.TextureFormat ->-  IORef (Int, Int) ->-  IORef WGPU.SwapChain ->-  IO ()-updateSwapChain device surface window textureFormat szRef swapChainRef = do-  oldSz <- readIORef szRef-  curSz <- GLFW.getWindowSize window-  when (curSz /= oldSz) $ do-    writeIORef szRef curSz-    swapChain <--      WGPU.createSwapChain-        device-        surface-        WGPU.SwapChainDescriptor-          { swapChainLabel = "SwapChain",-            usage = WGPU.TextureUsageRenderAttachment,-            swapChainFormat = textureFormat,-            width = fromIntegral . fst $ curSz,-            height = fromIntegral . snd $ curSz,-            presentMode = WGPU.PresentModeFifo-          }-    writeIORef swapChainRef swapChain--shaderSrc :: WGPU.WGSL-shaderSrc =-  WGPU.WGSL $-    Text.intercalate-      "\n"-      [ "[[stage(vertex)]]",-        "fn vs_main([[builtin(vertex_index)]] in_vertex_index: u32) -> [[builtin(position)]] vec4<f32> {",-        "  let x = f32(i32(in_vertex_index) - 1);",-        "  let y = f32(i32(in_vertex_index & 1u) * 2 - 1);",-        "  return vec4<f32>(x, y, 0.0, 1.0);",-        "}",-        "",-        "[[stage(fragment)]]",-        "fn fs_main([[builtin(position)]] in: vec4<f32>) -> [[location(0)]] vec4<f32> {",-        "  return vec4<f32>(in.x/640.0, in.y/480.0, 1.0, 1.0);",-        "}"-      ]

@@ -1,5 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -9,21 +10,50 @@ module WGPU.Internal.Adapter   ( -- * Types     Adapter (..),+    AdapterType (..),+    BackendType (..),+    AdapterProperties (..),      -- * Functions     requestAdapter,+    getAdapterProperties,+    adapterPropertiesToText,   ) where -import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)-import Foreign (freeHaskellFunPtr, nullPtr)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Word (Word32)+import Foreign (nullPtr) import Foreign.Ptr (Ptr)+import Text.Printf (printf)+import WGPU.Internal.ChainedStruct (ChainedStruct (EmptyChain)) import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawPtr, showWithPtr)+import WGPU.Internal.Memory+  ( FromRaw,+    ToRaw,+    allocaC,+    evalContT,+    freeHaskellFunPtr,+    fromRaw,+    fromRawPtr,+    newEmptyMVar,+    putMVar,+    raw,+    rawPtr,+    showWithPtr,+    takeMVar,+  ) import WGPU.Internal.Surface (Surface, surfaceInst)+import WGPU.Raw.Generated.Enum.WGPUAdapterType (WGPUAdapterType)+import qualified WGPU.Raw.Generated.Enum.WGPUAdapterType as WGPUAdapterType+import WGPU.Raw.Generated.Enum.WGPUBackendType (WGPUBackendType)+import qualified WGPU.Raw.Generated.Enum.WGPUBackendType as WGPUBackendType+import qualified WGPU.Raw.Generated.Enum.WGPUNativeSType as WGPUSType import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPUAdapterProperties (WGPUAdapterProperties)+import qualified WGPU.Raw.Generated.Struct.WGPUAdapterProperties as WGPUAdapterProperties import WGPU.Raw.Generated.Struct.WGPURequestAdapterOptions   ( WGPURequestAdapterOptions,   )@@ -60,41 +90,149 @@  ------------------------------------------------------------------------------- +-- | Physical device type.+data AdapterType+  = AdapterTypeDiscreteGPU+  | AdapterTypeIntegratedGPU+  | AdapterTypeCPU+  | AdapterTypeUnknown+  deriving (Eq, Show)++instance ToRaw AdapterType WGPUAdapterType where+  raw adapterType = case adapterType of+    AdapterTypeDiscreteGPU -> pure WGPUAdapterType.DiscreteGPU+    AdapterTypeIntegratedGPU -> pure WGPUAdapterType.IntegratedGPU+    AdapterTypeCPU -> pure WGPUAdapterType.CPU+    AdapterTypeUnknown -> pure WGPUAdapterType.Unknown++instance FromRaw WGPUAdapterType AdapterType where+  fromRaw wAdapterType = pure $ case wAdapterType of+    WGPUAdapterType.DiscreteGPU -> AdapterTypeDiscreteGPU+    WGPUAdapterType.IntegratedGPU -> AdapterTypeIntegratedGPU+    WGPUAdapterType.CPU -> AdapterTypeCPU+    WGPUAdapterType.Unknown -> AdapterTypeUnknown+    _ -> AdapterTypeUnknown++-------------------------------------------------------------------------------++-- | Backends supported by WGPU.+data BackendType+  = BackendTypeNull+  | BackendTypeD3D11+  | BackendTypeD3D12+  | BackendTypeMetal+  | BackendTypeVulkan+  | BackendTypeOpenGL+  | BackendTypeOpenGLES+  deriving (Eq, Show)++instance ToRaw BackendType WGPUBackendType where+  raw backendType = case backendType of+    BackendTypeNull -> pure WGPUBackendType.Null+    BackendTypeD3D11 -> pure WGPUBackendType.D3D11+    BackendTypeD3D12 -> pure WGPUBackendType.D3D12+    BackendTypeMetal -> pure WGPUBackendType.Metal+    BackendTypeVulkan -> pure WGPUBackendType.Vulkan+    BackendTypeOpenGL -> pure WGPUBackendType.OpenGL+    BackendTypeOpenGLES -> pure WGPUBackendType.OpenGLES++instance FromRaw WGPUBackendType BackendType where+  fromRaw wBackendType = pure $ case wBackendType of+    WGPUBackendType.Null -> BackendTypeNull+    WGPUBackendType.D3D11 -> BackendTypeD3D11+    WGPUBackendType.D3D12 -> BackendTypeD3D12+    WGPUBackendType.Metal -> BackendTypeMetal+    WGPUBackendType.Vulkan -> BackendTypeVulkan+    WGPUBackendType.OpenGL -> BackendTypeOpenGL+    WGPUBackendType.OpenGLES -> BackendTypeOpenGLES+    _ -> BackendTypeNull++-------------------------------------------------------------------------------++data AdapterProperties = AdapterProperties+  { deviceID :: !Word32,+    vendorID :: !Word32,+    adapterName :: !Text,+    driverDescription :: !Text,+    adapterType :: !AdapterType,+    backendType :: !BackendType+  }+  deriving (Eq, Show)++instance ToRaw AdapterProperties WGPUAdapterProperties where+  raw AdapterProperties {..} = do+    chain_ptr <- rawPtr (EmptyChain WGPUSType.AdapterExtras)+    name_ptr <- rawPtr adapterName+    driverDescription_ptr <- rawPtr driverDescription+    n_adapterType <- raw adapterType+    n_backendType <- raw backendType+    pure+      WGPUAdapterProperties.WGPUAdapterProperties+        { nextInChain = chain_ptr,+          deviceID = deviceID,+          vendorID = vendorID,+          name = name_ptr,+          driverDescription = driverDescription_ptr,+          adapterType = n_adapterType,+          backendType = n_backendType+        }++instance FromRaw WGPUAdapterProperties AdapterProperties where+  fromRaw WGPUAdapterProperties.WGPUAdapterProperties {..} = do+    n_adapterName <- fromRaw name+    n_driverDescription <- fromRaw driverDescription+    n_adapterType <- fromRaw adapterType+    n_backendType <- fromRaw backendType+    pure+      AdapterProperties+        { deviceID = deviceID,+          vendorID = vendorID,+          adapterName = n_adapterName,+          driverDescription = n_driverDescription,+          adapterType = n_adapterType,+          backendType = n_backendType+        }++-------------------------------------------------------------------------------+ -- | Request an 'Adapter' that is compatible with a given 'Surface'. -- -- This action blocks until an available adapter is returned. requestAdapter ::+  (MonadIO m) =>   -- | Existing surface for which to request an @Adapter@.   Surface ->   -- | The returned @Adapter@, if it could be retrieved.-  IO (Maybe Adapter)-requestAdapter surface = evalContT $ do+  m (Maybe Adapter)+requestAdapter surface = liftIO . evalContT $ do   let inst = surfaceInst surface -  adapterMVar :: MVar WGPUAdapter <- liftIO newEmptyMVar--  let adapterCallback :: WGPUAdapter -> Ptr () -> IO ()-      adapterCallback adapter _ = putMVar adapterMVar adapter-  adapterCallback_c <- liftIO $ mkAdapterCallback adapterCallback+  adaptmv <- newEmptyMVar+  callback <- mkAdapterCallback (\a _ -> putMVar adaptmv a)    requestAdapterOptions_ptr <- rawPtr (RequestAdapterOptions surface)-  liftIO $-    RawFun.wgpuInstanceRequestAdapter-      (wgpuHsInstance inst)-      (WGPUInstance nullPtr)-      requestAdapterOptions_ptr-      adapterCallback_c-      nullPtr+  RawFun.wgpuInstanceRequestAdapter+    (wgpuHsInstance inst)+    (WGPUInstance nullPtr)+    requestAdapterOptions_ptr+    callback+    nullPtr -  adapter <- liftIO $ takeMVar adapterMVar-  liftIO $ freeHaskellFunPtr adapterCallback_c+  adapter <- takeMVar adaptmv+  freeHaskellFunPtr callback    pure $ case adapter of     WGPUAdapter ptr | ptr == nullPtr -> Nothing     WGPUAdapter _ -> Just (Adapter inst adapter) +mkAdapterCallback ::+  MonadIO m =>+  (WGPUAdapter -> Ptr () -> IO ()) ->+  m WGPURequestAdapterCallback+mkAdapterCallback = liftIO . mkAdapterCallbackIO+ foreign import ccall "wrapper"-  mkAdapterCallback ::+  mkAdapterCallbackIO ::     (WGPUAdapter -> Ptr () -> IO ()) -> IO WGPURequestAdapterCallback  newtype RequestAdapterOptions = RequestAdapterOptions {compatibleSurface :: Surface}@@ -107,3 +245,54 @@         { nextInChain = nullPtr,           compatibleSurface = n_surface         }++-------------------------------------------------------------------------------++-- | Get information about an adapter.+getAdapterProperties :: MonadIO m => Adapter -> m AdapterProperties+getAdapterProperties adapter = liftIO $+  evalContT $ do+    wgpuAdapterProperties_ptr <- allocaC+    RawFun.wgpuAdapterGetProperties+      (wgpuHsInstance . adapterInst $ adapter)+      (wgpuAdapter adapter)+      wgpuAdapterProperties_ptr+    fromRawPtr wgpuAdapterProperties_ptr++-- | Format adapter properties into a multi-line block of text.+--+-- This can be useful for debugging purposes.+adapterPropertiesToText :: AdapterProperties -> Text+adapterPropertiesToText AdapterProperties {..} =+  Text.unlines+    [ "Adapter Properties:",+      "  device ID   : " <> Text.pack (printf "0x%08x" deviceID),+      "  vendor ID   : " <> Text.pack (printf "0x%08x" vendorID),+      "  name        : "+        <> if Text.null adapterName+          then "(unknown)"+          else adapterName,+      "  description : "+        <> if Text.null driverDescription+          then "(unknown)"+          else driverDescription,+      "  type        : " <> adapterTypeTxt,+      "  backend     : " <> backendTypeTxt+    ]+  where+    adapterTypeTxt :: Text+    adapterTypeTxt = case adapterType of+      AdapterTypeDiscreteGPU -> "Discrete GPU"+      AdapterTypeIntegratedGPU -> "Integrated GPU"+      AdapterTypeCPU -> "CPU"+      AdapterTypeUnknown -> "(unknown)"++    backendTypeTxt :: Text+    backendTypeTxt = case backendType of+      BackendTypeNull -> "(unknown)"+      BackendTypeD3D11 -> "D3D 11"+      BackendTypeD3D12 -> "D3D 12"+      BackendTypeMetal -> "Metal"+      BackendTypeVulkan -> "Vulkan"+      BackendTypeOpenGL -> "OpenGL"+      BackendTypeOpenGLES -> "OpenGL ES"

@@ -26,8 +26,7 @@   ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits ((.|.)) import Data.Text (Text) import Data.Vector (Vector)@@ -35,8 +34,15 @@ import Foreign (nullPtr) import Foreign.C (CBool (CBool)) import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)-import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawArrayPtr, rawPtr, showWithPtr)+import WGPU.Internal.Instance (wgpuHsInstance)+import WGPU.Internal.Memory+  ( ToRaw,+    evalContT,+    raw,+    rawArrayPtr,+    rawPtr,+    showWithPtr,+  ) import WGPU.Internal.SMaybe (SMaybe, fromSMaybe) import WGPU.Internal.Texture (TextureFormat, TextureViewDimension) import WGPU.Raw.Generated.Enum.WGPUBufferBindingType (WGPUBufferBindingType)@@ -92,23 +98,22 @@  -- | Creates a 'BindGroupLayout'. createBindGroupLayout ::+  MonadIO m =>   -- | The device for which the bind group layout will be created.   Device ->   -- | Description of the bind group layout.   BindGroupLayoutDescriptor ->-  -- | IO action that creates a bind group layout.-  IO BindGroupLayout-createBindGroupLayout device ld = evalContT $ do-  let inst :: Instance-      inst = deviceInst device+  -- | MonadIO action that creates a bind group layout.+  m BindGroupLayout+createBindGroupLayout device ld = liftIO . evalContT $ do+  let inst = deviceInst device    bindGroupLayoutDescriptor_ptr <- rawPtr ld   rawBindGroupLayout <--    liftIO $-      RawFun.wgpuDeviceCreateBindGroupLayout-        (wgpuHsInstance inst)-        (wgpuDevice device)-        bindGroupLayoutDescriptor_ptr+    RawFun.wgpuDeviceCreateBindGroupLayout+      (wgpuHsInstance inst)+      (wgpuDevice device)+      bindGroupLayoutDescriptor_ptr   pure (BindGroupLayout rawBindGroupLayout)  -------------------------------------------------------------------------------@@ -118,7 +123,7 @@   { -- | Debug label of the bind group layout.     bindGroupLabel :: !Text,     -- | Sequence of entries in this bind group layout.-    entries :: Vector BindGroupLayoutEntry+    entries :: !(Vector BindGroupLayoutEntry)   }   deriving (Eq, Show) 

@@ -13,6 +13,8 @@ import WGPU.Raw.Generated.Struct.WGPUChainedStruct (WGPUChainedStruct) import qualified WGPU.Raw.Generated.Struct.WGPUChainedStruct as WGPUChainedStruct +-------------------------------------------------------------------------------+ -- | Represents a chained structure. data ChainedStruct a   = -- | Empty chained structure, but with a type tag.

@@ -18,12 +18,14 @@ import WGPU.Raw.Generated.Struct.WGPUColor (WGPUColor) import qualified WGPU.Raw.Generated.Struct.WGPUColor as WGPUColor +-------------------------------------------------------------------------------+ -- | RGBA double-precision color. data Color = Color-  { red :: Double,-    green :: Double,-    blue :: Double,-    alpha :: Double+  { red :: {-# UNPACK #-} !Double,+    green :: {-# UNPACK #-} !Double,+    blue :: {-# UNPACK #-} !Double,+    alpha :: {-# UNPACK #-} !Double   }   deriving (Eq, Show) 

@@ -14,14 +14,20 @@   ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (ContT (ContT), evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text (Text)-import Foreign (nullPtr, with)+import Foreign (nullPtr) import WGPU.Internal.CommandBuffer (CommandBuffer (CommandBuffer)) import WGPU.Internal.Device (Device, deviceInst, wgpuDevice) import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawPtr, showWithPtr)+import WGPU.Internal.Memory+  ( ToRaw,+    evalContT,+    raw,+    rawPtr,+    showWithPtr,+    withCZeroingAfter,+  ) import qualified WGPU.Raw.Generated.Fun as RawFun import WGPU.Raw.Generated.Struct.WGPUCommandBufferDescriptor (WGPUCommandBufferDescriptor) import qualified WGPU.Raw.Generated.Struct.WGPUCommandBufferDescriptor as WGPUCommandBufferDescriptor@@ -57,46 +63,46 @@  -- | Create an empty command encoder. createCommandEncoder ::+  MonadIO m =>   -- | Device for which to create the command encoder.   Device ->   -- | Debug label for the command encoder.   Text ->   -- | IO action that returns the command encoder.-  IO CommandEncoder-createCommandEncoder device label = evalContT $ do+  m CommandEncoder+createCommandEncoder device label = liftIO . evalContT $ do   let inst = deviceInst device   label_ptr <- rawPtr label   commandEncoderDescriptor_ptr <--    ContT . with $+    withCZeroingAfter $       WGPUCommandEncoderDescriptor.WGPUCommandEncoderDescriptor         { nextInChain = nullPtr,           label = label_ptr         }   commandEncoderRaw <--    liftIO $-      RawFun.wgpuDeviceCreateCommandEncoder-        (wgpuHsInstance inst)-        (wgpuDevice device)-        commandEncoderDescriptor_ptr+    RawFun.wgpuDeviceCreateCommandEncoder+      (wgpuHsInstance inst)+      (wgpuDevice device)+      commandEncoderDescriptor_ptr   pure (CommandEncoder inst commandEncoderRaw)  -- | Finish encoding commands, returning a command buffer. commandEncoderFinish ::+  MonadIO m =>   -- | Command encoder to finish.   CommandEncoder ->   -- | Debugging label for the command buffer.   Text ->   -- | IO action which returns the command buffer.-  IO CommandBuffer-commandEncoderFinish commandEncoder label = evalContT $ do+  m CommandBuffer+commandEncoderFinish commandEncoder label = liftIO . evalContT $ do   let inst = commandEncoderInst commandEncoder-  commandBufferDescriptor_ptr <- rawPtr $ CommandBufferDescriptor label+  commandBufferDescriptor_ptr <- rawPtr (CommandBufferDescriptor label)   commandBufferRaw <--    liftIO $-      RawFun.wgpuCommandEncoderFinish-        (wgpuHsInstance inst)-        (wgpuCommandEncoder commandEncoder)-        commandBufferDescriptor_ptr+    RawFun.wgpuCommandEncoderFinish+      (wgpuHsInstance inst)+      (wgpuCommandEncoder commandEncoder)+      commandBufferDescriptor_ptr   pure (CommandBuffer commandBufferRaw)  -------------------------------------------------------------------------------

@@ -19,18 +19,27 @@   ) where -import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (ContT (ContT), evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default (Default, def) import Data.Text (Text) import qualified Data.Text as Text import Data.Word (Word32)-import Foreign (Ptr, freeHaskellFunPtr, nullPtr, with)+import Foreign (Ptr, nullPtr) import WGPU.Internal.Adapter (Adapter, adapterInst, wgpuAdapter) import WGPU.Internal.ChainedStruct (ChainedStruct (EmptyChain, PtrChain)) import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawPtr, showWithPtr)+import WGPU.Internal.Memory+  ( ToRaw,+    evalContT,+    freeHaskellFunPtr,+    newEmptyMVar,+    putMVar,+    raw,+    rawPtr,+    showWithPtr,+    takeMVar,+    withCZeroingAfter,+  ) import WGPU.Raw.Generated.Enum.WGPUNativeFeature (WGPUNativeFeature) import qualified WGPU.Raw.Generated.Enum.WGPUNativeFeature as WGPUNativeFeature import qualified WGPU.Raw.Generated.Enum.WGPUNativeSType as WGPUSType@@ -178,44 +187,47 @@ -- -- This action blocks until an available device is returned. requestDevice ::+  MonadIO m =>   -- | @Adapter@ for which the device will be returned.   Adapter ->   -- | The features and limits requested for the device.   DeviceDescriptor ->   -- | The returned @Device@, if it could be retrieved.-  IO (Maybe Device)-requestDevice adapter deviceDescriptor = evalContT $ do+  m (Maybe Device)+requestDevice adapter deviceDescriptor = liftIO . evalContT $ do   let inst = adapterInst adapter -  deviceMVar :: MVar WGPUDevice <- liftIO newEmptyMVar--  let deviceCallback :: WGPUDevice -> Ptr () -> IO ()-      deviceCallback device _ = putMVar deviceMVar device-  deviceCallback_c <- liftIO $ mkDeviceCallback deviceCallback+  deviceMVar <- newEmptyMVar+  callback <- mkDeviceCallback (\d _ -> putMVar deviceMVar d)    deviceExtras_ptr <- rawPtr deviceDescriptor   nextInChain_ptr <- rawPtr (PtrChain WGPUSType.DeviceExtras deviceExtras_ptr)   deviceDescriptor_ptr <--    ContT . with $+    withCZeroingAfter $       WGPUDeviceDescriptor.WGPUDeviceDescriptor         { nextInChain = nextInChain_ptr         } -  liftIO $-    RawFun.wgpuAdapterRequestDevice-      (wgpuHsInstance inst)-      (wgpuAdapter adapter)-      deviceDescriptor_ptr-      deviceCallback_c-      nullPtr+  RawFun.wgpuAdapterRequestDevice+    (wgpuHsInstance inst)+    (wgpuAdapter adapter)+    deviceDescriptor_ptr+    callback+    nullPtr -  device <- liftIO $ takeMVar deviceMVar-  liftIO $ freeHaskellFunPtr deviceCallback_c+  device <- takeMVar deviceMVar+  freeHaskellFunPtr callback    pure $ case device of     WGPUDevice ptr | ptr == nullPtr -> Nothing     WGPUDevice _ -> Just (Device inst device) +mkDeviceCallback ::+  (MonadIO m) =>+  (WGPUDevice -> Ptr () -> IO ()) ->+  m WGPURequestDeviceCallback+mkDeviceCallback = liftIO . mkDeviceCallbackIO+ foreign import ccall "wrapper"-  mkDeviceCallback ::+  mkDeviceCallbackIO ::     (WGPUDevice -> Ptr () -> IO ()) -> IO WGPURequestDeviceCallback

@@ -0,0 +1,33 @@+-- |+-- Module      : WGPU.Internal.GLFW.Surface+-- Description : GLFW-specific surfaces.+module WGPU.Internal.GLFW.Surface+  ( -- * Functions+    createSurface,+  )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Graphics.UI.GLFW as GLFW+import WGPU.Internal.Instance (Instance, wgpuHsInstance)+import WGPU.Internal.Surface (Surface (Surface))+import qualified WGPU.Raw.GLFWSurface++-------------------------------------------------------------------------------++-- | Create a WGPU 'Surface' for a GLFW 'GLFW.Window'.+--+-- This function is not part of the @wgpu-native@ API, but is part of the+-- Haskell API until the native WGPU API has a better story around windowing.+createSurface ::+  MonadIO m =>+  -- | API instance.+  Instance ->+  -- | GLFW window for which the surface will be created.+  GLFW.Window ->+  -- | IO action to create the surface.+  m Surface+createSurface inst window =+  liftIO $+    Surface inst+      <$> WGPU.Raw.GLFWSurface.createSurface (wgpuHsInstance inst) window

@@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | -- Module      : WGPU.Internal.Instance@@ -9,19 +10,16 @@ -- Instance of the WGPU API Haskell bindings. module WGPU.Internal.Instance   ( -- * Instance--    ---    -- $instance-    Instance (..),+    Instance,+    wgpuHsInstance,     withPlatformInstance,     withInstance,      -- * Logging-    LogCallback,     LogLevel (..),     setLogLevel,-    logLevelToText,-    logStdout,+    connectLog,+    disconnectLog,      -- * Version     Version (..),@@ -30,40 +28,19 @@   ) where +import Control.Monad.IO.Class (MonadIO) import Data.Bits (shiftR, (.&.)) import Data.Text (Text) import qualified Data.Text as Text-import qualified Data.Text.IO as TextIO import Data.Word (Word32, Word8)-import Foreign (Ptr, freeHaskellFunPtr, nullFunPtr)-import Foreign.C (CChar, peekCString) import qualified System.Info import WGPU.Internal.Memory (ToRaw, raw)-import WGPU.Raw.Dynamic (withWGPU)-import WGPU.Raw.Generated.Enum.WGPULogLevel (WGPULogLevel (WGPULogLevel))+import WGPU.Raw.Dynamic (InstanceHandle, instanceHandleInstance, withWGPU)+import WGPU.Raw.Generated.Enum.WGPULogLevel (WGPULogLevel) import qualified WGPU.Raw.Generated.Enum.WGPULogLevel as WGPULogLevel import WGPU.Raw.Generated.Fun (WGPUHsInstance) import qualified WGPU.Raw.Generated.Fun as RawFun-import WGPU.Raw.Types (WGPULogCallback)---- $instance------ The Haskell bindings to WGPU use a value of type 'Instance' as a handle to--- the rest of the API. An 'Instance' value is obtained by loading a dynamic--- library at runtime, using the 'withInstance' function. A typical invocation--- might look like this:------ @--- 'withInstance' "libwgpu_native.dylib" (Just 'logStdOut') $ \inst -> do---   -- set the logging level for the instance---   'setLogLevel' inst 'Warn'---   -- run the rest of the program ...--- @------ The dynamic library @libwgpu_native.dylib@ is obtained by compiling the--- Rust project <https://github.com/gfx-rs/wgpu-native wgpu-native>. Care--- should be take to compile a version of @libwgpu_native.dylib@ which is--- compatible with the API in these bindings.+import qualified WGPU.Raw.Log as RawLog  ------------------------------------------------------------------------------- @@ -71,8 +48,11 @@ -- -- An instance is loaded from a dynamic library using the 'withInstance' -- function.-newtype Instance = Instance {wgpuHsInstance :: WGPUHsInstance}+newtype Instance = Instance {instanceHandle :: InstanceHandle} +wgpuHsInstance :: Instance -> WGPUHsInstance+wgpuHsInstance = instanceHandleInstance . instanceHandle+ instance Show Instance where show _ = "<Instance>"  instance ToRaw Instance WGPUHsInstance where@@ -87,51 +67,33 @@ -- per-platform name for the library, based on the value returned by -- 'System.Info.os'. withPlatformInstance ::-  -- | Optional logging callback. @'Just' 'logStdout'@ can be supplied here to-  --   print log messages to @stdout@ for debugging purposes.-  Maybe LogCallback ->-  -- | The Program. A function which takes an 'Instance' and returns an IO-  --   action that uses the instance.-  (Instance -> IO a) ->-  -- | IO action which loads the WGPU 'Instance', passes it to the program, and-  --   returns the result of running the program.-  IO a+  MonadIO m =>+  -- | Bracketing function.+  -- This can (for example) be something like 'Control.Exception.Safe.bracket'.+  (m Instance -> (Instance -> m ()) -> r) ->+  -- | Usage or action component of the bracketing function.+  r withPlatformInstance = withInstance platformDylibName  -- | Load the WGPU API from a dynamic library and supply an 'Instance' to a -- program. withInstance ::+  forall m r.+  MonadIO m =>   -- | Name of the @wgpu-native@ dynamic library, or a complete path to it.   FilePath ->-  -- | Optional logging callback. @'Just' 'logStdout'@ can be supplied here to-  --   print log messages to @stdout@ for debugging purposes.-  Maybe LogCallback ->-  -- | The Program. A function which takes an 'Instance' and returns an IO-  --   action that uses the instance.-  (Instance -> IO a) ->-  -- | IO action which loads the WGPU 'Instance', passes it to the program, and-  --   returns the result of running the program.-  IO a-withInstance dylibPath mLog program =-  withWGPU dylibPath $-    \winst -> do-      -- create the logging callback if necessary-      logCallback_c <- case mLog of-        Nothing -> pure nullFunPtr-        Just logFn -> mkLogCallback . toRawLogCallback $ logFn-      RawFun.wgpuSetLogCallback winst logCallback_c--      -- run the program-      result <- program (Instance winst)--      -- free the logging callback-      case mLog of-        Nothing -> pure ()-        Just _ -> do-          RawFun.wgpuSetLogCallback winst nullFunPtr-          freeHaskellFunPtr logCallback_c--      pure result+  -- | Bracketing function.+  -- This can (for example) be something like 'Control.Exception.Safe.bracket'.+  (m Instance -> (Instance -> m ()) -> r) ->+  -- | Usage or action component of the bracketing function.+  r+withInstance dylibPath bkt = withWGPU dylibPath bkt'+  where+    bkt' :: m InstanceHandle -> (InstanceHandle -> m ()) -> r+    bkt' create release =+      bkt+        (Instance <$> create)+        (release . instanceHandle)  -- | Return the dynamic library name for a given platform. --@@ -157,39 +119,11 @@   | Error   deriving (Eq, Show) --- | Logging callback function.-type LogCallback = LogLevel -> Text -> IO ()- -- | Set the current logging level for the instance.-setLogLevel :: Instance -> LogLevel -> IO ()+setLogLevel :: MonadIO m => Instance -> LogLevel -> m () setLogLevel inst lvl =   RawFun.wgpuSetLogLevel (wgpuHsInstance inst) (logLevelToWLogLevel lvl) --- | Create a C callback from a Haskell logging function.-foreign import ccall "wrapper"-  mkLogCallback ::-    (WGPULogLevel -> Ptr CChar -> IO ()) ->-    IO WGPULogCallback---- | Convert a logging callback function to the form required by the Raw API.-toRawLogCallback :: LogCallback -> (WGPULogLevel -> Ptr CChar -> IO ())-toRawLogCallback logFn wLogLevel cMsg = do-  msg <- Text.pack <$> peekCString cMsg-  logFn (wLogLevelToLogLevel wLogLevel) msg---- | Convert a raw API logging level into a 'LogLevel'.------ Any unknown log levels become an 'Error'.-wLogLevelToLogLevel :: WGPULogLevel -> LogLevel-wLogLevelToLogLevel wLvl =-  case wLvl of-    WGPULogLevel.Trace -> Trace-    WGPULogLevel.Debug -> Debug-    WGPULogLevel.Info -> Info-    WGPULogLevel.Warn -> Warn-    WGPULogLevel.Error -> Error-    _ -> Error- -- | Convert a 'LogLevel' value into the type required by the raw API. logLevelToWLogLevel :: LogLevel -> WGPULogLevel logLevelToWLogLevel lvl =@@ -200,22 +134,13 @@     Warn -> WGPULogLevel.Warn     Error -> WGPULogLevel.Error --- | Convert a 'LogLevel' to a text string.-logLevelToText :: LogLevel -> Text-logLevelToText lvl =-  case lvl of-    Trace -> "Trace"-    Debug -> "Debug"-    Info -> "Info"-    Warn -> "Warn"-    Error -> "Error"+-- | Connect a stdout logger to the instance.+connectLog :: MonadIO m => Instance -> m ()+connectLog inst = RawLog.connectLog (wgpuHsInstance inst) --- | A logging function which prints to @stdout@.------ This logging function can be supplied to 'withInstance' to print logging--- messages to @stdout@ for debugging purposes.-logStdout :: LogLevel -> Text -> IO ()-logStdout lvl msg = TextIO.putStrLn $ "[" <> logLevelToText lvl <> "]: " <> msg+-- | Disconnect a stdout logger from the instance.+disconnectLog :: MonadIO m => Instance -> m ()+disconnectLog inst = RawLog.disconnectLog (wgpuHsInstance inst)  ------------------------------------------------------------------------------- @@ -229,7 +154,7 @@   deriving (Eq, Show)  -- | Return the exact version of the WGPU native instance.-getVersion :: Instance -> IO Version+getVersion :: MonadIO m => Instance -> m Version getVersion inst = w32ToVersion <$> RawFun.wgpuGetVersion (wgpuHsInstance inst)   where     w32ToVersion :: Word32 -> Version

@@ -61,17 +61,32 @@ module WGPU.Internal.Memory   ( -- * Classes     ToRaw (raw),+    FromRaw (fromRaw),     ToRawPtr (rawPtr),+    FromRawPtr (fromRawPtr),      -- * Functions++    -- ** Internal+    evalContT,+    allocaC,     rawArrayPtr,     showWithPtr,+    withCZeroingAfter,++    -- ** Lifted to MonadIO+    newEmptyMVar,+    takeMVar,+    putMVar,+    freeHaskellFunPtr,+    poke,   ) where -import Control.Monad (forM_)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (ContT (ContT), evalContT)+import Control.Concurrent (MVar)+import qualified Control.Concurrent (newEmptyMVar, putMVar, takeMVar)+import Control.Monad.Cont (ContT (ContT), callCC, runContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCString) import Data.Text (Text)@@ -80,17 +95,20 @@ import qualified Data.Vector.Generic as Vector import Data.Word (Word8) import Foreign-  ( Ptr,+  ( FunPtr,+    Ptr,     Storable,     advancePtr,+    alignment,+    alloca,     allocaArray,     castPtr,-    fillBytes,-    poke,+    nullPtr,+    peek,     sizeOf,-    with,   )-import Foreign.C (CBool, CChar, withCString)+import qualified Foreign (fillBytes, freeHaskellFunPtr, poke)+import Foreign.C (CBool, CChar, peekCString, withCString)  ------------------------------------------------------------------------------- -- Type Classes@@ -104,7 +122,7 @@ class ToRaw a b | a -> b where   -- | Convert a value to a raw representation, bracketing any resource   -- management.-  raw :: a -> ContT c IO b+  raw :: a -> ContT r IO b  -- | Represents a value of type @a@ that can be stored as type @(Ptr b)@ in the -- 'ContT' monad.@@ -114,72 +132,138 @@ -- allocated for @('Ptr' b)@ must be allocated before the continuation is -- called, and freed afterward. class ToRawPtr a b where-  rawPtr :: a -> ContT c IO (Ptr b)+  rawPtr :: a -> ContT r IO (Ptr b) +-- | Represents a type @a@ that can be read from a raw value @b@.+class FromRaw b a | a -> b where+  fromRaw :: MonadIO m => b -> m a++-- | Represents a type @a@ that can be read from a raw pointer @b@.+class FromRawPtr b a where+  fromRawPtr :: MonadIO m => Ptr b -> m a+ ------------------------------------------------------------------------------- -- Derived Functionality  -- | Return a pointer to an allocated array, populated with raw values from a -- vector. rawArrayPtr ::-  forall v a b c.+  forall v r a b.   (ToRaw a b, Storable b, Vector v a) =>   -- | Vector of values to store in a C array.   v a ->   -- | Pointer to the array with raw values stored in it.-  ContT c IO (Ptr b)-rawArrayPtr xs =-  ContT $ \action -> do-    let n :: Int-        n = Vector.length xs-    allocaArray n $ \arrayPtr ->-      evalContT $ do-        forM_-          (zip (Vector.toList xs) [0 ..])-          (\(x, i) -> pokeRaw x (advancePtr arrayPtr i))-        liftIO (action arrayPtr)-  where-    pokeRaw :: a -> Ptr b -> ContT c IO ()-    pokeRaw value raw_ptr = raw value >>= liftIO . poke raw_ptr+  ContT r IO (Ptr b)+rawArrayPtr xs = callCC $ \k -> do+  let pokeRaw :: a -> Ptr b -> ContT c IO ()+      pokeRaw value raw_ptr = raw value >>= liftIO . poke raw_ptr +      n :: Int+      n = Vector.length xs+  arrayPtr <- allocaArrayC n+  Vector.iforM_ xs $ \i x -> pokeRaw x (advancePtr arrayPtr i)+  r <- k arrayPtr+  zeroMemory arrayPtr (n * alignment (undefined :: b))+  pure r+{-# INLINEABLE rawArrayPtr #-}+ ------------------------------------------------------------------------------- -- Instances  -- Allow every ToRaw instance to be a ToRawPtr instance. instance {-# OVERLAPPABLE #-} (Storable b, ToRaw a b) => ToRawPtr a b where-  rawPtr x = do-    rawX <- raw x-    ContT $ zeroingWith rawX+  rawPtr x = raw x >>= withCZeroingAfter+  {-# INLINEABLE rawPtr #-} -instance ToRaw Bool CBool where raw x = pure (if x then 1 else 0)+instance {-# OVERLAPPABLE #-} (Storable b, FromRaw b a) => FromRawPtr b a where+  fromRawPtr ptr = (liftIO . peek) ptr >>= fromRaw+  {-# INLINEABLE fromRawPtr #-} -instance ToRawPtr Text CChar where rawPtr = ContT . withCString . Text.unpack+instance ToRaw Bool CBool where+  raw x = pure (if x then 1 else 0)+  {-# INLINE raw #-} +instance ToRawPtr Text CChar where+  rawPtr = withCStringC . Text.unpack+  {-# INLINEABLE rawPtr #-}+ instance ToRawPtr ByteString Word8 where-  rawPtr byteString =-    ContT $ \action -> unsafeUseAsCString byteString (action . castPtr)+  rawPtr = fmap castPtr . unsafeUseAsCStringC+  {-# INLINEABLE rawPtr #-} +instance FromRaw (Ptr CChar) Text where+  fromRaw ptr =+    if ptr == nullPtr+      then pure Text.empty+      else (liftIO . fmap Text.pack . peekCString) ptr+  {-# INLINEABLE fromRaw #-}+ ---------------------------------------------------------------------------------- Utils+-- Continuation helpers --- | Like 'with', but zeroes memory after the action has been performed.------ Allocates memory for a value of type @a@ and fills the memory with the--- 'Foreign.Storable' representation of the @a@ value.-zeroingWith ::-  Storable a =>-  -- | Value to use.-  a ->-  -- | Action to perform with a pointer to the value.-  (Ptr a -> IO b) ->-  -- | Result of running the action.-  IO b-zeroingWith value action =-  with value $ \value_ptr -> do-    result <- action value_ptr-    fillBytes value_ptr 0x00 (sizeOf value)-    pure result+allocaC :: Storable a => ContT r IO (Ptr a)+allocaC = ContT alloca+{-# INLINEABLE allocaC #-} +allocaArrayC :: Storable a => Int -> ContT r IO (Ptr a)+allocaArrayC sz = ContT (allocaArray sz)+{-# INLINEABLE allocaArrayC #-}++withCStringC :: String -> ContT r IO (Ptr CChar)+withCStringC str = ContT (withCString str)+{-# INLINEABLE withCStringC #-}++unsafeUseAsCStringC :: ByteString -> ContT r IO (Ptr CChar)+unsafeUseAsCStringC byteString = ContT (unsafeUseAsCString byteString)+{-# INLINEABLE unsafeUseAsCStringC #-}++withCZeroingAfter :: Storable a => a -> ContT r IO (Ptr a)+withCZeroingAfter x = callCC $ \k -> do+  ptr <- allocaC+  poke ptr x+  r <- k ptr+  zeroMemory ptr (sizeOf x)+  pure r+{-# INLINEABLE withCZeroingAfter #-}++-------------------------------------------------------------------------------+-- Memory actions lifted to MonadIO++newEmptyMVar :: MonadIO m => m (MVar a)+newEmptyMVar = liftIO Control.Concurrent.newEmptyMVar+{-# INLINEABLE newEmptyMVar #-}++takeMVar :: MonadIO m => MVar a -> m a+takeMVar = liftIO . Control.Concurrent.takeMVar+{-# INLINEABLE takeMVar #-}++putMVar :: MonadIO m => MVar a -> a -> m ()+putMVar mvar x = liftIO $ Control.Concurrent.putMVar mvar x+{-# INLINEABLE putMVar #-}++poke :: (MonadIO m, Storable a) => Ptr a -> a -> m ()+poke ptr value = liftIO (Foreign.poke ptr value)+{-# INLINEABLE poke #-}++freeHaskellFunPtr :: MonadIO m => FunPtr a -> m ()+freeHaskellFunPtr = liftIO . Foreign.freeHaskellFunPtr+{-# INLINEABLE freeHaskellFunPtr #-}++fillBytes :: MonadIO m => Ptr a -> Word8 -> Int -> m ()+fillBytes ptr x sz = liftIO (Foreign.fillBytes ptr x sz)+{-# INLINEABLE fillBytes #-}++zeroMemory :: MonadIO m => Ptr a -> Int -> m ()+zeroMemory ptr = fillBytes ptr 0x00+{-# INLINEABLE zeroMemory #-}++-------------------------------------------------------------------------------++evalContT :: Monad m => ContT a m a -> m a+evalContT cont = runContT cont pure++-------------------------------------------------------------------------------+ -- | Formatter for 'Show' instances for opaque pointers. -- -- Displays a name and a corresponding opaque pointer.@@ -191,3 +275,4 @@   -- | Final show string.   String showWithPtr name ptr = "<" <> name <> ":" <> show ptr <> ">"+{-# INLINEABLE showWithPtr #-}

@@ -40,8 +40,7 @@   ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits ((.|.)) import Data.Default (Default, def) import Data.Int (Int32)@@ -53,8 +52,15 @@ import Foreign.C (CFloat (CFloat)) import WGPU.Internal.Binding (BindGroupLayout) import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)-import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawArrayPtr, rawPtr, showWithPtr)+import WGPU.Internal.Instance (wgpuHsInstance)+import WGPU.Internal.Memory+  ( ToRaw,+    evalContT,+    raw,+    rawArrayPtr,+    rawPtr,+    showWithPtr,+  ) import WGPU.Internal.Multipurpose (CompareFunction) import WGPU.Internal.RenderPass (RenderPipeline (RenderPipeline)) import WGPU.Internal.SMaybe (SMaybe (SJust, SNothing))@@ -155,20 +161,20 @@  -- | Create a pipeline layout. createPipelineLayout ::+  MonadIO m =>   -- | The device for which the pipeline layout will be created.   Device ->   -- | Descriptor of the pipeline.   PipelineLayoutDescriptor ->-  IO PipelineLayout-createPipelineLayout device pdl = evalContT $ do+  m PipelineLayout+createPipelineLayout device pdl = liftIO . evalContT $ do   let inst = deviceInst device   pipelineLayoutDescriptor_ptr <- rawPtr pdl   rawPipelineLayout <--    liftIO $-      RawFun.wgpuDeviceCreatePipelineLayout-        (wgpuHsInstance inst)-        (wgpuDevice device)-        pipelineLayoutDescriptor_ptr+    RawFun.wgpuDeviceCreatePipelineLayout+      (wgpuHsInstance inst)+      (wgpuDevice device)+      pipelineLayoutDescriptor_ptr   pure (PipelineLayout rawPipelineLayout)  -------------------------------------------------------------------------------@@ -248,11 +254,11 @@ -- | Vertex inputs (attributes) to shaders. data VertexAttribute = VertexAttribute   { -- | Format of the input.-    vertexFormat :: VertexFormat,+    vertexFormat :: !VertexFormat,     -- | Byte offset of the start of the input.-    offset :: Word64,+    offset :: !Word64,     -- | Location for this input. Must match the location in the shader.-    shaderLocation :: Word32+    shaderLocation :: !Word32   }   deriving (Eq, Show) @@ -879,19 +885,19 @@           fragment = n_fragment         } +-------------------------------------------------------------------------------+ createRenderPipeline ::+  MonadIO m =>   Device ->   RenderPipelineDescriptor ->-  IO RenderPipeline-createRenderPipeline device rpd = evalContT $ do-  let inst :: Instance-      inst = deviceInst device-+  m RenderPipeline+createRenderPipeline device rpd = liftIO . evalContT $ do+  let inst = deviceInst device   renderPipelineDescriptor_ptr <- rawPtr rpd   renderPipelineRaw <--    liftIO $-      RawFun.wgpuDeviceCreateRenderPipeline-        (wgpuHsInstance inst)-        (wgpuDevice device)-        renderPipelineDescriptor_ptr+    RawFun.wgpuDeviceCreateRenderPipeline+      (wgpuHsInstance inst)+      (wgpuDevice device)+      renderPipelineDescriptor_ptr   pure (RenderPipeline renderPipelineRaw)

@@ -14,14 +14,12 @@   ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Vector (Vector)-import Data.Word (Word32) import WGPU.Internal.CommandBuffer (CommandBuffer) import WGPU.Internal.Device (Device, deviceInst, wgpuDevice) import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawArrayPtr, showWithPtr)+import WGPU.Internal.Memory (ToRaw, evalContT, raw, rawArrayPtr, showWithPtr) import qualified WGPU.Raw.Generated.Fun as RawFun import WGPU.Raw.Types (WGPUQueue (WGPUQueue)) @@ -49,26 +47,21 @@ -------------------------------------------------------------------------------  -- | Get the queue for a device.-getQueue :: Device -> IO Queue+getQueue :: MonadIO m => Device -> m Queue getQueue device = do-  let queueInst :: Instance-      queueInst = deviceInst device+  let queueInst = deviceInst device   wgpuQueue <-     RawFun.wgpuDeviceGetQueue (wgpuHsInstance queueInst) (wgpuDevice device)   pure Queue {..}  -- | Submit a list of command buffers to a device queue.-queueSubmit :: Queue -> Vector CommandBuffer -> IO ()-queueSubmit queue cbs = evalContT $ do-  let inst :: Instance-      inst = queueInst queue-  let commandCount :: Word32-      commandCount = fromIntegral . length $ cbs-+queueSubmit :: MonadIO m => Queue -> Vector CommandBuffer -> m ()+queueSubmit queue cbs = liftIO . evalContT $ do+  let inst = queueInst queue+  let commandCount = fromIntegral . length $ cbs   commandBuffer_ptr <- rawArrayPtr cbs-  liftIO $-    RawFun.wgpuQueueSubmit-      (wgpuHsInstance inst)-      (wgpuQueue queue)-      commandCount-      commandBuffer_ptr+  RawFun.wgpuQueueSubmit+    (wgpuHsInstance inst)+    (wgpuQueue queue)+    commandCount+    commandBuffer_ptr

@@ -24,17 +24,27 @@   ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text (Text) import Data.Vector (Vector) import Data.Word (Word32) import Foreign (nullPtr) import Foreign.C (CBool (CBool), CFloat (CFloat)) import WGPU.Internal.Color (Color, transparentBlack)-import WGPU.Internal.CommandEncoder (CommandEncoder, commandEncoderInst, wgpuCommandEncoder)+import WGPU.Internal.CommandEncoder+  ( CommandEncoder,+    commandEncoderInst,+    wgpuCommandEncoder,+  ) import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawArrayPtr, rawPtr, showWithPtr)+import WGPU.Internal.Memory+  ( ToRaw,+    evalContT,+    raw,+    rawArrayPtr,+    rawPtr,+    showWithPtr,+  ) import WGPU.Internal.SMaybe (SMaybe (SJust, SNothing)) import WGPU.Internal.Texture (TextureView) import qualified WGPU.Raw.Generated.Enum.WGPULoadOp as WGPULoadOp@@ -104,6 +114,8 @@     LoadOpLoad   deriving (Eq, Show) +-------------------------------------------------------------------------------+ -- | Operation to perform to the output attachment at the end of the render -- pass. data StoreOp@@ -120,12 +132,16 @@         StoreOpStore -> WGPUStoreOp.Store         StoreOpClear -> WGPUStoreOp.Clear +-------------------------------------------------------------------------------+ data Operations a = Operations   { load :: !(LoadOp a),-    store :: StoreOp+    store :: !StoreOp   }   deriving (Eq, Show) +-------------------------------------------------------------------------------+ -- | Describes a color attachment to a render pass. data RenderPassColorAttachment = RenderPassColorAttachment   { -- | The view to use as an attachment.@@ -162,6 +178,8 @@           clearColor = n_clearColor         } +-------------------------------------------------------------------------------+ -- | Describes a depth/stencil attachment to a render pass. data RenderPassDepthStencilAttachment = RenderPassDepthStencilAttachment   { -- | The view to use as an attachment.@@ -228,6 +246,8 @@           stencilReadOnly = n_stencilReadOnly         } +-------------------------------------------------------------------------------+ -- | Describes the attachments of a render pass. data RenderPassDescriptor = RenderPassDescriptor   { -- | Debugging label for the render pass.@@ -257,6 +277,8 @@           occlusionQuerySet = WGPUQuerySet nullPtr         } +-------------------------------------------------------------------------------+ -- | Half open range. It includes the 'start' value but not the 'end' value. data Range a = Range   { rangeStart :: !a,@@ -264,41 +286,40 @@   }   deriving (Eq, Show) +-------------------------------------------------------------------------------+ -- | Begins recording of a render pass. beginRenderPass ::+  MonadIO m =>   -- | @CommandEncoder@ to contain the render pass.   CommandEncoder ->   -- | Description of the render pass.   RenderPassDescriptor ->   -- | IO action which returns the render pass encoder.-  IO RenderPassEncoder-beginRenderPass commandEncoder rpd = evalContT $ do-  let inst :: Instance-      inst = commandEncoderInst commandEncoder-+  m RenderPassEncoder+beginRenderPass commandEncoder rpd = liftIO . evalContT $ do+  let inst = commandEncoderInst commandEncoder   renderPassDescriptor_ptr <- rawPtr rpd   renderPassEncoderRaw <--    liftIO $-      RawFun.wgpuCommandEncoderBeginRenderPass-        (wgpuHsInstance inst)-        (wgpuCommandEncoder commandEncoder)-        renderPassDescriptor_ptr+    RawFun.wgpuCommandEncoderBeginRenderPass+      (wgpuHsInstance inst)+      (wgpuCommandEncoder commandEncoder)+      renderPassDescriptor_ptr   pure (RenderPassEncoder inst renderPassEncoderRaw)  -- | Sets the active render pipeline. -- -- Subsequent draw calls will exhibit the behaviour defined by the pipeline. renderPassSetPipeline ::+  MonadIO m =>   -- | Render pass encoder on which to act.   RenderPassEncoder ->   -- | Render pipeline to set active.   RenderPipeline ->   -- | IO action which sets the active render pipeline.-  IO ()+  m () renderPassSetPipeline renderPassEncoder renderPipeline = do-  let inst :: Instance-      inst = renderPassEncoderInst renderPassEncoder-+  let inst = renderPassEncoderInst renderPassEncoder   RawFun.wgpuRenderPassEncoderSetPipeline     (wgpuHsInstance inst)     (wgpuRenderPassEncoder renderPassEncoder)@@ -306,6 +327,7 @@  -- | Draws primitives from the active vertex buffers. renderPassDraw ::+  MonadIO m =>   -- | Render pass encoder on which to act.   RenderPassEncoder ->   -- | Range of vertices to draw.@@ -313,11 +335,9 @@   -- | Range of instances to draw.   Range Word32 ->   -- | IO action which stores the draw command.-  IO ()+  m () renderPassDraw renderPassEncoder vertices instances = do-  let inst :: Instance-      inst = renderPassEncoderInst renderPassEncoder-+  let inst = renderPassEncoderInst renderPassEncoder   RawFun.wgpuRenderPassEncoderDraw     (wgpuHsInstance inst)     (wgpuRenderPassEncoder renderPassEncoder)@@ -328,14 +348,13 @@  -- | Finish recording of a render pass. endRenderPass ::+  MonadIO m =>   -- | Render pass encoder on which to finish recording.   RenderPassEncoder ->   -- | IO action that finishes recording.-  IO ()+  m () endRenderPass renderPassEncoder = do-  let inst :: Instance-      inst = renderPassEncoderInst renderPassEncoder-+  let inst = renderPassEncoderInst renderPassEncoder   RawFun.wgpuRenderPassEncoderEndPass     (wgpuHsInstance inst)     (wgpuRenderPassEncoder renderPassEncoder)

@@ -0,0 +1,23 @@+-- |+-- Module      : WGPU.Internal.SDL.Surface+-- Description : SDL-specific surfaces.+module WGPU.Internal.SDL.Surface+  ( -- * Functions+    createSurface,+  )+where++import Control.Monad.IO.Class (MonadIO)+import qualified SDL (Window)+import WGPU.Internal.Instance (Instance, wgpuHsInstance)+import WGPU.Internal.Surface (Surface (Surface))+import qualified WGPU.Raw.SDLSurface (createSurface)++createSurface ::+  MonadIO m =>+  Instance ->+  SDL.Window ->+  m Surface+createSurface inst window =+  Surface inst+    <$> WGPU.Raw.SDLSurface.createSurface (wgpuHsInstance inst) window

@@ -21,8 +21,7 @@   ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import Data.String (IsString)@@ -32,8 +31,15 @@ import Foreign.C (CChar) import WGPU.Internal.ChainedStruct (ChainedStruct (EmptyChain, PtrChain)) import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)-import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, ToRawPtr, raw, rawPtr, showWithPtr)+import WGPU.Internal.Instance (wgpuHsInstance)+import WGPU.Internal.Memory+  ( ToRaw,+    ToRawPtr,+    evalContT,+    raw,+    rawPtr,+    showWithPtr,+  ) import qualified WGPU.Raw.Generated.Enum.WGPUSType as WGPUSType import qualified WGPU.Raw.Generated.Fun as RawFun import WGPU.Raw.Generated.Struct.WGPUShaderModuleDescriptor (WGPUShaderModuleDescriptor)@@ -67,26 +73,26 @@  -- | Create a shader module from either SPIR-V or WGSL source code. createShaderModule ::+  MonadIO m =>   -- | Device for the shader.   Device ->   -- | Descriptor of the shader module.   ShaderModuleDescriptor ->   -- | IO action producing the shader module.-  IO ShaderModule-createShaderModule device smd = evalContT $ do-  let inst :: Instance-      inst = deviceInst device+  m ShaderModule+createShaderModule device smd = liftIO . evalContT $ do+  let inst = deviceInst device   shaderModuleDescriptor_ptr <- rawPtr smd   rawShaderModule <--    liftIO $-      RawFun.wgpuDeviceCreateShaderModule-        (wgpuHsInstance inst)-        (wgpuDevice device)-        shaderModuleDescriptor_ptr+    RawFun.wgpuDeviceCreateShaderModule+      (wgpuHsInstance inst)+      (wgpuDevice device)+      shaderModuleDescriptor_ptr   pure (ShaderModule rawShaderModule)  -- | Create a shader module from SPIR-V source code. createShaderModuleSPIRV ::+  MonadIO m =>   -- | Device for which the shader should be created.   Device ->   -- | Debugging label for the shader.@@ -94,7 +100,7 @@   -- | Shader source code (SPIR-V bytestring).   SPIRV ->   -- | IO action creating the shader module.-  IO ShaderModule+  m ShaderModule createShaderModuleSPIRV device label spirv =   createShaderModule device smd   where@@ -107,6 +113,7 @@  -- | Create a shader module from WGSL source code. createShaderModuleWGSL ::+  MonadIO m =>   -- | Device for which the shader should be created.   Device ->   -- | Debugging label for the shader.@@ -114,7 +121,7 @@   -- | Shader source code (WGSL source string).   WGSL ->   -- | IO action creating the shader module.-  IO ShaderModule+  m ShaderModule createShaderModuleWGSL device label wgsl =   createShaderModule device smd   where

@@ -3,21 +3,14 @@ -- | -- Module      : WGPU.Internal.Surface -- Description : Platform-specific surfaces.------ Device-specific surfaces. module WGPU.Internal.Surface   ( -- * Types     Surface (..),--    -- * Functions-    createGLFWSurface,   ) where -import qualified Graphics.UI.GLFW as GLFW-import WGPU.Internal.Instance (Instance, wgpuHsInstance)+import WGPU.Internal.Instance (Instance) import WGPU.Internal.Memory (ToRaw, raw, showWithPtr)-import qualified WGPU.Raw.GLFWSurface import WGPU.Raw.Types (WGPUSurface (WGPUSurface))  -------------------------------------------------------------------------------@@ -45,20 +38,3 @@  instance ToRaw Surface WGPUSurface where   raw = pure . wgpuSurface------------------------------------------------------------------------------------- | Create a WGPU 'Surface' for a GLFW 'GLFW.Window'.------ This function is not part of the @wgpu-native@ API, but is part of the--- Haskell API until the native WGPU API has a better story around windowing.-createGLFWSurface ::-  -- | API instance.-  Instance ->-  -- | GLFW window for which the surface will be created.-  GLFW.Window ->-  -- | IO action to create the surface.-  IO Surface-createGLFWSurface inst window = do-  Surface inst-    <$> WGPU.Raw.GLFWSurface.createSurface (wgpuHsInstance inst) window

@@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}  -- | -- Module      : WGPU.Internal.SwapChain@@ -19,16 +20,24 @@   ) where -import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Cont (evalContT)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text (Text) import Data.Word (Word32)-import Foreign (Ptr, freeHaskellFunPtr, nullPtr)+import Foreign (Ptr, nullPtr) import WGPU.Internal.Adapter (Adapter, wgpuAdapter) import WGPU.Internal.Device (Device, deviceInst, wgpuDevice) import WGPU.Internal.Instance (Instance, wgpuHsInstance)-import WGPU.Internal.Memory (ToRaw, raw, rawPtr, showWithPtr)+import WGPU.Internal.Memory+  ( ToRaw,+    evalContT,+    freeHaskellFunPtr,+    newEmptyMVar,+    putMVar,+    raw,+    rawPtr,+    showWithPtr,+    takeMVar,+  ) import WGPU.Internal.Surface (Surface, surfaceInst, wgpuSurface) import WGPU.Internal.Texture (TextureFormat, TextureUsage, TextureView (TextureView), textureFormatFromRaw) import WGPU.Raw.Generated.Enum.WGPUPresentMode (WGPUPresentMode)@@ -137,37 +146,40 @@ -- | Returns an optimal texture format to use for the swapchain with this --   adapter and surface. getSwapChainPreferredFormat ::+  MonadIO m =>   -- | @Surface@ for which to obtain an optimal texture format.   Surface ->   -- | @Adapter@ for which to obtain an optimal texture format.   Adapter ->   -- | IO action which returns the optimal texture format.-  IO TextureFormat+  m TextureFormat getSwapChainPreferredFormat surface adapter = do-  let inst :: Instance-      inst = surfaceInst surface--  textureFormatMVar :: MVar WGPUTextureFormat <- newEmptyMVar--  let textureFormatCallback :: WGPUTextureFormat -> Ptr () -> IO ()-      textureFormatCallback tf _ = putMVar textureFormatMVar tf+  let inst = surfaceInst surface -  textureFormatCallback_c <--    mkSurfaceGetPreferredFormatCallback textureFormatCallback+  textureFormatMVar <- newEmptyMVar+  callback <-+    mkSurfaceGetPreferredFormatCallback (\tf _ -> putMVar textureFormatMVar tf)    RawFun.wgpuSurfaceGetPreferredFormat     (wgpuHsInstance inst)     (wgpuSurface surface)     (wgpuAdapter adapter)-    textureFormatCallback_c+    callback     nullPtr    textureFormat <- textureFormatFromRaw <$> takeMVar textureFormatMVar-  freeHaskellFunPtr textureFormatCallback_c+  freeHaskellFunPtr callback   pure textureFormat +mkSurfaceGetPreferredFormatCallback ::+  MonadIO m =>+  (WGPUTextureFormat -> Ptr () -> IO ()) ->+  m WGPUSurfaceGetPreferredFormatCallback+mkSurfaceGetPreferredFormatCallback =+  liftIO . mkSurfaceGetPreferredFormatCallbackIO+ foreign import ccall "wrapper"-  mkSurfaceGetPreferredFormatCallback ::+  mkSurfaceGetPreferredFormatCallbackIO ::     (WGPUTextureFormat -> Ptr () -> IO ()) ->     IO WGPUSurfaceGetPreferredFormatCallback @@ -178,6 +190,7 @@ -- To determine the preferred 'TextureFormat' for the 'Surface', use the -- 'getSwapChainPreferredFormat' function. createSwapChain ::+  MonadIO m =>   -- | @Device@ for which the @SwapChain@ will be created.   Device ->   -- | @Surface@ for which the @SwapChain@ will be created.@@ -185,32 +198,29 @@   -- | Description of the @SwapChain@ to be created.   SwapChainDescriptor ->   -- | IO action which creates the swap chain.-  IO SwapChain-createSwapChain device surface scd = evalContT $ do-  let inst :: Instance-      inst = deviceInst device-+  m SwapChain+createSwapChain device surface scd = liftIO . evalContT $ do+  let inst = deviceInst device   swapChainDescriptor_ptr <- rawPtr scd   rawSwapChain <--    liftIO $-      RawFun.wgpuDeviceCreateSwapChain-        (wgpuHsInstance inst)-        (wgpuDevice device)-        (wgpuSurface surface)-        swapChainDescriptor_ptr+    RawFun.wgpuDeviceCreateSwapChain+      (wgpuHsInstance inst)+      (wgpuDevice device)+      (wgpuSurface surface)+      swapChainDescriptor_ptr   pure (SwapChain inst rawSwapChain)  -------------------------------------------------------------------------------  -- | Get the 'TextureView' for the current swap chain frame. getSwapChainCurrentTextureView ::+  MonadIO m =>   -- | Swap chain from which to fetch the current texture view.   SwapChain ->   -- | IO action which returns the current swap chain texture view.-  IO TextureView+  m TextureView getSwapChainCurrentTextureView swapChain = do-  let inst :: Instance-      inst = swapChainInst swapChain+  let inst = swapChainInst swapChain   TextureView     <$> RawFun.wgpuSwapChainGetCurrentTextureView       (wgpuHsInstance inst)@@ -220,11 +230,11 @@  -- | Present the latest swap chain image. swapChainPresent ::+  MonadIO m =>   -- | Swap chain to present.   SwapChain ->   -- | IO action which presents the swap chain image.-  IO ()+  m () swapChainPresent swapChain = do-  let inst :: Instance-      inst = swapChainInst swapChain+  let inst = swapChainInst swapChain   RawFun.wgpuSwapChainPresent (wgpuHsInstance inst) (wgpuSwapChain swapChain)

@@ -22,12 +22,16 @@     -- * Surface #surface#     -- $surface     Surface,-    createGLFWSurface,      -- * Adapter #adapter#     -- $adapter     Adapter,+    AdapterType (..),+    BackendType (..),+    AdapterProperties (..),     requestAdapter,+    getAdapterProperties,+    adapterPropertiesToText,      -- * Device #device#     -- $device@@ -149,10 +153,9 @@      -- * Logging     LogLevel (..),-    LogCallback,+    connectLog,+    disconnectLog,     setLogLevel,-    logStdout,-    logLevelToText,      -- * Multipurpose     CompareFunction (..),@@ -161,6 +164,7 @@      -- ** Strict Maybe     SMaybe (..),+    fromSMaybe,   ) where @@ -193,14 +197,11 @@ -- there are also early attempts to create a native binding (ie. a C language -- binding). Two implementations of the native binding are: -----   * <https://github.com/gfx-rs/wgpu-native wgpu-native>: a Mozilla-backed---     WebGPU native implementation, written in Rust, used in the Firefox web---     browser. This is the binding to which this Haskell library is currently---     tied.+--   * <https://github.com/gfx-rs/wgpu-native wgpu-native>: a Rust+--     implementation used in the Firefox web browser. -----   * <https://dawn.googlesource.com/dawn dawn>: a Google-backed WebGPU native---     implementation, written in C++, used in the Chrome web browser. In the---     future, we hope to support this backend too.+--   * <https://dawn.googlesource.com/dawn dawn>: a C++ implementation,used in+--     the Chrome web browser. -- -- The native bindings to WebGPU have the potential to become a portable, -- next-generation GPU API which is easy to use. Vulkan is also currently@@ -214,11 +215,11 @@ -- -- Currently, macOS (Metal), Windows and Linux are supported. ----- === Dependence on GLFW-b+-- === Windowing System Support ----- This package currently uses only--- <https://hackage.haskell.org/package/GLFW-b GLFW-b>--- for windowing and event processing.+-- The bindings support both GLFW-b and SDL as windowing systems on macOS,+-- Windows and Linux. The windowing system bindings are somewhat hacky (due to+-- the early stage of WebGPU Native), but they work. -- -- === Structure of Bindings --@@ -262,11 +263,13 @@ -- <https://github.com/gfx-rs/wgpu-native wgpu-native> is supported. -- -- To load the dynamic library and obtain an instance, use the--- 'withPlatformInstance' or 'withInstance' bracketing functions:+-- 'withPlatformInstance' or 'withInstance' bracketing functions. These+-- functions take a function that performs bracketing. -- -- @--- 'withPlatformInstance' (Just 'logStdout') $ \inst -> do---   -- set the logging level (optional)+-- 'withPlatformInstance' 'Control.Exception.Safe.bracket' $ \inst -> do+--   -- attach the logger and set the logging level (optional)+--   'connectLog' inst --   'setLogLevel' inst 'Warn' --   -- run the rest of the program... -- @@@ -279,9 +282,8 @@ -- $surface -- -- A 'Surface' is a handle to a platform-specific presentable surface, like a--- window. Currently, only GLFW windows are supported for surface creation.--- Once you have a GLFW window, you may create a 'Surface' for it using the--- 'createGLFWSurface' function.+-- window. First, create either a GLFW or SDL window, and then create a surface+-- using either 'createGLFWSurface' or 'createSDLSurface'. -- -- Once you have a 'Surface', the next step is usually to -- <WGPU.html#g:adapter request an adapter> that is compatible with it.

@@ -0,0 +1,407 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : WGPU.BoneYard.SimpleSDL+-- Description : Template for a simple SDL app.+--+-- This is a kind of skeleton for a very simple SDL app. It is intended for+-- bootstrapping development. A common use case is when you want a window to+-- draw in with everything configured. This provides a version of that+-- functionality that can later be replaced or refined (easily) by the app+-- developer if necessary.+module WGPU.BoneYard.SimpleSDL+  ( -- * Swap Chain++    -- ** Types+    SwapChainState,++    -- ** Functions+    emptySwapChainState,+    withSwapChain,++    -- * Render Pipelines++    -- ** Types+    RenderPipelineName,+    RenderPipelines,++    -- ** Functions+    emptyRenderPipelines,+    createRenderPipeline,+    getRenderPipeline,++    -- * Shaders++    -- ** Types+    ShaderName,+    Shaders,++    -- ** Functions+    emptyShaders,+    compileWGSL,+    compileWGSL_,+    getShader,++    -- * Resources++    -- ** Types+    Params (..),+    Resources (..),++    -- ** Functions+    loadResources,++    -- * Exceptions+    AppException (..),+  )+where++import Control.Concurrent (MVar, modifyMVar, modifyMVar_, newMVar, withMVar)+import Control.Exception.Safe (Exception, MonadThrow, throwM)+import Control.Lens (lens)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)+import Control.Monad.Trans.Resource (MonadResource, allocate)+import Data.Default (def)+import Data.Has (Has, getter, hasLens)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.String (IsString)+import Data.Text (Text)+import Data.Word (Word32)+import GHC.Generics (Generic)+import SDL (Window)+import qualified SDL+import WGPU+  ( Adapter,+    Device,+    DeviceDescriptor,+    Instance,+    Queue,+    RenderPipeline,+    RenderPipelineDescriptor,+    SMaybe,+    ShaderModule,+    Surface,+    SwapChain,+    TextureFormat,+    WGSL,+  )+import qualified WGPU+import qualified WGPU.Classy as C+import qualified WGPU.SDL.Surface++-------------------------------------------------------------------------------+-- SwapChain Management++-- | Contains mutable state to manage the swap chain.+newtype SwapChainState = SwapChainState+  {unSwapChainState :: MVar (Maybe SwapChainDetails)}++data SwapChainDetails = SwapChainDetails+  { scdSize :: !(Word32, Word32),+    scdSwapChain :: !SwapChain+  }++-- | Initialize a new 'SwapChainState'.+emptySwapChainState :: MonadResource m => m SwapChainState+emptySwapChainState = SwapChainState <$> liftIO (newMVar Nothing)++-- | Provide a 'ReaderT' with a properly-configured 'SwapChain'.+withSwapChain ::+  forall r m a.+  ( C.HasDevice r m,+    C.HasSurface r m,+    C.HasAdapter r m,+    Has Window r,+    Has SwapChainState r+  ) =>+  ReaderT (SwapChain, r) m a ->+  m a+withSwapChain action = do+  env <- ask+  swapChain <- getSwapChain+  runReaderT action (swapChain, env)+  where+    windowSize :: m (Word32, Word32)+    windowSize = do+      SDL.V2 w h <- asks getter >>= SDL.glGetDrawableSize+      pure (fromIntegral w, fromIntegral h)++    getSwapChain :: m SwapChain+    getSwapChain = do+      device <- asks getter+      surface <- asks getter+      windowSz <- windowSize+      textureFormat <- C.getSwapChainPreferredFormat+      mVarMaybe <- asks getter+      liftIO $+        modifyMVar (unSwapChainState mVarMaybe) $ \case+          Nothing -> do+            newSwapChain device surface windowSz textureFormat+          Just scd@SwapChainDetails {..} -> do+            if scdSize == windowSz+              then pure (Just scd, scdSwapChain)+              else newSwapChain device surface windowSz textureFormat++    newSwapChain ::+      Device ->+      Surface ->+      (Word32, Word32) ->+      TextureFormat ->+      IO (Maybe SwapChainDetails, SwapChain)+    newSwapChain device surface (w, h) textureFormat = do+      swapChain <-+        WGPU.createSwapChain+          device+          surface+          WGPU.SwapChainDescriptor+            { swapChainLabel = "SwapChain",+              usage = WGPU.TextureUsageRenderAttachment,+              swapChainFormat = textureFormat,+              width = w,+              height = h,+              presentMode = WGPU.PresentModeFifo+            }+      pure (Just (SwapChainDetails (w, h) swapChain), swapChain)++-------------------------------------------------------------------------------+-- Render Pipeline Collection++-- | Name of a render pipeline.+newtype RenderPipelineName = RenderPipelineName {unRenderPipelineName :: Text}+  deriving (Eq, Ord, IsString, Show)++-- | Container for mutable state that contains a map of render pipelines.+newtype RenderPipelines = RenderPipelines+  {unRenderPipelines :: MVarMap RenderPipelineName RenderPipeline}++-- | Create an empty 'RenderPipelines'.+emptyRenderPipelines :: MonadResource m => m RenderPipelines+emptyRenderPipelines = RenderPipelines <$> emptyMVarMap++-- | Create a 'RenderPipeline', storing it in the 'RenderPipelines' map.+--+-- A 'RenderPipeline' created this way can be fetched using+-- 'getRenderPipeline'. This calls 'C.createRenderPipeline' under the hood.+createRenderPipeline ::+  ( MonadIO m,+    C.HasDevice r m,+    Has RenderPipelines r+  ) =>+  -- | Name of the render pipeline.+  RenderPipelineName ->+  -- | Descriptor of the render pipeline.+  RenderPipelineDescriptor ->+  -- | The created render pipeline.+  m RenderPipeline+createRenderPipeline name renderPipelineDescriptor = do+  renderPipeline <- C.createRenderPipeline renderPipelineDescriptor+  asks getter >>= insertMVarMap name renderPipeline . unRenderPipelines+  pure renderPipeline++-- | Fetch a render pipeline that was previously created using+-- 'createRenderPipeline'.+--+-- If the render pipeline is not available, this function throws an exception+-- of type 'AppException'.+getRenderPipeline ::+  (Has RenderPipelines r, MonadReader r m, MonadIO m, MonadThrow m) =>+  -- | Name of the render pipeline to fetch.+  RenderPipelineName ->+  -- | The render pipeline.+  m RenderPipeline+getRenderPipeline name = do+  mRenderPipeline <- asks getter >>= lookupMVarMap name . unRenderPipelines+  case mRenderPipeline of+    Just renderPipeline -> pure renderPipeline+    Nothing -> throwM (UnknownRenderPipelineName name)++-------------------------------------------------------------------------------+-- Shader Collection++-- | Name of a shader.+newtype ShaderName = ShaderName {unShaderName :: Text}+  deriving (Eq, Ord, IsString, Show)++-- | Container for mutable state that contains a map of shaders.+newtype Shaders = Shaders {unShaders :: MVarMap ShaderName ShaderModule}++-- | Create an empty 'Shaders'.+emptyShaders :: MonadResource m => m Shaders+emptyShaders = Shaders <$> emptyMVarMap++-- | Compile a WGSL shader, adding it to the 'Shaders' map.+compileWGSL_ ::+  (Has Device r, Has Shaders r, MonadReader r m, MonadResource m) =>+  -- | Name of the shader.+  ShaderName ->+  -- | Shader source code.+  WGSL ->+  -- | Action that compiles the shader and adds it to the 'Shaders' map.+  m ()+compileWGSL_ shaderName wgsl = compileWGSL shaderName wgsl >> pure ()++-- | Compile a WGSL shader, adding it to the 'Shaders' map, and returning the+-- compiled 'ShaderModule'.+compileWGSL ::+  (Has Device r, Has Shaders r, MonadReader r m, MonadResource m) =>+  -- | Name of the shader.+  ShaderName ->+  -- | Shader source code.+  WGSL ->+  -- | Action that returns the compiled shader module, after adding it to the+  -- 'Shaders' map.+  m ShaderModule+compileWGSL shaderName wgsl = do+  shaderModule <- C.createShaderModuleWGSL (unShaderName shaderName) wgsl+  asks getter >>= insertMVarMap shaderName shaderModule . unShaders+  pure shaderModule++-- | Fetch a shader that was previously compiled.+--+-- If the shader is not available, this function throws an exception of type+-- 'AppException'.+getShader ::+  (Has Shaders r, MonadReader r m, MonadIO m, MonadThrow m) =>+  -- | Name of the shader to fetch.+  ShaderName ->+  -- | The shader module.+  m ShaderModule+getShader shaderName = do+  mShaderModule <- asks getter >>= lookupMVarMap shaderName . unShaders+  case mShaderModule of+    Just shaderModule -> pure shaderModule+    Nothing -> throwM (UnknownShaderName shaderName)++-------------------------------------------------------------------------------+-- Application Static Resources++-- | Parameters for initialization.+data Params = Params+  { -- | Title of the window.+    title :: !Text,+    -- | Optional device descriptor.+    mDeviceDescriptor :: !(SMaybe DeviceDescriptor)+  }++-- | Load the resources for an application.+--+-- This creates:+--   - 'Instance',+--   - SDL 'Window' (which is shown)+--   - 'Surface' for the SDL window+--   - 'Adapter'+--   - 'Device'+--   - 'Queue'+loadResources ::+  forall m.+  (MonadResource m, MonadThrow m) =>+  -- | Initialization parameters.+  Params ->+  -- | Created application resources.+  m Resources+loadResources Params {..} = do+  inst <- createInstance+  window <- createWindow+  surface <- WGPU.SDL.Surface.createSurface inst window+  adapter <- requestAdapter surface+  device <- requestDevice adapter+  queue <- WGPU.getQueue device+  pure Resources {..}+  where+    createInstance :: m Instance+    createInstance = snd <$> WGPU.withPlatformInstance allocate++    createWindow :: m Window+    createWindow = do+      SDL.initializeAll+      let windowConfig = SDL.defaultWindow {SDL.windowResizable = True}+      snd+        <$> allocate+          (SDL.createWindow title windowConfig)+          SDL.destroyWindow++    requestAdapter :: Surface -> m Adapter+    requestAdapter surface =+      WGPU.requestAdapter surface >>= \case+        Nothing -> throwM AdapterRequestFailed+        Just adapter -> pure adapter++    requestDevice :: Adapter -> m Device+    requestDevice adapter = do+      let deviceDescriptor = WGPU.fromSMaybe def mDeviceDescriptor+      WGPU.requestDevice adapter deviceDescriptor >>= \case+        Nothing -> throwM DeviceRequestFailed+        Just device -> pure device++-- | Resources for the app.+data Resources = Resources+  { inst :: !Instance,+    window :: !Window,+    surface :: !Surface,+    adapter :: !Adapter,+    device :: !Device,+    queue :: !Queue+  }+  deriving (Generic)++instance Has Instance Resources where+  hasLens = lens inst (\s x -> s {inst = x})++instance Has Window Resources where+  hasLens = lens window (\s x -> s {window = x})++instance Has Surface Resources where+  hasLens = lens surface (\s x -> s {surface = x})++instance Has Adapter Resources where+  hasLens = lens adapter (\s x -> s {adapter = x})++instance Has Device Resources where+  hasLens = lens device (\s x -> s {device = x})++instance Has Queue Resources where+  hasLens = lens queue (\s x -> s {queue = x})++-------------------------------------------------------------------------------+-- Map inside an MVar++newtype MVarMap k v = MVarMap {unMVarMap :: MVar (Map k v)}++emptyMVarMap :: MonadIO m => m (MVarMap k v)+emptyMVarMap = MVarMap <$> liftIO (newMVar Map.empty)++insertMVarMap :: (Ord k, MonadIO m) => k -> v -> MVarMap k v -> m ()+insertMVarMap key value mVarMap =+  liftIO $ modifyMVar_ (unMVarMap mVarMap) (pure . Map.insert key value)++lookupMVarMap :: (Ord k, MonadIO m) => k -> MVarMap k v -> m (Maybe v)+lookupMVarMap key mVarMap =+  liftIO $ withMVar (unMVarMap mVarMap) (pure . Map.lookup key)++-------------------------------------------------------------------------------+-- Exceptions++-- | Exceptions from SimpleSDL.+data AppException+  = -- | Requesting an adapter failed.+    AdapterRequestFailed+  | -- | Requesting a device failed.+    DeviceRequestFailed+  | -- | Requesting a shader failed.+    UnknownShaderName ShaderName+  | -- | Requesting a render pipeline failed.+    UnknownRenderPipelineName RenderPipelineName+  deriving (Show)++instance Exception AppException

@@ -0,0 +1,362 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : WGPU.Classy+-- Description : Get parameters from readers.+--+-- WGPU commands commonly take parameters such as the 'Instance', 'Device', etc,+-- which are relatively unchanged across multiple commands. This module provides+-- a way to supply those parameters from a 'MonadReader'. Useful for the truly+-- lazy among us.+module WGPU.Classy+  ( -- * Constraints+    HasInstance,+    HasSurface,+    HasAdapter,+    HasDevice,+    HasSwapChain,+    HasCommandEncoder,+    HasRenderPassEncoder,+    HasQueue,++    -- * Classes++    -- * Lifted Functions++    -- ** Adapter+    requestAdapter,+    getAdapterProperties,++    -- ** Device+    requestDevice,++    -- ** Swapchain+    getSwapChainPreferredFormat,+    createSwapChain,+    getSwapChainCurrentTextureView,+    swapChainPresent,++    -- ** Resource Binding+    createBindGroupLayout,++    -- ** Shader Modules+    createShaderModule,+    createShaderModuleSPIRV,+    createShaderModuleWGSL,++    -- ** Pipelines++    -- *** Render+    createPipelineLayout,+    createRenderPipeline,++    -- ** Command Encoding+    createCommandEncoder,+    commandEncoderFinish,+    beginRenderPass,+    renderPassSetPipeline,+    renderPassDraw,+    endRenderPass,++    -- ** Queue+    getQueue,+    queueSubmit,+    queueSubmit',++    -- ** Version+    getVersion,++    -- ** Logging+    connectLog,+    disconnectLog,+    setLogLevel,++    -- * Reader Contexts+    addEnv,++    -- * Building++    -- ** Command Encoding+    buildCommandBuffer,+    buildRenderPass,+  )+where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)+import Data.Has (Has, getter)+import Data.Text (Text)+import Data.Vector (Vector)+import Data.Word (Word32)+import WGPU+  ( Adapter,+    AdapterProperties,+    BindGroupLayout,+    BindGroupLayoutDescriptor,+    CommandBuffer,+    CommandEncoder,+    Device,+    DeviceDescriptor,+    Instance,+    LogLevel,+    PipelineLayout,+    PipelineLayoutDescriptor,+    Queue,+    Range,+    RenderPassDescriptor,+    RenderPassEncoder,+    RenderPipeline,+    RenderPipelineDescriptor,+    SPIRV,+    ShaderModule,+    ShaderModuleDescriptor,+    Surface,+    SwapChain,+    SwapChainDescriptor,+    TextureFormat,+    TextureView,+    Version,+    WGSL,+  )+import qualified WGPU++-------------------------------------------------------------------------------+-- Constraint Synonyms++type RIO r m = (MonadIO m, MonadReader r m)++type HasInstance r m = (RIO r m, Has Instance r)++type HasSurface r m = (RIO r m, Has Surface r)++type HasAdapter r m = (RIO r m, Has Adapter r)++type HasDevice r m = (RIO r m, Has Device r)++type HasSwapChain r m = (RIO r m, Has SwapChain r)++type HasCommandEncoder r m = (RIO r m, Has CommandEncoder r)++type HasRenderPassEncoder r m = (RIO r m, Has RenderPassEncoder r)++type HasQueue r m = (RIO r m, Has Queue r)++access :: (Has q r, MonadReader r m) => (q -> m a) -> m a+access action = asks getter >>= action+{-# INLINEABLE access #-}++access2 :: (Has q r, MonadReader r m) => (q -> b -> m a) -> b -> m a+access2 action y = asks getter >>= \x -> action x y+{-# INLINEABLE access2 #-}++access3 :: (Has q r, MonadReader r m) => (q -> b -> c -> m a) -> b -> c -> m a+access3 action y z = asks getter >>= \x -> action x y z+{-# INLINEABLE access3 #-}++-------------------------------------------------------------------------------+-- Adapter++requestAdapter :: HasSurface r m => m (Maybe Adapter)+requestAdapter = access WGPU.requestAdapter+{-# INLINEABLE requestAdapter #-}++getAdapterProperties :: HasAdapter r m => m AdapterProperties+getAdapterProperties = access WGPU.getAdapterProperties+{-# INLINEABLE getAdapterProperties #-}++-------------------------------------------------------------------------------+-- Device++requestDevice :: HasAdapter r m => DeviceDescriptor -> m (Maybe Device)+requestDevice = access2 WGPU.requestDevice+{-# INLINEABLE requestDevice #-}++-------------------------------------------------------------------------------+-- Swapchain++getSwapChainPreferredFormat ::+  (HasSurface r m, HasAdapter r m) =>+  m TextureFormat+getSwapChainPreferredFormat =+  access . access2 $ WGPU.getSwapChainPreferredFormat+{-# INLINEABLE getSwapChainPreferredFormat #-}++createSwapChain ::+  (HasDevice r m, HasSurface r m) =>+  SwapChainDescriptor ->+  m SwapChain+createSwapChain = access2 . access3 $ WGPU.createSwapChain+{-# INLINEABLE createSwapChain #-}++getSwapChainCurrentTextureView :: HasSwapChain r m => m TextureView+getSwapChainCurrentTextureView = access WGPU.getSwapChainCurrentTextureView+{-# INLINEABLE getSwapChainCurrentTextureView #-}++swapChainPresent :: HasSwapChain r m => m ()+swapChainPresent = access WGPU.swapChainPresent+{-# INLINEABLE swapChainPresent #-}++-------------------------------------------------------------------------------+-- Resource Binding++createBindGroupLayout ::+  HasDevice r m =>+  BindGroupLayoutDescriptor ->+  m BindGroupLayout+createBindGroupLayout = access2 WGPU.createBindGroupLayout+{-# INLINEABLE createBindGroupLayout #-}++-------------------------------------------------------------------------------+-- Shader Modules++createShaderModule :: HasDevice r m => ShaderModuleDescriptor -> m ShaderModule+createShaderModule = access2 WGPU.createShaderModule+{-# INLINEABLE createShaderModule #-}++createShaderModuleSPIRV :: HasDevice r m => Text -> SPIRV -> m ShaderModule+createShaderModuleSPIRV = access3 WGPU.createShaderModuleSPIRV+{-# INLINEABLE createShaderModuleSPIRV #-}++createShaderModuleWGSL :: HasDevice r m => Text -> WGSL -> m ShaderModule+createShaderModuleWGSL = access3 WGPU.createShaderModuleWGSL+{-# INLINEABLE createShaderModuleWGSL #-}++-------------------------------------------------------------------------------+-- Render Pipelines++createPipelineLayout ::+  HasDevice r m =>+  PipelineLayoutDescriptor ->+  m PipelineLayout+createPipelineLayout = access2 WGPU.createPipelineLayout+{-# INLINEABLE createPipelineLayout #-}++createRenderPipeline ::+  HasDevice r m =>+  RenderPipelineDescriptor ->+  m RenderPipeline+createRenderPipeline = access2 WGPU.createRenderPipeline+{-# INLINEABLE createRenderPipeline #-}++-------------------------------------------------------------------------------+-- Command Encoding (Lifted)++createCommandEncoder :: HasDevice r m => Text -> m CommandEncoder+createCommandEncoder = access2 WGPU.createCommandEncoder+{-# INLINEABLE createCommandEncoder #-}++commandEncoderFinish :: HasCommandEncoder r m => Text -> m CommandBuffer+commandEncoderFinish = access2 WGPU.commandEncoderFinish+{-# INLINEABLE commandEncoderFinish #-}++beginRenderPass ::+  HasCommandEncoder r m =>+  RenderPassDescriptor ->+  m RenderPassEncoder+beginRenderPass = access2 WGPU.beginRenderPass+{-# INLINEABLE beginRenderPass #-}++renderPassSetPipeline :: HasRenderPassEncoder r m => RenderPipeline -> m ()+renderPassSetPipeline = access2 WGPU.renderPassSetPipeline+{-# INLINEABLE renderPassSetPipeline #-}++renderPassDraw ::+  HasRenderPassEncoder r m =>+  Range Word32 ->+  Range Word32 ->+  m ()+renderPassDraw = access3 WGPU.renderPassDraw+{-# INLINEABLE renderPassDraw #-}++endRenderPass :: HasRenderPassEncoder r m => m ()+endRenderPass = access WGPU.endRenderPass+{-# INLINEABLE endRenderPass #-}++-------------------------------------------------------------------------------+-- Queue++getQueue :: HasDevice r m => m Queue+getQueue = access WGPU.getQueue+{-# INLINEABLE getQueue #-}++queueSubmit :: HasQueue r m => Vector CommandBuffer -> m ()+queueSubmit = access2 WGPU.queueSubmit+{-# INLINEABLE queueSubmit #-}++-- | Fetch the queue from a device and submit command buffers to it.+queueSubmit' :: HasDevice r m => Vector CommandBuffer -> m ()+queueSubmit' = buildQueue . queueSubmit+{-# INLINEABLE queueSubmit' #-}++-------------------------------------------------------------------------------+-- Version++getVersion :: HasInstance r m => m Version+getVersion = access WGPU.getVersion++-------------------------------------------------------------------------------+-- Logging++connectLog :: HasInstance r m => m ()+connectLog = access WGPU.connectLog+{-# INLINEABLE connectLog #-}++disconnectLog :: HasInstance r m => m ()+disconnectLog = access WGPU.disconnectLog+{-# INLINEABLE disconnectLog #-}++setLogLevel :: HasInstance r m => LogLevel -> m ()+setLogLevel = access2 WGPU.setLogLevel+{-# INLINEABLE setLogLevel #-}++-------------------------------------------------------------------------------+-- Reader Contexts++-- | Add 'q' into the reader environment.+addEnv :: MonadReader r m => q -> ReaderT (q, r) m a -> m a+addEnv x action = ask >>= \env -> runReaderT action (x, env)+{-# INLINEABLE addEnv #-}++-------------------------------------------------------------------------------+-- Building++-- | Build a 'CommandBuffer' by running actions in an environment that has+-- access to a 'CommandEncoder'.+buildCommandBuffer ::+  forall r m.+  HasDevice r m =>+  -- | Debugging label for the command encoder.+  Text ->+  -- | Debugging label for the command buffer.+  Text ->+  -- | Action to configure the 'CommandEncoder'.+  ReaderT (CommandEncoder, r) m () ->+  -- | Completed 'CommandBuffer'.+  m CommandBuffer+buildCommandBuffer commandEncoderLabel commandBufferLabel build = do+  commandEncoder <- createCommandEncoder commandEncoderLabel+  addEnv commandEncoder (build >> commandEncoderFinish commandBufferLabel)+{-# INLINEABLE buildCommandBuffer #-}++-- | Build a render pass by running actions in an environment that has access+-- to a 'RenderPassEncoder'.+buildRenderPass ::+  forall r m.+  HasCommandEncoder r m =>+  RenderPassDescriptor ->+  ReaderT (RenderPassEncoder, r) m () ->+  m ()+buildRenderPass renderPassDescriptor build = do+  renderPassEncoder <- beginRenderPass renderPassDescriptor+  addEnv renderPassEncoder (build >> endRenderPass)+{-# INLINEABLE buildRenderPass #-}++-- | Build a queue by running actions in an environment that has access to a+-- `Queue`.+buildQueue :: HasDevice r m => ReaderT (Queue, r) m () -> m ()+buildQueue action = getQueue >>= \queue -> addEnv queue action+{-# INLINEABLE buildQueue #-}

@@ -0,0 +1,10 @@+-- |+-- Module      : WGPU.GLFW.Surface+-- Description : GLFW-specific surfaces.+module WGPU.GLFW.Surface+  ( -- * Functions+    createSurface,+  )+where++import WGPU.Internal.GLFW.Surface (createSurface)

@@ -0,0 +1,10 @@+-- |+-- Module      : WGPU.SDL.Surface+-- Description : SDL-specific surfaces.+module WGPU.SDL.Surface+  ( -- * Functions+    createSurface,+  )+where++import WGPU.Internal.SDL.Surface (createSurface)

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               wgpu-hs-version:            0.2.0.1+version:            0.3.0.0 synopsis:           WGPU description:        A high-level binding to WGPU. bug-reports:        https://github.com/lancelet/wgpu-hs/issues@@ -12,11 +12,21 @@ category:           Graphics extra-source-files: CHANGELOG.md +flag glfw+  description: Enable GLFW integration+  default:     True+  manual:      True+ flag examples   description: Build the examples   default:     True   manual:      True +flag sdl2+  description: Enable SDL2 integration+  default:     True+  manual:      True+ common base   default-language: Haskell2010   build-depends:    base ^>=4.14.0.0@@ -50,12 +60,22 @@     WGPU.Internal.SwapChain     WGPU.Internal.Texture +  if flag(glfw)+    build-depends:   GLFW-b+    exposed-modules: WGPU.Internal.GLFW.Surface++  if flag(sdl2)+    build-depends:   sdl2+    exposed-modules: WGPU.Internal.SDL.Surface+   build-depends:     , bytestring     , data-default-    , GLFW-b+    , data-has+    , lens+    , mtl+    , resourcet     , text-    , transformers     , vector     , wgpu-raw-hs @@ -64,21 +84,60 @@   hs-source-dirs:  src   build-depends:     , bytestring        ^>=0.10.12+    , containers        ^>=0.6.5.1     , data-default      ^>=0.7.1.1-    , GLFW-b            ^>=3.3.0+    , data-has          ^>=0.4.0.0+    , lens              ^>=5.0.1+    , mtl               ^>=2.2.2+    , resourcet         ^>=1.2.4.3+    , safe-exceptions   ^>=0.1.7.2     , text              ^>=1.2.4-    , transformers      ^>=0.5.6     , vector            ^>=0.12.3     , wgpu-hs-internal-    , wgpu-raw-hs       ==0.2.0.1+    , wgpu-raw-hs       ==0.3.0.0 -  exposed-modules: WGPU+  exposed-modules:+    WGPU+    WGPU.Classy -executable triangle+  if flag(glfw)+    build-depends:   GLFW-b ^>=3.3.0+    exposed-modules: WGPU.GLFW.Surface++  if flag(sdl2)+    build-depends:   sdl2 ^>=2.5.3.0+    exposed-modules:+      WGPU.BoneYard.SimpleSDL+      WGPU.SDL.Surface++executable triangle-sdl   import:         base, ghc-options -  if flag(examples)+  if (flag(examples) && flag(sdl2))     build-depends:+      , data-default     ^>=0.7.1.1+      , data-has         ^>=0.4.0.0+      , lens             ^>=5.0.1+      , mtl              ^>=2.2.2+      , resourcet        ^>=1.2.4.3+      , safe-exceptions  ^>=0.1.7.2+      , sdl2             ^>=2.5.3.0+      , string-qq        ^>=0.0.4+      , text             ^>=1.2.4+      , vector           ^>=0.12.3+      , wgpu-hs++  else+    buildable: False++  hs-source-dirs: examples/triangle-sdl+  main-is:        TriangleSDL.hs++executable triangle-glfw+  import:         base, ghc-options++  if (flag(examples) && flag(glfw))+    build-depends:       , data-default  ^>=0.7.1.1       , GLFW-b        ^>=3.3.0       , text          ^>=1.2.4@@ -88,5 +147,5 @@   else     buildable: False -  hs-source-dirs: examples/triangle-  main-is:        Main.hs+  hs-source-dirs: examples/triangle-glfw+  main-is:        TriangleGLFW.hs