packages feed

wgpu-hs (empty) → 0.1.0.0

raw patch · 23 files changed

+4175/−0 lines, 23 filesdep +GLFW-bdep +basedep +bytestring

Dependencies added: GLFW-b, base, bytestring, data-default, text, transformers, vector, wgpu-hs, wgpu-raw-hs

Files

+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Revision history for wgpu-hs++## 0.1.0.0 -- 2021-08-20++- Initial (incomplete) API bindings started.+- Working `triangle` example.
+ examples/triangle/Main.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Let's draw a triangle!+module Main (main) where++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.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"+  let initWidth, initHeight :: Int+      initWidth = 640+      initHeight = 480+  GLFW.windowHint (GLFW.WindowHint'ClientAPI GLFW.ClientAPI'NoAPI)+  window <- do+    mWin <- GLFW.createWindow initWidth initHeight "Triangle" Nothing Nothing+    case mWin of+      Just w -> pure w+      Nothing -> do+        TextIO.putStrLn "Failed to create GLFW window"+        exitFailure++  WGPU.withInstance "libwgpu_native.dylib" (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 = fromIntegral initWidth,+            height = fromIntegral initHeight,+            presentMode = WGPU.PresentModeFifo+          }+    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+          -- 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 {..}++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);",+        "}"+      ]
+ src-internal/WGPU/Internal/Adapter.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : WGPU.Internal.Adapter+-- Description : Adapter (physical device).+module WGPU.Internal.Adapter+  ( -- * Types+    Adapter (..),++    -- * Functions+    requestAdapter,+  )+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 Foreign.Ptr (Ptr)+import WGPU.Internal.Instance (Instance, wgpuHsInstance)+import WGPU.Internal.Memory (ToRaw, raw, rawPtr, showWithPtr)+import WGPU.Internal.Surface (Surface, surfaceInst)+import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPURequestAdapterOptions+  ( WGPURequestAdapterOptions,+  )+import qualified WGPU.Raw.Generated.Struct.WGPURequestAdapterOptions as WGPURequestAdapterOptions+import WGPU.Raw.Types+  ( WGPUAdapter (WGPUAdapter),+    WGPUInstance (WGPUInstance),+    WGPURequestAdapterCallback,+  )++-------------------------------------------------------------------------------++-- | Handle to a physical graphics and/or compute device.+--+-- Request an 'Adapter' for a 'Surface' using the 'requestAdapter' function.+data Adapter = Adapter+  { adapterInst :: !Instance,+    wgpuAdapter :: !WGPUAdapter+  }++instance Show Adapter where+  show a =+    let Adapter _ (WGPUAdapter ptr) = a+     in showWithPtr "Adapter" ptr++instance Eq Adapter where+  (==) a1 a2 =+    let Adapter _ (WGPUAdapter a1_ptr) = a1+        Adapter _ (WGPUAdapter a2_ptr) = a2+     in a1_ptr == a2_ptr++instance ToRaw Adapter WGPUAdapter where+  raw = pure . wgpuAdapter++-------------------------------------------------------------------------------++-- | Request an 'Adapter' that is compatible with a given 'Surface'.+--+-- This action blocks until an available adapter is returned.+requestAdapter ::+  -- | Existing surface for which to request an @Adapter@.+  Surface ->+  -- | The returned @Adapter@, if it could be retrieved.+  IO (Maybe Adapter)+requestAdapter surface = 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++  requestAdapterOptions_ptr <- rawPtr (RequestAdapterOptions surface)+  liftIO $+    RawFun.wgpuInstanceRequestAdapter+      (wgpuHsInstance inst)+      (WGPUInstance nullPtr)+      requestAdapterOptions_ptr+      adapterCallback_c+      nullPtr++  adapter <- liftIO $ takeMVar adapterMVar+  liftIO $ freeHaskellFunPtr adapterCallback_c++  pure $ case adapter of+    WGPUAdapter ptr | ptr == nullPtr -> Nothing+    WGPUAdapter _ -> Just (Adapter inst adapter)++foreign import ccall "wrapper"+  mkAdapterCallback ::+    (WGPUAdapter -> Ptr () -> IO ()) -> IO WGPURequestAdapterCallback++newtype RequestAdapterOptions = RequestAdapterOptions {compatibleSurface :: Surface}++instance ToRaw RequestAdapterOptions WGPURequestAdapterOptions where+  raw RequestAdapterOptions {..} = do+    n_surface <- raw compatibleSurface+    pure+      WGPURequestAdapterOptions.WGPURequestAdapterOptions+        { nextInChain = nullPtr,+          compatibleSurface = n_surface+        }
+ src-internal/WGPU/Internal/Binding.hs view
@@ -0,0 +1,414 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- |+-- Module      : WGPU.Internal.Binding+-- Description : Resource Binding+module WGPU.Internal.Binding+  ( -- * Types+    BindGroupLayout (..),+    BindGroupLayoutDescriptor (..),+    BindGroupLayoutEntry (..),+    Binding (..),+    ShaderStage (..),+    BindingType (..),+    BufferBindingLayout (..),+    SamplerBindingLayout (..),+    TextureBindingLayout (..),+    StorageTextureBindingLayout (..),+    StorageTextureAccess (..),+    TextureSampleType (..),+    BufferBindingType (..),++    -- * Functions+    createBindGroupLayout,+  )+where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (evalContT)+import Data.Bits ((.|.))+import Data.Text (Text)+import Data.Vector (Vector)+import Data.Word (Word32, Word64)+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.SMaybe (SMaybe, fromSMaybe)+import WGPU.Internal.Texture (TextureFormat, TextureViewDimension)+import WGPU.Raw.Generated.Enum.WGPUBufferBindingType (WGPUBufferBindingType)+import qualified WGPU.Raw.Generated.Enum.WGPUBufferBindingType as WGPUBufferBindingType+import qualified WGPU.Raw.Generated.Enum.WGPUSamplerBindingType as WGPUSamplerBindingType+import qualified WGPU.Raw.Generated.Enum.WGPUShaderStage as WGPUShaderStage+import WGPU.Raw.Generated.Enum.WGPUStorageTextureAccess (WGPUStorageTextureAccess)+import qualified WGPU.Raw.Generated.Enum.WGPUStorageTextureAccess as WGPUStorageTextureAccess+import qualified WGPU.Raw.Generated.Enum.WGPUTextureFormat as WGPUTextureFormat+import WGPU.Raw.Generated.Enum.WGPUTextureSampleType (WGPUTextureSampleType)+import qualified WGPU.Raw.Generated.Enum.WGPUTextureSampleType as WGPUTextureSampleType+import qualified WGPU.Raw.Generated.Enum.WGPUTextureViewDimension as WGPUTextureViewDimension+import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPUBindGroupLayoutDescriptor (WGPUBindGroupLayoutDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUBindGroupLayoutDescriptor as WGPUBindGroupLayoutDescriptor+import WGPU.Raw.Generated.Struct.WGPUBindGroupLayoutEntry (WGPUBindGroupLayoutEntry)+import qualified WGPU.Raw.Generated.Struct.WGPUBindGroupLayoutEntry as WGPUBindGroupLayoutEntry+import WGPU.Raw.Generated.Struct.WGPUBufferBindingLayout (WGPUBufferBindingLayout)+import qualified WGPU.Raw.Generated.Struct.WGPUBufferBindingLayout as WGPUBufferBindingLayout+import WGPU.Raw.Generated.Struct.WGPUSamplerBindingLayout (WGPUSamplerBindingLayout)+import qualified WGPU.Raw.Generated.Struct.WGPUSamplerBindingLayout as WGPUSamplerBindingLayout+import WGPU.Raw.Generated.Struct.WGPUStorageTextureBindingLayout (WGPUStorageTextureBindingLayout)+import qualified WGPU.Raw.Generated.Struct.WGPUStorageTextureBindingLayout as WGPUStorageTextureBindingLayout+import WGPU.Raw.Generated.Struct.WGPUTextureBindingLayout (WGPUTextureBindingLayout)+import qualified WGPU.Raw.Generated.Struct.WGPUTextureBindingLayout as WGPUTextureBindingLayout+import WGPU.Raw.Types+  ( WGPUBindGroupLayout (WGPUBindGroupLayout),+    WGPUShaderStageFlags,+  )++-------------------------------------------------------------------------------++-- | Handle to a binding group layout.+--+-- A @BindGroupLayout@ is a handle to the GPU-side layout of a binding group.+newtype BindGroupLayout = BindGroupLayout {wgpuBindGroupLayout :: WGPUBindGroupLayout}++instance Show BindGroupLayout where+  show b =+    let BindGroupLayout (WGPUBindGroupLayout ptr) = b+     in showWithPtr "BindGroupLayout" ptr++instance Eq BindGroupLayout where+  (==) b1 b2 =+    let BindGroupLayout (WGPUBindGroupLayout b1_ptr) = b1+        BindGroupLayout (WGPUBindGroupLayout b2_ptr) = b2+     in b1_ptr == b2_ptr++instance ToRaw BindGroupLayout WGPUBindGroupLayout where+  raw = pure . wgpuBindGroupLayout++-------------------------------------------------------------------------------++-- | Creates a 'BindGroupLayout'.+createBindGroupLayout ::+  -- | 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++  bindGroupLayoutDescriptor_ptr <- rawPtr ld+  rawBindGroupLayout <-+    liftIO $+      RawFun.wgpuDeviceCreateBindGroupLayout+        (wgpuHsInstance inst)+        (wgpuDevice device)+        bindGroupLayoutDescriptor_ptr+  pure (BindGroupLayout rawBindGroupLayout)++-------------------------------------------------------------------------------++-- | Describes a 'BindGroupLayout'.+data BindGroupLayoutDescriptor = BindGroupLayoutDescriptor+  { -- | Debug label of the bind group layout.+    bindGroupLabel :: !Text,+    -- | Sequence of entries in this bind group layout.+    entries :: Vector BindGroupLayoutEntry+  }+  deriving (Eq, Show)++instance ToRaw BindGroupLayoutDescriptor WGPUBindGroupLayoutDescriptor where+  raw BindGroupLayoutDescriptor {..} = do+    label_ptr <- rawPtr bindGroupLabel+    let n_entryCount = fromIntegral . length $ entries+    entries_ptr <- rawArrayPtr entries+    pure+      WGPUBindGroupLayoutDescriptor.WGPUBindGroupLayoutDescriptor+        { nextInChain = nullPtr,+          label = label_ptr,+          entryCount = n_entryCount,+          entries = entries_ptr+        }++-------------------------------------------------------------------------------++-- | Describes a single binding inside a bind group.+data BindGroupLayoutEntry = BindGroupLayoutEntry+  { -- | Binding index. Must match a shader index, and be unique inside a+    --   bind group layout.+    binding :: !Binding,+    -- | Which shader stages can see this binding.+    visibility :: !ShaderStage,+    -- | Type of the binding.+    bindGroupLayoutEntryType :: !BindingType+  }+  deriving (Eq, Show)++instance ToRaw BindGroupLayoutEntry WGPUBindGroupLayoutEntry where+  raw BindGroupLayoutEntry {..} = do+    n_binding <- raw binding+    n_visibility <- raw visibility+    (n_buffer, n_sampler, n_texture, n_storageTexture) <-+      case bindGroupLayoutEntryType of+        BindingTypeBuffer bbl -> do+          nn_buffer <- raw bbl+          pure (nn_buffer, noSampler, noTexture, noStorageTexture)+        BindingTypeSampler sbl -> do+          nn_sampler <- raw sbl+          pure (noBuffer, nn_sampler, noTexture, noStorageTexture)+        BindingTypeTexture tbl -> do+          nn_texture <- raw tbl+          pure (noBuffer, noSampler, nn_texture, noStorageTexture)+        BindingTypeStorageTexture stbl -> do+          nn_storageTexture <- raw stbl+          pure (noBuffer, noSampler, noTexture, nn_storageTexture)+    pure+      WGPUBindGroupLayoutEntry.WGPUBindGroupLayoutEntry+        { nextInChain = nullPtr,+          binding = n_binding,+          visibility = n_visibility,+          buffer = n_buffer,+          sampler = n_sampler,+          texture = n_texture,+          storageTexture = n_storageTexture+        }+    where+      noBuffer :: WGPUBufferBindingLayout+      noBuffer =+        WGPUBufferBindingLayout.WGPUBufferBindingLayout+          { nextInChain = nullPtr,+            typ = WGPUBufferBindingType.Undefined,+            hasDynamicOffset = CBool 0,+            minBindingSize = 0+          }++      noSampler :: WGPUSamplerBindingLayout+      noSampler =+        WGPUSamplerBindingLayout.WGPUSamplerBindingLayout+          { nextInChain = nullPtr,+            typ = WGPUSamplerBindingType.Undefined+          }++      noTexture :: WGPUTextureBindingLayout+      noTexture =+        WGPUTextureBindingLayout.WGPUTextureBindingLayout+          { nextInChain = nullPtr,+            sampleType = WGPUTextureSampleType.Undefined,+            viewDimension = WGPUTextureViewDimension.Undefined,+            multisampled = CBool 0+          }++      noStorageTexture :: WGPUStorageTextureBindingLayout+      noStorageTexture =+        WGPUStorageTextureBindingLayout.WGPUStorageTextureBindingLayout+          { nextInChain = nullPtr,+            access = WGPUStorageTextureAccess.Undefined,+            format = WGPUTextureFormat.Undefined,+            viewDimension = WGPUTextureViewDimension.Undefined+          }++-------------------------------------------------------------------------------++-- | Binding index.+--+-- This must match a shader index, and be unique inside a binding group+-- layout.+newtype Binding = Binding {unBinding :: Word32} deriving (Eq, Show)++instance ToRaw Binding Word32 where+  raw = pure . unBinding++-------------------------------------------------------------------------------++-- | Describes the shader stages from which a binding will be visible.+data ShaderStage = ShaderStage+  { -- | Binding is visible from the vertex shader of a render pipeline.+    stageVertex :: !Bool,+    -- | Binding is visible from the fragment shader of a render pipeline.+    stageFragment :: !Bool,+    -- | Binding is visible from the compute shader of a compute pipeline.+    stageCompute :: !Bool+  }+  deriving (Eq, Show)++instance ToRaw ShaderStage WGPUShaderStageFlags where+  raw ShaderStage {..} =+    pure $+      (if stageVertex then WGPUShaderStage.Vertex else 0)+        .|. (if stageFragment then WGPUShaderStage.Fragment else 0)+        .|. (if stageCompute then WGPUShaderStage.Compute else 0)++-------------------------------------------------------------------------------++-- | Specifies type of a binding.+data BindingType+  = -- | A buffer binding.+    BindingTypeBuffer !BufferBindingLayout+  | -- | A sampler that can be used to sample a texture.+    BindingTypeSampler !SamplerBindingLayout+  | -- | A texture binding.+    BindingTypeTexture !TextureBindingLayout+  | -- | A storage texture.+    BindingTypeStorageTexture !StorageTextureBindingLayout+  deriving (Eq, Show)++-------------------------------------------------------------------------------++-- | A buffer binding.+data BufferBindingLayout = BufferBindingLayout+  { -- | Sub-type of the buffer binding.+    bindingBufferLayoutType :: !BufferBindingType,+    -- | Indicates that the binding has a dynamic offset. One offset must be+    --   passed when setting the bind group in the render pass.+    hasDynamicOffset :: !Bool,+    -- | Minimum size of a corresponding buffer binding required to match this+    --   entry.+    minBindingSize :: !(SMaybe Word64)+  }+  deriving (Eq, Show)++instance ToRaw BufferBindingLayout WGPUBufferBindingLayout where+  raw BufferBindingLayout {..} = do+    n_typ <- raw bindingBufferLayoutType+    n_hasDynamicOffset <- raw hasDynamicOffset+    pure+      WGPUBufferBindingLayout.WGPUBufferBindingLayout+        { nextInChain = nullPtr,+          typ = n_typ,+          hasDynamicOffset = n_hasDynamicOffset,+          minBindingSize = fromSMaybe 0 minBindingSize+        }++-------------------------------------------------------------------------------++-- | A sampler binding that can be used to sample a texture.+data SamplerBindingLayout+  = SamplerBindingLayoutFiltering+  | SamplerBindingLayoutNonFiltering+  | SamplerBindingLayoutComparison+  deriving (Eq, Show)++instance ToRaw SamplerBindingLayout WGPUSamplerBindingLayout where+  raw sbl =+    pure $+      WGPUSamplerBindingLayout.WGPUSamplerBindingLayout+        { nextInChain = nullPtr,+          typ =+            case sbl of+              SamplerBindingLayoutFiltering ->+                WGPUSamplerBindingType.Filtering+              SamplerBindingLayoutNonFiltering ->+                WGPUSamplerBindingType.NonFiltering+              SamplerBindingLayoutComparison ->+                WGPUSamplerBindingType.Comparison+        }++-------------------------------------------------------------------------------++-- | A texture binding.+data TextureBindingLayout = TextureBindingLayout+  { -- | Sample type of the texture binding.+    sampleType :: !TextureSampleType,+    -- | Dimension of the texture view that is going to be sampled.+    textureViewDimension :: !TextureViewDimension,+    -- | True if the texture has a sample count greater than 1.+    multiSampled :: !Bool+  }+  deriving (Eq, Show)++instance ToRaw TextureBindingLayout WGPUTextureBindingLayout where+  raw TextureBindingLayout {..} = do+    n_sampleType <- raw sampleType+    n_viewDimension <- raw textureViewDimension+    n_multisampled <- raw multiSampled+    pure+      WGPUTextureBindingLayout.WGPUTextureBindingLayout+        { nextInChain = nullPtr,+          sampleType = n_sampleType,+          viewDimension = n_viewDimension,+          multisampled = n_multisampled+        }++-------------------------------------------------------------------------------++-- | A storage texture binding.+data StorageTextureBindingLayout = StorageTextureBindingLayout+  { -- | Permitted access to this texture.+    access :: !StorageTextureAccess,+    -- | Format of the texture.+    storageTextureFormat :: !TextureFormat,+    -- | Dimension of the texture view that is going to be sampled.+    storageTextureViewDimension :: !TextureViewDimension+  }+  deriving (Eq, Show)++instance ToRaw StorageTextureBindingLayout WGPUStorageTextureBindingLayout where+  raw StorageTextureBindingLayout {..} = do+    n_access <- raw access+    n_format <- raw storageTextureFormat+    n_viewDimension <- raw storageTextureViewDimension+    pure+      WGPUStorageTextureBindingLayout.WGPUStorageTextureBindingLayout+        { nextInChain = nullPtr,+          access = n_access,+          format = n_format,+          viewDimension = n_viewDimension+        }++-------------------------------------------------------------------------------++-- | Specific method of allowed access to a storage texture.+data StorageTextureAccess+  = StorageTextureAccessReadOnly+  | StorageTextureAccessWriteOnly+  | StorageTextureAccessReadWrite+  deriving (Eq, Show)++instance ToRaw StorageTextureAccess WGPUStorageTextureAccess where+  raw sta =+    pure $+      case sta of+        StorageTextureAccessReadOnly -> WGPUStorageTextureAccess.ReadOnly+        StorageTextureAccessWriteOnly -> WGPUStorageTextureAccess.WriteOnly+        StorageTextureAccessReadWrite -> WGPUStorageTextureAccess.Undefined -- ?++-------------------------------------------------------------------------------++-- | Specific type of a sample in a texture binding.+data TextureSampleType+  = TextureSampleTypeFloat {filterable :: !Bool}+  | TextureSampleTypeDepth+  | TextureSampleTypeSignedInt+  | TextureSampleTypeUnsignedInt+  deriving (Eq, Show)++instance ToRaw TextureSampleType WGPUTextureSampleType where+  raw tt =+    pure $+      case tt of+        TextureSampleTypeFloat False -> WGPUTextureSampleType.UnfilterableFloat+        TextureSampleTypeFloat True -> WGPUTextureSampleType.Float+        TextureSampleTypeDepth -> WGPUTextureSampleType.Depth+        TextureSampleTypeSignedInt -> WGPUTextureSampleType.Sint+        TextureSampleTypeUnsignedInt -> WGPUTextureSampleType.Uint++-------------------------------------------------------------------------------++-- | Specific type of a buffer binding.+data BufferBindingType+  = Uniform+  | Storage {readOnly :: !Bool}+  deriving (Eq, Show)++instance ToRaw BufferBindingType WGPUBufferBindingType where+  raw bt =+    pure $+      case bt of+        Uniform -> WGPUBufferBindingType.Uniform+        Storage False -> WGPUBufferBindingType.Storage+        Storage True -> WGPUBufferBindingType.ReadOnlyStorage
+ src-internal/WGPU/Internal/ChainedStruct.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+module WGPU.Internal.ChainedStruct+  ( -- * Types+    ChainedStruct (..),+  )+where++import Foreign (Ptr, castPtr, nullPtr)+import WGPU.Internal.Memory (ToRaw, raw)+import WGPU.Raw.Generated.Enum.WGPUSType (WGPUSType)+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.+    EmptyChain WGPUSType+  | -- | Chained structue that points to the next structure in a chain.+    PtrChain WGPUSType (Ptr a)++instance ToRaw (ChainedStruct a) WGPUChainedStruct where+  raw chainedStruct =+    case chainedStruct of+      EmptyChain sType ->+        pure+          WGPUChainedStruct.WGPUChainedStruct+            { next = nullPtr,+              sType = sType+            }+      PtrChain sType ptr ->+        pure+          WGPUChainedStruct.WGPUChainedStruct+            { next = castPtr ptr,+              sType = sType+            }
+ src-internal/WGPU/Internal/Color.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.Color+-- Description : Color.+module WGPU.Internal.Color+  ( -- * Types+    Color (..),++    -- * Functions+    transparentBlack,+  )+where++import Foreign.C (CDouble (CDouble))+import WGPU.Internal.Memory (ToRaw, raw)+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+  }+  deriving (Eq, Show)++transparentBlack :: Color+transparentBlack = Color 0 0 0 0++instance ToRaw Color WGPUColor where+  raw Color {..} =+    pure $+      WGPUColor.WGPUColor+        (CDouble red)+        (CDouble green)+        (CDouble blue)+        (CDouble alpha)
+ src-internal/WGPU/Internal/CommandBuffer.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : WGPU.Internal.CommandBuffer+-- Description : Command buffers.+module WGPU.Internal.CommandBuffer+  ( -- * Types+    CommandBuffer (..),+  )+where++import WGPU.Internal.Memory (ToRaw, raw, showWithPtr)+import WGPU.Raw.Types (WGPUCommandBuffer (WGPUCommandBuffer))++-------------------------------------------------------------------------------++newtype CommandBuffer = CommandBuffer {wgpuCommandBuffer :: WGPUCommandBuffer}++instance Show CommandBuffer where+  show b =+    let CommandBuffer (WGPUCommandBuffer ptr) = b+     in showWithPtr "CommandBuffer" ptr++instance Eq CommandBuffer where+  (==) b1 b2 =+    let CommandBuffer (WGPUCommandBuffer b1_ptr) = b1+        CommandBuffer (WGPUCommandBuffer b2_ptr) = b2+     in b1_ptr == b2_ptr++instance ToRaw CommandBuffer WGPUCommandBuffer where+  raw = pure . wgpuCommandBuffer
+ src-internal/WGPU/Internal/CommandEncoder.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.CommandEncoder+-- Description : Command encoding.+module WGPU.Internal.CommandEncoder+  ( -- * Types+    CommandEncoder (..),++    -- * Functions+    createCommandEncoder,+    commandEncoderFinish,+  )+where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (ContT (ContT), evalContT)+import Data.Text (Text)+import Foreign (nullPtr, with)+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 qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPUCommandBufferDescriptor (WGPUCommandBufferDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUCommandBufferDescriptor as WGPUCommandBufferDescriptor+import qualified WGPU.Raw.Generated.Struct.WGPUCommandEncoderDescriptor as WGPUCommandEncoderDescriptor+import WGPU.Raw.Types (WGPUCommandEncoder (WGPUCommandEncoder))++-------------------------------------------------------------------------------++-- | Handle to an encoder for a series of GPU operations.+--+-- A command encoder can record render passes, compute passes, and transfer+-- operations between driver-managed resources like buffers and textures.+data CommandEncoder = CommandEncoder+  { commandEncoderInst :: !Instance,+    wgpuCommandEncoder :: !WGPUCommandEncoder+  }++instance Show CommandEncoder where+  show e =+    let CommandEncoder _ (WGPUCommandEncoder ptr) = e+     in showWithPtr "CommandEncoder" ptr++instance Eq CommandEncoder where+  (==) e1 e2 =+    let CommandEncoder _ (WGPUCommandEncoder e1_ptr) = e1+        CommandEncoder _ (WGPUCommandEncoder e2_ptr) = e2+     in e1_ptr == e2_ptr++instance ToRaw CommandEncoder WGPUCommandEncoder where+  raw = pure . wgpuCommandEncoder++-------------------------------------------------------------------------------++-- | Create an empty command encoder.+createCommandEncoder ::+  -- | 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+  let inst = deviceInst device+  label_ptr <- rawPtr label+  commandEncoderDescriptor_ptr <-+    ContT . with $+      WGPUCommandEncoderDescriptor.WGPUCommandEncoderDescriptor+        { nextInChain = nullPtr,+          label = label_ptr+        }+  commandEncoderRaw <-+    liftIO $+      RawFun.wgpuDeviceCreateCommandEncoder+        (wgpuHsInstance inst)+        (wgpuDevice device)+        commandEncoderDescriptor_ptr+  pure (CommandEncoder inst commandEncoderRaw)++-- | Finish encoding commands, returning a command buffer.+commandEncoderFinish ::+  -- | 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+  let inst = commandEncoderInst commandEncoder+  commandBufferDescriptor_ptr <- rawPtr $ CommandBufferDescriptor label+  commandBufferRaw <-+    liftIO $+      RawFun.wgpuCommandEncoderFinish+        (wgpuHsInstance inst)+        (wgpuCommandEncoder commandEncoder)+        commandBufferDescriptor_ptr+  pure (CommandBuffer commandBufferRaw)++-------------------------------------------------------------------------------++newtype CommandBufferDescriptor = CommandBufferDescriptor+  {commandBufferLabel :: Text}+  deriving (Eq, Show)++instance ToRaw CommandBufferDescriptor WGPUCommandBufferDescriptor where+  raw CommandBufferDescriptor {..} = do+    label_ptr <- rawPtr commandBufferLabel+    pure+      WGPUCommandBufferDescriptor.WGPUCommandBufferDescriptor+        { nextInChain = nullPtr,+          label = label_ptr+        }
+ src-internal/WGPU/Internal/Device.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}++-- |+-- Module      : WGPU.Internal.Device.+-- Description : Device (open connection to a device).+module WGPU.Internal.Device+  ( -- * Types+    Device (..),+    DeviceDescriptor (..),+    Features (..),+    Limits (..),++    -- * Functions+    requestDevice,+  )+where++import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (ContT (ContT), evalContT)+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 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.Raw.Generated.Enum.WGPUNativeFeature (WGPUNativeFeature)+import qualified WGPU.Raw.Generated.Enum.WGPUNativeFeature as WGPUNativeFeature+import qualified WGPU.Raw.Generated.Enum.WGPUNativeSType as WGPUSType+import qualified WGPU.Raw.Generated.Fun as RawFun+import qualified WGPU.Raw.Generated.Struct.WGPUDeviceDescriptor as WGPUDeviceDescriptor+import WGPU.Raw.Generated.Struct.WGPUDeviceExtras (WGPUDeviceExtras)+import qualified WGPU.Raw.Generated.Struct.WGPUDeviceExtras as WGPUDeviceExtras+import WGPU.Raw.Types (WGPUDevice (WGPUDevice), WGPURequestDeviceCallback)++-------------------------------------------------------------------------------++-- | An open connection to a graphics and/or compute device.+--+-- A 'Device' may be created using the 'requestDevice' function.+data Device = Device+  { deviceInst :: !Instance,+    wgpuDevice :: !WGPUDevice+  }++instance Show Device where+  show d =+    let Device _ (WGPUDevice ptr) = d+     in showWithPtr "Device" ptr++instance Eq Device where+  (==) d1 d2 =+    let Device _ (WGPUDevice d1_ptr) = d1+        Device _ (WGPUDevice d2_ptr) = d2+     in d1_ptr == d2_ptr++instance ToRaw Device WGPUDevice where+  raw = pure . wgpuDevice++-------------------------------------------------------------------------------++-- | Device features that are not guaranteed to be supported.+--+--   * NOTE: The Rust API currently has far more extensive @Features@. Perhaps+--     they have not yet been ported to the C API?+--     <https://docs.rs/wgpu-types/0.9.0/wgpu_types/struct.Features.html>+newtype Features = Features+  { textureAdapterSpecificFormatFeatures :: Bool+  }+  deriving (Eq, Show)++instance Default Features where+  def =+    Features+      { textureAdapterSpecificFormatFeatures = False+      }++instance ToRaw Features WGPUNativeFeature where+  raw Features {..} =+    pure $+      if textureAdapterSpecificFormatFeatures+        then WGPUNativeFeature.TEXTURE_ADAPTER_SPECIFIC_FORMAT_FEATURES+        else 0++-------------------------------------------------------------------------------++-- | Device limits.+--+-- Represents the set of limits an adapter/device supports.+data Limits = Limits+  { -- | Maximum allowed value for the width of a 1D texture.+    maxTextureDimension1D :: !Word32,+    -- | Maximum allowed value for the width and height of a 2D texture.+    maxTextureDimension2D :: !Word32,+    -- | Maximum allowed value for the width, height or depth of a 3D texture.+    maxTextureDimension3D :: !Word32,+    -- | Maximum allowed value for the array layers of a texture.+    maxTextureArrayLayers :: !Word32,+    -- | Amount of bind groups that can be attached to a pipeline at the same+    --   time.+    maxBindGroups :: !Word32,+    -- | Amount of storage buffer bindings that can be dynamic in a single+    --   pipeline.+    maxDynamicStorageBuffersPerPipelineLayout :: !Word32,+    -- | Amount of sampled textures visible in a single shader stage.+    maxStorageBuffersPerShaderStage :: !Word32,+    -- | Maximum size in bytes of a binding to a uniform buffer.+    maxStorageBufferBindingSize :: !Word32+  }+  deriving (Eq, Show)++instance Default Limits where+  def =+    Limits+      { maxTextureDimension1D = 0,+        maxTextureDimension2D = 0,+        maxTextureDimension3D = 0,+        maxTextureArrayLayers = 0,+        maxBindGroups = 0,+        maxDynamicStorageBuffersPerPipelineLayout = 0,+        maxStorageBuffersPerShaderStage = 0,+        maxStorageBufferBindingSize = 0+      }++-------------------------------------------------------------------------------++-- | Describes a 'Device'.+data DeviceDescriptor = DeviceDescriptor+  { -- | Debug label for the device.+    deviceLabel :: !Text,+    -- | Features that the device should support.+    features :: !Features,+    -- | Limits that the device should support (minimum values).+    limits :: !Limits+  }+  deriving (Eq, Show)++instance Default DeviceDescriptor where+  def =+    DeviceDescriptor+      { deviceLabel = Text.empty,+        features = def,+        limits = def+      }++instance ToRaw DeviceDescriptor WGPUDeviceExtras where+  raw DeviceDescriptor {..} = do+    chain_ptr <- raw (EmptyChain WGPUSType.DeviceExtras)+    label_ptr <- rawPtr deviceLabel+    n_nativeFeatures <- raw features+    pure+      WGPUDeviceExtras.WGPUDeviceExtras+        { chain = chain_ptr,+          maxTextureDimension1D = maxTextureDimension1D limits,+          maxTextureDimension2D = maxTextureDimension2D limits,+          maxTextureDimension3D = maxTextureDimension3D limits,+          maxTextureArrayLayers = maxTextureArrayLayers limits,+          maxBindGroups = maxBindGroups limits,+          maxDynamicStorageBuffersPerPipelineLayout =+            maxDynamicStorageBuffersPerPipelineLayout limits,+          maxStorageBuffersPerShaderStage =+            maxStorageBuffersPerShaderStage limits,+          maxStorageBufferBindingSize =+            maxStorageBufferBindingSize limits,+          nativeFeatures = n_nativeFeatures,+          label = label_ptr,+          tracePath = nullPtr+        }++-- | Requests a connection to a physical device, creating a logical device.+--+-- This action blocks until an available device is returned.+requestDevice ::+  -- | @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+  let inst = adapterInst adapter++  deviceMVar :: MVar WGPUDevice <- liftIO newEmptyMVar++  let deviceCallback :: WGPUDevice -> Ptr () -> IO ()+      deviceCallback device _ = putMVar deviceMVar device+  deviceCallback_c <- liftIO $ mkDeviceCallback deviceCallback++  deviceExtras_ptr <- rawPtr deviceDescriptor+  nextInChain_ptr <- rawPtr (PtrChain WGPUSType.DeviceExtras deviceExtras_ptr)+  deviceDescriptor_ptr <-+    ContT . with $+      WGPUDeviceDescriptor.WGPUDeviceDescriptor+        { nextInChain = nextInChain_ptr+        }++  liftIO $+    RawFun.wgpuAdapterRequestDevice+      (wgpuHsInstance inst)+      (wgpuAdapter adapter)+      deviceDescriptor_ptr+      deviceCallback_c+      nullPtr++  device <- liftIO $ takeMVar deviceMVar+  liftIO $ freeHaskellFunPtr deviceCallback_c++  pure $ case device of+    WGPUDevice ptr | ptr == nullPtr -> Nothing+    WGPUDevice _ -> Just (Device inst device)++foreign import ccall "wrapper"+  mkDeviceCallback ::+    (WGPUDevice -> Ptr () -> IO ()) -> IO WGPURequestDeviceCallback
+ src-internal/WGPU/Internal/Instance.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.Instance+-- Description : Instance.+--+-- Instance of the WGPU API Haskell bindings.+module WGPU.Internal.Instance+  ( -- * Instance++    --+    -- $instance+    Instance (..),+    withInstance,++    -- * Logging+    LogCallback,+    LogLevel (..),+    setLogLevel,+    logLevelToText,+    logStdout,++    -- * Version+    Version (..),+    getVersion,+    versionToText,+  )+where++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 WGPU.Internal.Memory (ToRaw, raw)+import WGPU.Raw.Dynamic (withWGPU)+import WGPU.Raw.Generated.Enum.WGPULogLevel (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.++-------------------------------------------------------------------------------++-- | Instance of the WGPU API.+--+-- An instance is loaded from a dynamic library using the 'withInstance'+-- function.+newtype Instance = Instance {wgpuHsInstance :: WGPUHsInstance}++instance Show Instance where show _ = "<Instance>"++instance ToRaw Instance WGPUHsInstance where+  raw = pure . wgpuHsInstance++-------------------------------------------------------------------------------++-- | Logging level.+data LogLevel+  = Trace+  | Debug+  | Info+  | Warn+  | Error+  deriving (Eq, Show)++-- | Logging callback function.+type LogCallback = LogLevel -> Text -> IO ()++-- | Load the WGPU API from a dynamic library and supply an 'Instance' to a+-- program.+withInstance ::+  -- | 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++-- | Set the current logging level for the instance.+setLogLevel :: Instance -> LogLevel -> IO ()+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 =+  case lvl of+    Trace -> WGPULogLevel.Trace+    Debug -> WGPULogLevel.Debug+    Info -> WGPULogLevel.Info+    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"++-- | 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++-------------------------------------------------------------------------------++-- | Version of WGPU native.+data Version = Version+  { major :: !Word8,+    minor :: !Word8,+    patch :: !Word8,+    subPatch :: !Word8+  }+  deriving (Eq, Show)++-- | Return the exact version of the WGPU native instance.+getVersion :: Instance -> IO Version+getVersion inst = w32ToVersion <$> RawFun.wgpuGetVersion (wgpuHsInstance inst)+  where+    w32ToVersion :: Word32 -> Version+    w32ToVersion w =+      let major = fromIntegral $ (w `shiftR` 24) .&. 0xFF+          minor = fromIntegral $ (w `shiftR` 16) .&. 0xFF+          patch = fromIntegral $ (w `shiftR` 8) .&. 0xFF+          subPatch = fromIntegral $ w .&. 0xFF+       in Version {..}++-- | Convert a 'Version' value to a text string.+--+-- >>> versionToText (Version 0 9 2 2)+-- "v0.9.2.2"+versionToText :: Version -> Text+versionToText ver =+  "" <> showt (major ver)+    <> "."+    <> showt (minor ver)+    <> "."+    <> showt (patch ver)+    <> "."+    <> showt (subPatch ver)++-- | Show a value as a 'Text' string.+showt :: Show a => a -> Text+showt = Text.pack . show
+ src-internal/WGPU/Internal/Memory.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : WGPU.Internal.Memory+-- Description : Managing memory.+--+-- This module contains type classes used to manage marshalling of objects into+-- memory before calling C functions.+--+-- = Motivation+--+-- In many locations in the API, we have:+--+-- A type (example only) which contains a nice Haskell representation of+-- some data:+--+-- @+-- data ApiType = ApiType { things :: Vector Thing }+-- @+--+-- and a raw type which is required for a C function:+--+-- @+-- data WGPUApiType = WGPUApiType+--   { thingsCount :: 'Word8',            -- this is an array length+--     things      :: 'Ptr' WGPUApiThing  -- this is a pointer to an array+--   }+-- @+--+-- This type class constraint represents the ability to encode @ApiType@ as+-- @WGPUApiType@, performing any necessary memory allocation and freeing:+--+-- @+-- 'ToRaw' ApiType WGPUApiType+-- @+--+-- 'ToRaw' uses the 'ContT' monad so that bracketing of the memory resources+-- can be performed around some continuation that uses the memory.+--+-- In the example above, we could write a 'ToRaw' instance as follows:+--+-- @+-- instance 'ToRaw' ApiType WGPUApiType where+--   'raw' ApiType{..} = do+--     names_ptr <- 'rawArrayPtr' names+--     'pure' $ WGPUApiType+--       { namesCount = fromIntegral . length $ names,+--         names      = names_ptr+--       }+-- @+--+-- The 'ToRawPtr' type class represents similar functionality, except that it+-- creates a pointer to a value. Thus it does both raw conversion and storing+-- the raw value in allocated memory. It exists as a separate type class so+-- that library types (eg. 'Text' and 'ByteString') can be marshalled into+-- pointers more easily.+module WGPU.Internal.Memory+  ( -- * Classes+    ToRaw (raw),+    ToRawPtr (rawPtr),++    -- * Functions+    rawArrayPtr,+    showWithPtr,+  )+where++import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (ContT (ContT), evalContT)+import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCString)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Vector.Generic (Vector)+import qualified Data.Vector.Generic as Vector+import Data.Word (Word8)+import Foreign+  ( Ptr,+    Storable,+    advancePtr,+    allocaArray,+    castPtr,+    fillBytes,+    poke,+    sizeOf,+    with,+  )+import Foreign.C (CBool, CChar, withCString)++-------------------------------------------------------------------------------+-- Type Classes++-- | Represents a value of type @a@ that can be stored as type @b@ in the+-- 'ContT' monad.+--+-- Implementations of this type class should bracket any resource management for+-- creating the @b@ value around the continuation. For example. memory to hold+-- elements of @b@ should be allocated and freed in a bracketed fashion.+class ToRaw a b | a -> b where+  -- | Convert a value to a raw representation, bracketing any resource+  -- management.+  raw :: a -> ContT c IO b++-- | Represents a value of type @a@ that can be stored as type @(Ptr b)@ in the+-- 'ContT' monad.+--+-- Implementations of this type class should bracket resource management for+-- creating @('Ptr' b)@ around the continuation. In particular, the memory+-- 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)++-------------------------------------------------------------------------------+-- Derived Functionality++-- | Return a pointer to an allocated array, populated with raw values from a+-- vector.+rawArrayPtr ::+  forall v a b c.+  (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++-------------------------------------------------------------------------------+-- 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++instance ToRaw Bool CBool where raw x = pure (if x then 1 else 0)++instance ToRawPtr Text CChar where rawPtr = ContT . withCString . Text.unpack++instance ToRawPtr ByteString Word8 where+  rawPtr byteString =+    ContT $ \action -> unsafeUseAsCString byteString (action . castPtr)++-------------------------------------------------------------------------------+-- Utils++-- | 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++-- | Formatter for 'Show' instances for opaque pointers.+--+-- Displays a name and a corresponding opaque pointer.+showWithPtr ::+  -- | Name of the type.+  String ->+  -- | Opaque pointer that the type contains.+  Ptr a ->+  -- | Final show string.+  String+showWithPtr name ptr = "<" <> name <> ":" <> show ptr <> ">"
+ src-internal/WGPU/Internal/Multipurpose.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : WGPU.Internal.Multipurpose+-- Description : Multipurpose+--+-- This is a bit like a "Types" module. It exists to collect things which are+-- somewhat generic and are used in more than one part of the API.+module WGPU.Internal.Multipurpose+  ( -- * Types+    CompareFunction (..),+  )+where++import WGPU.Internal.Memory (ToRaw, raw)+import WGPU.Raw.Generated.Enum.WGPUCompareFunction (WGPUCompareFunction)+import qualified WGPU.Raw.Generated.Enum.WGPUCompareFunction as WGPUCompareFunction++-------------------------------------------------------------------------------++-- | Comparison function used for depth and stencil operations.+data CompareFunction+  = CompareFunctionNever+  | CompareFunctionLess+  | CompareFunctionEqual+  | CompareFunctionLessEqual+  | CompareFunctionGreater+  | CompareFunctionNotEqual+  | CompareFunctionGreaterEqual+  | CompareFunctionAlways+  deriving (Eq, Show)++-- | Convert a 'CompareFunction' to its raw value.+instance ToRaw CompareFunction WGPUCompareFunction where+  raw cf =+    pure $+      case cf of+        CompareFunctionNever -> WGPUCompareFunction.Never+        CompareFunctionLess -> WGPUCompareFunction.Less+        CompareFunctionEqual -> WGPUCompareFunction.Equal+        CompareFunctionLessEqual -> WGPUCompareFunction.LessEqual+        CompareFunctionGreater -> WGPUCompareFunction.Greater+        CompareFunctionNotEqual -> WGPUCompareFunction.NotEqual+        CompareFunctionGreaterEqual -> WGPUCompareFunction.GreaterEqual+        CompareFunctionAlways -> WGPUCompareFunction.Always
+ src-internal/WGPU/Internal/Pipeline.hs view
@@ -0,0 +1,897 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.Pipeline+-- Description : Pipelines.+module WGPU.Internal.Pipeline+  ( -- * Types+    PipelineLayout (..),+    PipelineLayoutDescriptor (..),+    VertexFormat (..),+    VertexAttribute (..),+    InputStepMode (..),+    VertexBufferLayout (..),+    VertexState (..),+    PrimitiveTopology (..),+    IndexFormat (..),+    FrontFace (..),+    CullMode (..),+    PrimitiveState (..),+    StencilOperation (..),+    StencilFaceState (..),+    StencilState (..),+    DepthBiasState (..),+    DepthStencilState (..),+    MultisampleState (..),+    BlendFactor (..),+    BlendOperation (..),+    BlendComponent (..),+    BlendState (..),+    ColorWriteMask (..),+    ColorTargetState (..),+    FragmentState (..),+    RenderPipelineDescriptor (..),++    -- * Functions+    createPipelineLayout,+    createRenderPipeline,+    colorWriteMaskAll,+  )+where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (evalContT)+import Data.Bits ((.|.))+import Data.Default (Default, def)+import Data.Int (Int32)+import Data.Text (Text)+import Data.Vector (Vector)+import qualified Data.Vector as Vector+import Data.Word (Word32, Word64, Word8)+import Foreign (nullPtr)+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.Multipurpose (CompareFunction)+import WGPU.Internal.RenderPass (RenderPipeline (RenderPipeline))+import WGPU.Internal.SMaybe (SMaybe (SJust, SNothing))+import WGPU.Internal.Shader (ShaderEntryPoint, ShaderModule)+import WGPU.Internal.Texture (TextureFormat)+import WGPU.Raw.Generated.Enum.WGPUBlendFactor (WGPUBlendFactor)+import qualified WGPU.Raw.Generated.Enum.WGPUBlendFactor as WGPUBlendFactor+import WGPU.Raw.Generated.Enum.WGPUBlendOperation (WGPUBlendOperation)+import qualified WGPU.Raw.Generated.Enum.WGPUBlendOperation as WGPUBlendOperation+import WGPU.Raw.Generated.Enum.WGPUColorWriteMask (WGPUColorWriteMask (WGPUColorWriteMask))+import qualified WGPU.Raw.Generated.Enum.WGPUColorWriteMask as WGPUColorWriteMask+import WGPU.Raw.Generated.Enum.WGPUCullMode (WGPUCullMode)+import qualified WGPU.Raw.Generated.Enum.WGPUCullMode as WGPUCullMode+import WGPU.Raw.Generated.Enum.WGPUFrontFace (WGPUFrontFace)+import qualified WGPU.Raw.Generated.Enum.WGPUFrontFace as WGPUFrontFace+import WGPU.Raw.Generated.Enum.WGPUIndexFormat (WGPUIndexFormat)+import qualified WGPU.Raw.Generated.Enum.WGPUIndexFormat as WGPUIndexFormat+import WGPU.Raw.Generated.Enum.WGPUInputStepMode (WGPUInputStepMode)+import qualified WGPU.Raw.Generated.Enum.WGPUInputStepMode as WGPUInputStepMode+import WGPU.Raw.Generated.Enum.WGPUPrimitiveTopology (WGPUPrimitiveTopology)+import qualified WGPU.Raw.Generated.Enum.WGPUPrimitiveTopology as WGPUPrimitiveTopology+import WGPU.Raw.Generated.Enum.WGPUStencilOperation (WGPUStencilOperation)+import qualified WGPU.Raw.Generated.Enum.WGPUStencilOperation as WGPUStencilOperation+import WGPU.Raw.Generated.Enum.WGPUVertexFormat (WGPUVertexFormat)+import qualified WGPU.Raw.Generated.Enum.WGPUVertexFormat as WGPUVertexFormat+import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPUBlendComponent (WGPUBlendComponent)+import qualified WGPU.Raw.Generated.Struct.WGPUBlendComponent as WGPUBlendComponent+import WGPU.Raw.Generated.Struct.WGPUBlendState (WGPUBlendState)+import qualified WGPU.Raw.Generated.Struct.WGPUBlendState as WGPUBlendState+import WGPU.Raw.Generated.Struct.WGPUColorTargetState (WGPUColorTargetState)+import qualified WGPU.Raw.Generated.Struct.WGPUColorTargetState as WGPUColorTargetState+import WGPU.Raw.Generated.Struct.WGPUDepthStencilState (WGPUDepthStencilState)+import qualified WGPU.Raw.Generated.Struct.WGPUDepthStencilState as WGPUDepthStencilState+import WGPU.Raw.Generated.Struct.WGPUFragmentState (WGPUFragmentState)+import qualified WGPU.Raw.Generated.Struct.WGPUFragmentState as WGPUFragmentState+import WGPU.Raw.Generated.Struct.WGPUMultisampleState (WGPUMultisampleState)+import qualified WGPU.Raw.Generated.Struct.WGPUMultisampleState as WGPUMultisampleState+import WGPU.Raw.Generated.Struct.WGPUPipelineLayoutDescriptor (WGPUPipelineLayoutDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUPipelineLayoutDescriptor as WGPUPipelineLayoutDescriptor+import WGPU.Raw.Generated.Struct.WGPUPrimitiveState (WGPUPrimitiveState)+import qualified WGPU.Raw.Generated.Struct.WGPUPrimitiveState as WGPUPrimitiveState+import WGPU.Raw.Generated.Struct.WGPURenderPipelineDescriptor (WGPURenderPipelineDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPURenderPipelineDescriptor as WGPURenderPipelineDescriptor+import WGPU.Raw.Generated.Struct.WGPUStencilFaceState (WGPUStencilFaceState)+import qualified WGPU.Raw.Generated.Struct.WGPUStencilFaceState as WGPUStencilFaceState+import WGPU.Raw.Generated.Struct.WGPUVertexAttribute (WGPUVertexAttribute)+import qualified WGPU.Raw.Generated.Struct.WGPUVertexAttribute as WGPUVertexAttribute+import WGPU.Raw.Generated.Struct.WGPUVertexBufferLayout (WGPUVertexBufferLayout)+import qualified WGPU.Raw.Generated.Struct.WGPUVertexBufferLayout as WGPUVertexBufferLayout+import WGPU.Raw.Generated.Struct.WGPUVertexState (WGPUVertexState)+import qualified WGPU.Raw.Generated.Struct.WGPUVertexState as WGPUVertexState+import WGPU.Raw.Types (WGPUPipelineLayout (WGPUPipelineLayout))+import Prelude hiding (compare)++-------------------------------------------------------------------------------++newtype PipelineLayout = PipelineLayout {wgpuPipelineLayout :: WGPUPipelineLayout}++instance Show PipelineLayout where+  show p =+    let PipelineLayout (WGPUPipelineLayout ptr) = p+     in showWithPtr "PipelineLayout" ptr++instance Eq PipelineLayout where+  (==) p1 p2 =+    let PipelineLayout (WGPUPipelineLayout p1_ptr) = p1+        PipelineLayout (WGPUPipelineLayout p2_ptr) = p2+     in p1_ptr == p2_ptr++instance ToRaw PipelineLayout WGPUPipelineLayout where+  raw = pure . wgpuPipelineLayout++-------------------------------------------------------------------------------++-- | Describes a pipeline layout.+data PipelineLayoutDescriptor = PipelineLayoutDescriptor+  { -- | Debug label of the pipeline layout.+    pipelineLabel :: !Text,+    -- | Bind groups that this pipeline uses.+    bindGroupLayouts :: !(Vector BindGroupLayout)+  }+  deriving (Eq, Show)++instance ToRaw PipelineLayoutDescriptor WGPUPipelineLayoutDescriptor where+  raw PipelineLayoutDescriptor {..} = do+    label_ptr <- rawPtr pipelineLabel+    bindGroupLayouts_ptr <- rawArrayPtr bindGroupLayouts+    pure+      WGPUPipelineLayoutDescriptor.WGPUPipelineLayoutDescriptor+        { nextInChain = nullPtr,+          label = label_ptr,+          bindGroupLayoutCount = fromIntegral . Vector.length $ bindGroupLayouts,+          bindGroupLayouts = bindGroupLayouts_ptr+        }++-------------------------------------------------------------------------------++-- | Create a pipeline layout.+createPipelineLayout ::+  -- | The device for which the pipeline layout will be created.+  Device ->+  -- | Descriptor of the pipeline.+  PipelineLayoutDescriptor ->+  IO PipelineLayout+createPipelineLayout device pdl = evalContT $ do+  let inst = deviceInst device+  pipelineLayoutDescriptor_ptr <- rawPtr pdl+  rawPipelineLayout <-+    liftIO $+      RawFun.wgpuDeviceCreatePipelineLayout+        (wgpuHsInstance inst)+        (wgpuDevice device)+        pipelineLayoutDescriptor_ptr+  pure (PipelineLayout rawPipelineLayout)++-------------------------------------------------------------------------------++-- | Vertex format for a vertex attribute.+data VertexFormat+  = VertexFormatUint8x2+  | VertexFormatUint8x4+  | VertexFormatSint8x2+  | VertexFormatSint8x4+  | VertexFormatUnorm8x2+  | VertexFormatUnorm8x4+  | VertexFormatSnorm8x2+  | VertexFormatSnorm8x4+  | VertexFormatUint16x2+  | VertexFormatUint16x4+  | VertexFormatSint16x2+  | VertexFormatSint16x4+  | VertexFormatUnorm16x2+  | VertexFormatUnorm16x4+  | VertexFormatSnorm16x2+  | VertexFormatSnorm16x4+  | VertexFormatFloat16x2+  | VertexFormatFloat16x4+  | VertexFormatFloat32+  | VertexFormatFloat32x2+  | VertexFormatFloat32x3+  | VertexFormatFloat32x4+  | VertexFormatUint32+  | VertexFormatUint32x2+  | VertexFormatUint32x3+  | VertexFormatUint32x4+  | VertexFormatSint32+  | VertexFormatSint32x2+  | VertexFormatSint32x3+  | VertexFormatSint32x4+  deriving (Eq, Show)++-- | Convert a 'VertexFormat' to its raw representation.+instance ToRaw VertexFormat WGPUVertexFormat where+  raw vf =+    pure $+      case vf of+        VertexFormatUint8x2 -> WGPUVertexFormat.Uint8x2+        VertexFormatUint8x4 -> WGPUVertexFormat.Uint8x4+        VertexFormatSint8x2 -> WGPUVertexFormat.Sint8x2+        VertexFormatSint8x4 -> WGPUVertexFormat.Sint8x4+        VertexFormatUnorm8x2 -> WGPUVertexFormat.Unorm8x2+        VertexFormatUnorm8x4 -> WGPUVertexFormat.Unorm8x4+        VertexFormatSnorm8x2 -> WGPUVertexFormat.Snorm8x2+        VertexFormatSnorm8x4 -> WGPUVertexFormat.Snorm8x4+        VertexFormatUint16x2 -> WGPUVertexFormat.Uint16x2+        VertexFormatUint16x4 -> WGPUVertexFormat.Uint16x4+        VertexFormatSint16x2 -> WGPUVertexFormat.Sint16x2+        VertexFormatSint16x4 -> WGPUVertexFormat.Sint16x4+        VertexFormatUnorm16x2 -> WGPUVertexFormat.Unorm16x2+        VertexFormatUnorm16x4 -> WGPUVertexFormat.Unorm16x4+        VertexFormatSnorm16x2 -> WGPUVertexFormat.Snorm16x2+        VertexFormatSnorm16x4 -> WGPUVertexFormat.Snorm16x4+        VertexFormatFloat16x2 -> WGPUVertexFormat.Float16x2+        VertexFormatFloat16x4 -> WGPUVertexFormat.Float16x4+        VertexFormatFloat32 -> WGPUVertexFormat.Float32+        VertexFormatFloat32x2 -> WGPUVertexFormat.Float32x2+        VertexFormatFloat32x3 -> WGPUVertexFormat.Float32x3+        VertexFormatFloat32x4 -> WGPUVertexFormat.Float32x4+        VertexFormatUint32 -> WGPUVertexFormat.Uint32+        VertexFormatUint32x2 -> WGPUVertexFormat.Uint32x2+        VertexFormatUint32x3 -> WGPUVertexFormat.Uint32x3+        VertexFormatUint32x4 -> WGPUVertexFormat.Uint32x4+        VertexFormatSint32 -> WGPUVertexFormat.Sint32+        VertexFormatSint32x2 -> WGPUVertexFormat.Sint32x2+        VertexFormatSint32x3 -> WGPUVertexFormat.Sint32x3+        VertexFormatSint32x4 -> WGPUVertexFormat.Sint32x4++-------------------------------------------------------------------------------++-- | Vertex inputs (attributes) to shaders.+data VertexAttribute = VertexAttribute+  { -- | Format of the input.+    vertexFormat :: VertexFormat,+    -- | Byte offset of the start of the input.+    offset :: Word64,+    -- | Location for this input. Must match the location in the shader.+    shaderLocation :: Word32+  }+  deriving (Eq, Show)++instance ToRaw VertexAttribute WGPUVertexAttribute where+  raw VertexAttribute {..} = do+    n_format <- raw vertexFormat+    pure+      WGPUVertexAttribute.WGPUVertexAttribute+        { format = n_format,+          offset = offset,+          shaderLocation = shaderLocation+        }++-------------------------------------------------------------------------------++-- | Determines when vertex data is advanced.+data InputStepMode+  = -- | Input data is advanced every vertex.+    InputStepModeVertex+  | -- | Input data is advanced every instance.+    InputStepModeInstance+  deriving (Eq, Show)++-- | Convert an 'InputStepMode' to its raw value.+instance ToRaw InputStepMode WGPUInputStepMode where+  raw ism =+    pure $+      case ism of+        InputStepModeVertex -> WGPUInputStepMode.Vertex+        InputStepModeInstance -> WGPUInputStepMode.Instance++-------------------------------------------------------------------------------++-- | Describes how a vertex buffer is interpreted.+data VertexBufferLayout = VertexBufferLayout+  { -- | The stride, in bytes, between elements of the buffer.+    arrayStride :: !Word64,+    -- | How often the vertex buffer is stepped forward (per vertex or+    -- per instance).+    stepMode :: !InputStepMode,+    -- | List of attributes that comprise a single vertex.+    attributes :: !(Vector VertexAttribute)+  }+  deriving (Eq, Show)++instance ToRaw VertexBufferLayout WGPUVertexBufferLayout where+  raw VertexBufferLayout {..} = do+    n_stepMode <- raw stepMode+    attributes_ptr <- rawArrayPtr attributes+    pure+      WGPUVertexBufferLayout.WGPUVertexBufferLayout+        { arrayStride = arrayStride,+          stepMode = n_stepMode,+          attributeCount = fromIntegral . length $ attributes,+          attributes = attributes_ptr+        }++-------------------------------------------------------------------------------++-- | Describes the vertex process in a render pipeline.+data VertexState = VertexState+  { -- | The compiled shader module for this stage.+    vertexShaderModule :: !ShaderModule,+    -- | The name of the entry point in the compiled shader. There must be a+    -- function that returns @void@ with this name in the shader.+    vertexEntryPoint :: !ShaderEntryPoint,+    -- | The format of any vertex buffers used with this pipeline.+    buffers :: !(Vector VertexBufferLayout)+  }+  deriving (Eq, Show)++instance ToRaw VertexState WGPUVertexState where+  raw VertexState {..} = do+    n_shaderModule <- raw vertexShaderModule+    entryPoint_ptr <- rawPtr vertexEntryPoint+    buffers_ptr <- rawArrayPtr buffers+    pure+      WGPUVertexState.WGPUVertexState+        { nextInChain = nullPtr,+          shaderModule = n_shaderModule,+          entryPoint = entryPoint_ptr,+          bufferCount = fromIntegral . length $ buffers,+          buffers = buffers_ptr+        }++-------------------------------------------------------------------------------++-- | Primitive type out of which an input mesh is composed.+data PrimitiveTopology+  = PrimitiveTopologyPointList+  | PrimitiveTopologyLineList+  | PrimitiveTopologyLineStrip+  | PrimitiveTopologyTriangleList+  | PrimitiveTopologyTriangleStrip+  deriving (Eq, Show)++instance Default PrimitiveTopology where def = PrimitiveTopologyTriangleList++-- | Convert a 'PrimitiveTopology' to its raw value.+instance ToRaw PrimitiveTopology WGPUPrimitiveTopology where+  raw pt =+    pure $+      case pt of+        PrimitiveTopologyPointList -> WGPUPrimitiveTopology.PointList+        PrimitiveTopologyLineList -> WGPUPrimitiveTopology.LineList+        PrimitiveTopologyLineStrip -> WGPUPrimitiveTopology.LineStrip+        PrimitiveTopologyTriangleList -> WGPUPrimitiveTopology.TriangleList+        PrimitiveTopologyTriangleStrip -> WGPUPrimitiveTopology.TriangleStrip++-------------------------------------------------------------------------------++-- | Format of indices used within a pipeline.+data IndexFormat+  = -- | Indices are 16-bit unsigned integers ('Word16')+    IndexFormatUint16+  | -- | Indices are 32-bit unsigned integers ('Word32')+    IndexFormatUint32+  deriving (Eq, Show)++-- | Convert an 'IndexFormat' to its raw value.+instance ToRaw IndexFormat WGPUIndexFormat where+  raw idxFmt =+    pure $+      case idxFmt of+        IndexFormatUint16 -> WGPUIndexFormat.Uint16+        IndexFormatUint32 -> WGPUIndexFormat.Uint32++-------------------------------------------------------------------------------++-- | Winding order which classifies the "front" face.+data FrontFace+  = -- | Triangles with counter-clockwise vertices are the front face.+    FrontFaceCCW+  | -- | Triangles with clockwise vertices are the front face.+    FrontFaceCW+  deriving (Eq, Show)++instance Default FrontFace where def = FrontFaceCCW++-- | Convert a 'FrontFace' to its raw value.+instance ToRaw FrontFace WGPUFrontFace where+  raw ff =+    pure $+      case ff of+        FrontFaceCCW -> WGPUFrontFace.CCW+        FrontFaceCW -> WGPUFrontFace.CW++-------------------------------------------------------------------------------++-- | Whether to cull the face of a vertex.+data CullMode+  = -- | Cull the front face.+    CullModeFront+  | -- | Cull the back face.+    CullModeBack+  | -- | Do not cull either face.+    CullModeNone+  deriving (Eq, Show)++instance Default CullMode where def = CullModeNone++-- | Convert a 'CullMode' to its raw value.+instance ToRaw CullMode WGPUCullMode where+  raw cm =+    pure $+      case cm of+        CullModeFront -> WGPUCullMode.Front+        CullModeBack -> WGPUCullMode.Back+        CullModeNone -> WGPUCullMode.None++-------------------------------------------------------------------------------++-- | Describes the state of primitive assembly and rasterization in a render+-- pipeline.+--+-- Differences between this and the Rust API:+--   - no `clamp_depth` member+--   - no `polygon_mode` member+--   - no `conservative` member+data PrimitiveState = PrimitiveState+  { -- | The primitive topology used to interpret vertices.+    topology :: !PrimitiveTopology,+    -- | When drawing strip topologies with indices, this is the required+    -- format for the index buffer. This has no effect for non-indexed or+    -- non-strip draws.+    stripIndexFormat :: !(SMaybe IndexFormat),+    -- | The face to consider the front for the purpose of culling and+    -- stencil operations.+    frontFace :: !FrontFace,+    -- | The face culling mode.+    cullMode :: !CullMode+  }+  deriving (Eq, Show)++instance Default PrimitiveState where+  def =+    PrimitiveState+      { topology = def,+        stripIndexFormat = SNothing,+        frontFace = def,+        cullMode = def+      }++instance ToRaw PrimitiveState WGPUPrimitiveState where+  raw PrimitiveState {..} = do+    n_topology <- raw topology+    n_stripIndexFormat <-+      case stripIndexFormat of+        SNothing -> pure WGPUIndexFormat.Undefined+        SJust sif -> raw sif+    n_frontFace <- raw frontFace+    n_cullMode <- raw cullMode+    pure+      WGPUPrimitiveState.WGPUPrimitiveState+        { nextInChain = nullPtr,+          topology = n_topology,+          stripIndexFormat = n_stripIndexFormat,+          frontFace = n_frontFace,+          cullMode = n_cullMode+        }++-------------------------------------------------------------------------------++-- | Operation to perform on a stencil value.+data StencilOperation+  = StencilOperationKeep+  | StencilOperationZero+  | StencilOperationReplace+  | StencilOperationInvert+  | StencilOperationIncrementClamp+  | StencilOperationDecrementClamp+  | StencilOperationIncrementWrap+  | StencilOperationDecrementWrap+  deriving (Eq, Show)++-- | Convert a 'StencilOperation' to its raw value.+instance ToRaw StencilOperation WGPUStencilOperation where+  raw so =+    pure $+      case so of+        StencilOperationKeep -> WGPUStencilOperation.Keep+        StencilOperationZero -> WGPUStencilOperation.Zero+        StencilOperationReplace -> WGPUStencilOperation.Replace+        StencilOperationInvert -> WGPUStencilOperation.Invert+        StencilOperationIncrementClamp -> WGPUStencilOperation.IncrementClamp+        StencilOperationDecrementClamp -> WGPUStencilOperation.DecrementClamp+        StencilOperationIncrementWrap -> WGPUStencilOperation.IncrementWrap+        StencilOperationDecrementWrap -> WGPUStencilOperation.DecrementWrap++-------------------------------------------------------------------------------++-- | Describes stencil state in a render pipeline.+data StencilFaceState = StencilFaceState+  { compare :: !CompareFunction,+    failOp :: !StencilOperation,+    depthFailOp :: !StencilOperation,+    passOp :: !StencilOperation+  }+  deriving (Eq, Show)++instance ToRaw StencilFaceState WGPUStencilFaceState where+  raw StencilFaceState {..} = do+    n_compare <- raw compare+    n_failOp <- raw failOp+    n_depthFailOp <- raw depthFailOp+    n_passOp <- raw passOp+    pure+      WGPUStencilFaceState.WGPUStencilFaceState+        { compare = n_compare,+          failOp = n_failOp,+          depthFailOp = n_depthFailOp,+          passOp = n_passOp+        }++-------------------------------------------------------------------------------++-- | State of the stencil operation (fixed pipeline stage).+data StencilState = StencilState+  { -- | Front face mode.+    front :: !StencilFaceState,+    -- | Back face mode.+    back :: !StencilFaceState,+    -- | Stencil values are AND-ed with this mask when reading and writing from+    -- the stencil buffer.+    readMask :: !Word8,+    -- | Stencil values are AND-ed with this mask when writing to the stencil+    -- buffer.+    writeMask :: !Word8+  }+  deriving (Eq, Show)++-------------------------------------------------------------------------------++-- | Describes the biasing setting for the depth target.+data DepthBiasState = DepthBiasState+  { -- Constant depth biasing factor, in basic units of the depth format.+    constant :: !Int32,+    -- | Slope depth biasing factor.+    slopeScale :: !Float,+    -- | Depth bias clamp value (absolute).+    clamp :: !Float+  }+  deriving (Eq, Show)++-------------------------------------------------------------------------------++-- | Describes the depth / stencil state of a render pipeline.+data DepthStencilState = DepthStencilState+  { -- | Format of the depth/stencil buffer. This must be a special depth+    -- format, and must match the format of the depth/stencil attachment in+    -- the command encoder.+    depthStencilTextureFormat :: !TextureFormat,+    -- | If disabled, depth will not be written to.+    depthWriteEnabled :: !Bool,+    -- | Comparison function used to compare depth values in the depth test.+    depthCompare :: !CompareFunction,+    -- | Stencil state.+    stencil :: !StencilState,+    -- | Depth bias state.+    bias :: !DepthBiasState+  }+  deriving (Eq, Show)++instance ToRaw DepthStencilState WGPUDepthStencilState where+  raw DepthStencilState {..} = do+    n_format <- raw depthStencilTextureFormat+    n_depthWriteEnabled <- raw depthWriteEnabled+    n_depthCompare <- raw depthCompare+    n_stencilFront <- raw . front $ stencil+    n_stencilBack <- raw . back $ stencil+    pure+      WGPUDepthStencilState.WGPUDepthStencilState+        { nextInChain = nullPtr,+          format = n_format,+          depthWriteEnabled = n_depthWriteEnabled,+          depthCompare = n_depthCompare,+          stencilFront = n_stencilFront,+          stencilBack = n_stencilBack,+          stencilReadMask = fromIntegral . readMask $ stencil,+          stencilWriteMask = fromIntegral $ writeMask (stencil :: StencilState),+          depthBias = constant bias,+          depthBiasSlopeScale = CFloat (slopeScale bias),+          depthBiasClamp = CFloat (clamp bias)+        }++-------------------------------------------------------------------------------++-- | Describes the multi-sampling state of a render pipeline.+data MultisampleState = MultisampleState+  { -- | Number of samples calculated per pixel (for MSAA). For+    -- non-multisampled textures, this should be 1.+    count :: Word32,+    -- | Bitmask that restricts the samples of a pixel modified by this+    -- pipeline. All samples can be enabled by using+    -- @0XFFFFFFFF@ (ie. zero complement).+    mask :: Word32,+    -- | When enabled, produces another sample mask per pixel based on the+    -- alpha output value, and that is AND-ed with the sample mask and the+    -- primitive coverage to restrict the set of samples affected by a+    -- primitive.+    alphaToCoverageEnabled :: Bool+  }+  deriving (Eq, Show)++instance ToRaw MultisampleState WGPUMultisampleState where+  raw MultisampleState {..} = do+    n_alphaToCoverageEnabled <- raw alphaToCoverageEnabled+    pure+      WGPUMultisampleState.WGPUMultisampleState+        { nextInChain = nullPtr,+          count = count,+          mask = mask,+          alphaToCoverageEnabled = n_alphaToCoverageEnabled+        }++-------------------------------------------------------------------------------++-- | Alpha blend factor.+data BlendFactor+  = BlendFactorZero+  | BlendFactorOne+  | BlendFactorSrc+  | BlendFactorOneMinusSrc+  | BlendFactorSrcAlpha+  | BlendFactorOneMinusSrcAlpha+  | BlendFactorDst+  | BlendFactorOneMinusDst+  | BlendFactorDstAlpha+  | BlendFactorOneMinusDstAlpha+  | BlendFactorSrcAlphaSaturated+  | BlendFactorConstant+  | BlendFactorOneMinusConstant+  deriving (Eq, Show)++-- | Convert a 'BlendFactor' to its raw value.+instance ToRaw BlendFactor WGPUBlendFactor where+  raw bf =+    pure $+      case bf of+        BlendFactorZero -> WGPUBlendFactor.Zero+        BlendFactorOne -> WGPUBlendFactor.One+        BlendFactorSrc -> WGPUBlendFactor.Src+        BlendFactorOneMinusSrc -> WGPUBlendFactor.OneMinusSrc+        BlendFactorSrcAlpha -> WGPUBlendFactor.SrcAlpha+        BlendFactorOneMinusSrcAlpha -> WGPUBlendFactor.OneMinusSrcAlpha+        BlendFactorDst -> WGPUBlendFactor.Dst+        BlendFactorOneMinusDst -> WGPUBlendFactor.OneMinusDst+        BlendFactorDstAlpha -> WGPUBlendFactor.DstAlpha+        BlendFactorOneMinusDstAlpha -> WGPUBlendFactor.OneMinusDstAlpha+        BlendFactorSrcAlphaSaturated -> WGPUBlendFactor.SrcAlphaSaturated+        BlendFactorConstant -> WGPUBlendFactor.Constant+        BlendFactorOneMinusConstant -> WGPUBlendFactor.OneMinusConstant++-------------------------------------------------------------------------------++-- | Alpha blending operation.+data BlendOperation+  = BlendOperationAdd+  | BlendOperationSubtract+  | BlendOperationReverseSubtract+  | BlendOperationMin+  | BlendOperationMax+  deriving (Eq, Show)++-- | Convert a 'BlendOperation' to its raw value.+instance ToRaw BlendOperation WGPUBlendOperation where+  raw bo =+    pure $+      case bo of+        BlendOperationAdd -> WGPUBlendOperation.Add+        BlendOperationSubtract -> WGPUBlendOperation.Subtract+        BlendOperationReverseSubtract -> WGPUBlendOperation.ReverseSubtract+        BlendOperationMin -> WGPUBlendOperation.Min+        BlendOperationMax -> WGPUBlendOperation.Max++-------------------------------------------------------------------------------++-- | Describes the blend component of a pipeline.+data BlendComponent = BlendComponent+  { -- | Multiplier for the source, which is produced by the fragment shader.+    srcFactor :: !BlendFactor,+    -- | Multiplier for the destination, which is stored in the target.+    dstFactor :: !BlendFactor,+    -- | Binary operation applied to the source and destination, multiplied by+    -- their respective factors.+    operation :: !BlendOperation+  }+  deriving (Eq, Show)++instance Default BlendComponent where+  def =+    BlendComponent+      { srcFactor = BlendFactorOne,+        dstFactor = BlendFactorZero,+        operation = BlendOperationAdd+      }++instance ToRaw BlendComponent WGPUBlendComponent where+  raw BlendComponent {..} = do+    n_srcFactor <- raw srcFactor+    n_dstFactor <- raw dstFactor+    n_operation <- raw operation+    pure+      WGPUBlendComponent.WGPUBlendComponent+        { srcFactor = n_srcFactor,+          dstFactor = n_dstFactor,+          operation = n_operation+        }++-------------------------------------------------------------------------------++-- | Describes the blend state of a render pipeline.+data BlendState = BlendState+  { -- | Color equation.+    blendColor :: !BlendComponent,+    -- | Alpha equation.+    blendAlpha :: !BlendComponent+  }+  deriving (Eq, Show)++instance ToRaw BlendState WGPUBlendState where+  raw BlendState {..} = do+    n_color <- raw blendColor+    n_alpha <- raw blendAlpha+    pure+      WGPUBlendState.WGPUBlendState+        { color = n_color,+          alpha = n_alpha+        }++-------------------------------------------------------------------------------++-- | Describes which color channels are written.+data ColorWriteMask = ColorWriteMask+  { maskRed :: !Bool,+    maskGreen :: !Bool,+    maskBlue :: !Bool,+    maskAlpha :: !Bool+  }+  deriving (Eq, Show)++-- | A 'ColorWriteMask' that writes all colors and the alpha value.+colorWriteMaskAll :: ColorWriteMask+colorWriteMaskAll = ColorWriteMask True True True True++instance ToRaw ColorWriteMask WGPUColorWriteMask where+  raw ColorWriteMask {..} =+    pure $+      WGPUColorWriteMask+        ( (if maskRed then WGPUColorWriteMask.Red else 0)+            .|. (if maskGreen then WGPUColorWriteMask.Green else 0)+            .|. (if maskBlue then WGPUColorWriteMask.Blue else 0)+            .|. (if maskAlpha then WGPUColorWriteMask.Alpha else 0)+        )++-------------------------------------------------------------------------------++-- | Describes the color state of a render pipeline.+data ColorTargetState = ColorTargetState+  { -- | The texture format of the image that this pipeline will render to.+    -- Must match the format of the corresponding color attachment in the+    -- command encoder.+    colorTextureFormat :: !TextureFormat,+    -- | The blending that is used for this pipeline.+    blend :: !(SMaybe BlendState),+    -- | Mask which enables or disables writes to different color/alpha+    -- channels.+    colorWriteMask :: !ColorWriteMask+  }+  deriving (Eq, Show)++instance ToRaw ColorTargetState WGPUColorTargetState where+  raw ColorTargetState {..} = do+    n_format <- raw colorTextureFormat+    blend_ptr <-+      case blend of+        SNothing -> pure nullPtr+        SJust x -> rawPtr x+    WGPUColorWriteMask n_writeMask <- raw colorWriteMask+    pure+      WGPUColorTargetState.WGPUColorTargetState+        { nextInChain = nullPtr,+          format = n_format,+          blend = blend_ptr,+          writeMask = n_writeMask+        }++-------------------------------------------------------------------------------++-- | Describes the fragment processing in a render pipeline.+data FragmentState = FragmentState+  { -- | The compiled shader module for this stage.+    fragmentShaderModule :: !ShaderModule,+    -- | The entry point in the compiled shader. There must be a function that+    -- returns @void@ with this name in the shader.+    fragmentEntryPoint :: !ShaderEntryPoint,+    -- | The color state of the render targets.+    targets :: !(Vector ColorTargetState)+  }+  deriving (Eq, Show)++instance ToRaw FragmentState WGPUFragmentState where+  raw FragmentState {..} = do+    n_shaderModule <- raw fragmentShaderModule+    entryPoint_ptr <- rawPtr fragmentEntryPoint+    targets_ptr <- rawArrayPtr targets+    pure+      WGPUFragmentState.WGPUFragmentState+        { nextInChain = nullPtr,+          shaderModule = n_shaderModule,+          entryPoint = entryPoint_ptr,+          targetCount = fromIntegral . length $ targets,+          targets = targets_ptr+        }++-------------------------------------------------------------------------------++-- | Describes a render (graphics) pipeline.+data RenderPipelineDescriptor = RenderPipelineDescriptor+  { -- | Debug label of the pipeline.+    renderPipelineLabel :: !Text,+    -- | The layout of bind groups for this pipeline.+    layout :: !(SMaybe PipelineLayout),+    -- | Vertex state.+    vertex :: !VertexState,+    -- | Primitive state.+    primitive :: !PrimitiveState,+    -- | Depth stencil state.+    depthStencil :: !(SMaybe DepthStencilState),+    -- | Multisample state.+    multisample :: !MultisampleState,+    -- | Fragment state.+    fragment :: !(SMaybe FragmentState)+  }+  deriving (Eq, Show)++instance ToRaw RenderPipelineDescriptor WGPURenderPipelineDescriptor where+  raw RenderPipelineDescriptor {..} = do+    label_ptr <- rawPtr renderPipelineLabel+    n_layout <-+      case layout of+        SNothing -> pure (WGPUPipelineLayout nullPtr)+        SJust x -> raw x+    n_vertex <- raw vertex+    n_primitive <- raw primitive+    n_depthStencil <-+      case depthStencil of+        SNothing -> pure nullPtr+        SJust x -> rawPtr x+    n_multisample <- raw multisample+    n_fragment <-+      case fragment of+        SNothing -> pure nullPtr+        SJust x -> rawPtr x+    pure+      WGPURenderPipelineDescriptor.WGPURenderPipelineDescriptor+        { nextInChain = nullPtr,+          label = label_ptr,+          layout = n_layout,+          vertex = n_vertex,+          primitive = n_primitive,+          depthStencil = n_depthStencil,+          multisample = n_multisample,+          fragment = n_fragment+        }++createRenderPipeline ::+  Device ->+  RenderPipelineDescriptor ->+  IO RenderPipeline+createRenderPipeline device rpd = evalContT $ do+  let inst :: Instance+      inst = deviceInst device++  renderPipelineDescriptor_ptr <- rawPtr rpd+  renderPipelineRaw <-+    liftIO $+      RawFun.wgpuDeviceCreateRenderPipeline+        (wgpuHsInstance inst)+        (wgpuDevice device)+        renderPipelineDescriptor_ptr+  pure (RenderPipeline renderPipelineRaw)
+ src-internal/WGPU/Internal/Queue.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.Queue+-- Description : Queues+module WGPU.Internal.Queue+  ( -- * Types+    Queue,++    -- * Functions+    getQueue,+    queueSubmit,+  )+where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (evalContT)+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 qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Types (WGPUQueue (WGPUQueue))++-------------------------------------------------------------------------------++data Queue = Queue+  { queueInst :: !Instance,+    wgpuQueue :: !WGPUQueue+  }++instance Show Queue where+  show q =+    let Queue _ (WGPUQueue ptr) = q+     in showWithPtr "Queue" ptr++instance Eq Queue where+  (==) q1 q2 =+    let Queue _ (WGPUQueue q1_ptr) = q1+        Queue _ (WGPUQueue q2_ptr) = q2+     in q1_ptr == q2_ptr++instance ToRaw Queue WGPUQueue where+  raw = pure . wgpuQueue++-------------------------------------------------------------------------------++-- | Get the queue for a device.+getQueue :: Device -> IO Queue+getQueue device = do+  let queueInst :: Instance+      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++  commandBuffer_ptr <- rawArrayPtr cbs+  liftIO $+    RawFun.wgpuQueueSubmit+      (wgpuHsInstance inst)+      (wgpuQueue queue)+      commandCount+      commandBuffer_ptr
+ src-internal/WGPU/Internal/RenderPass.hs view
@@ -0,0 +1,341 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.RenderPass+-- Description : Render passes.+module WGPU.Internal.RenderPass+  ( -- * Types+    RenderPipeline (..),+    RenderPassEncoder,+    LoadOp (..),+    StoreOp (..),+    Operations (..),+    RenderPassColorAttachment (..),+    RenderPassDepthStencilAttachment (..),+    RenderPassDescriptor (..),+    Range (..),++    -- * Functions+    beginRenderPass,+    renderPassSetPipeline,+    renderPassDraw,+    endRenderPass,+  )+where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (evalContT)+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.Instance (Instance, wgpuHsInstance)+import WGPU.Internal.Memory (ToRaw, 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+import WGPU.Raw.Generated.Enum.WGPUStoreOp (WGPUStoreOp)+import qualified WGPU.Raw.Generated.Enum.WGPUStoreOp as WGPUStoreOp+import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPURenderPassColorAttachment (WGPURenderPassColorAttachment)+import qualified WGPU.Raw.Generated.Struct.WGPURenderPassColorAttachment as WGPURenderPassColorAttachment+import WGPU.Raw.Generated.Struct.WGPURenderPassDepthStencilAttachment (WGPURenderPassDepthStencilAttachment)+import qualified WGPU.Raw.Generated.Struct.WGPURenderPassDepthStencilAttachment as WGPURenderPassDepthStencilAttachment+import WGPU.Raw.Generated.Struct.WGPURenderPassDescriptor (WGPURenderPassDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPURenderPassDescriptor as WGPURenderPassDescriptor+import WGPU.Raw.Types+  ( WGPUQuerySet (WGPUQuerySet),+    WGPURenderPassEncoder (WGPURenderPassEncoder),+    WGPURenderPipeline (WGPURenderPipeline),+    WGPUTextureView (WGPUTextureView),+  )++-------------------------------------------------------------------------------++newtype RenderPipeline = RenderPipeline {wgpuRenderPipeline :: WGPURenderPipeline}++instance Show RenderPipeline where+  show p =+    let RenderPipeline (WGPURenderPipeline ptr) = p+     in showWithPtr "RenderPipeline" ptr++instance Eq RenderPipeline where+  (==) p1 p2 =+    let RenderPipeline (WGPURenderPipeline p1_ptr) = p1+        RenderPipeline (WGPURenderPipeline p2_ptr) = p2+     in p1_ptr == p2_ptr++instance ToRaw RenderPipeline WGPURenderPipeline where+  raw = pure . wgpuRenderPipeline++-------------------------------------------------------------------------------++data RenderPassEncoder = RenderPassEncoder+  { renderPassEncoderInst :: !Instance,+    wgpuRenderPassEncoder :: !WGPURenderPassEncoder+  }++instance Show RenderPassEncoder where+  show e =+    let RenderPassEncoder _ (WGPURenderPassEncoder ptr) = e+     in showWithPtr "RenderPassEncoder" ptr++instance Eq RenderPassEncoder where+  (==) e1 e2 =+    let RenderPassEncoder _ (WGPURenderPassEncoder e1_ptr) = e1+        RenderPassEncoder _ (WGPURenderPassEncoder e2_ptr) = e2+     in e1_ptr == e2_ptr++instance ToRaw RenderPassEncoder WGPURenderPassEncoder where+  raw = pure . wgpuRenderPassEncoder++-------------------------------------------------------------------------------++-- | Operation to perform to the output attachment at the start of a render+-- pass.+data LoadOp a+  = -- | Clear with the specified color value.+    LoadOpClear !a+  | -- | Load from memory.+    LoadOpLoad+  deriving (Eq, Show)++-- | Operation to perform to the output attachment at the end of the render+-- pass.+data StoreOp+  = -- | Store the result.+    StoreOpStore+  | -- | Discard the result.+    StoreOpClear+  deriving (Eq, Show)++instance ToRaw StoreOp WGPUStoreOp where+  raw storeOp =+    pure $+      case storeOp of+        StoreOpStore -> WGPUStoreOp.Store+        StoreOpClear -> WGPUStoreOp.Clear++data Operations a = Operations+  { load :: !(LoadOp a),+    store :: StoreOp+  }+  deriving (Eq, Show)++-- | Describes a color attachment to a render pass.+data RenderPassColorAttachment = RenderPassColorAttachment+  { -- | The view to use as an attachment.+    colorView :: !TextureView,+    -- | The view that will receive output if multisampling is used.+    resolveTarget :: !(SMaybe TextureView),+    -- | What operations will be performed on this color attachment.+    operations :: !(Operations Color)+  }+  deriving (Eq, Show)++instance ToRaw RenderPassColorAttachment WGPURenderPassColorAttachment where+  raw RenderPassColorAttachment {..} = do+    n_view <- raw colorView+    n_resolveTarget <-+      case resolveTarget of+        SNothing -> pure (WGPUTextureView nullPtr)+        SJust t -> raw t+    n_storeOp <- raw . store $ operations+    (n_loadOp, n_clearColor) <-+      case load operations of+        LoadOpClear color -> do+          n_color <- raw color+          pure (WGPULoadOp.Clear, n_color)+        LoadOpLoad -> do+          n_color <- raw transparentBlack+          pure (WGPULoadOp.Load, n_color)+    pure+      WGPURenderPassColorAttachment.WGPURenderPassColorAttachment+        { view = n_view,+          resolveTarget = n_resolveTarget,+          loadOp = n_loadOp,+          storeOp = n_storeOp,+          clearColor = n_clearColor+        }++-- | Describes a depth/stencil attachment to a render pass.+data RenderPassDepthStencilAttachment = RenderPassDepthStencilAttachment+  { -- | The view to use as an attachment.+    depthStencilView :: !TextureView,+    -- | What operations will be performed on the depth part.+    depthOps :: !(SMaybe (Operations Float)),+    -- | What operations will be performed on the stencil part.+    stencilOps :: !(SMaybe (Operations Word32))+  }+  deriving (Eq, Show)++instance+  ToRaw+    RenderPassDepthStencilAttachment+    WGPURenderPassDepthStencilAttachment+  where+  raw RenderPassDepthStencilAttachment {..} = do+    n_view <- raw depthStencilView++    (n_depthLoadOp, n_depthStoreOp, n_clearDepth, n_depthReadOnly) <-+      case depthOps of+        SNothing ->+          pure+            ( WGPULoadOp.Clear,+              WGPUStoreOp.Clear,+              CFloat 0,+              CBool 1+            )+        SJust Operations {..} -> do+          (loadOp, depth) <-+            case load of+              LoadOpClear d -> pure (WGPULoadOp.Clear, CFloat d)+              LoadOpLoad -> pure (WGPULoadOp.Load, CFloat 0)+          storeOp <- raw store+          pure (loadOp, storeOp, depth, CBool 0)++    (n_stencilLoadOp, n_stencilStoreOp, n_clearStencil, n_stencilReadOnly) <-+      case stencilOps of+        SNothing ->+          pure+            ( WGPULoadOp.Clear,+              WGPUStoreOp.Clear,+              0,+              CBool 1+            )+        SJust Operations {..} -> do+          (loadOp, stencil) <-+            case load of+              LoadOpClear s -> pure (WGPULoadOp.Clear, s)+              LoadOpLoad -> pure (WGPULoadOp.Load, 0)+          storeOp <- raw store+          pure (loadOp, storeOp, stencil, CBool 0)++    pure+      WGPURenderPassDepthStencilAttachment.WGPURenderPassDepthStencilAttachment+        { view = n_view,+          depthLoadOp = n_depthLoadOp,+          depthStoreOp = n_depthStoreOp,+          clearDepth = n_clearDepth,+          depthReadOnly = n_depthReadOnly,+          stencilLoadOp = n_stencilLoadOp,+          stencilStoreOp = n_stencilStoreOp,+          clearStencil = n_clearStencil,+          stencilReadOnly = n_stencilReadOnly+        }++-- | Describes the attachments of a render pass.+data RenderPassDescriptor = RenderPassDescriptor+  { -- | Debugging label for the render pass.+    renderPassLabel :: !Text,+    -- | Color attachments of the render pass.+    colorAttachments :: !(Vector RenderPassColorAttachment),+    -- | Depth and stencil attachments of the render pass.+    depthStencilAttachment :: !(SMaybe RenderPassDepthStencilAttachment)+  }+  deriving (Eq, Show)++instance ToRaw RenderPassDescriptor WGPURenderPassDescriptor where+  raw RenderPassDescriptor {..} = do+    label_ptr <- rawPtr renderPassLabel+    colorAttachments_ptr <- rawArrayPtr colorAttachments+    depthStencilAttachment_ptr <-+      case depthStencilAttachment of+        SNothing -> pure nullPtr+        SJust x -> rawPtr x+    pure+      WGPURenderPassDescriptor.WGPURenderPassDescriptor+        { nextInChain = nullPtr,+          label = label_ptr,+          colorAttachmentCount = fromIntegral . length $ colorAttachments,+          colorAttachments = colorAttachments_ptr,+          depthStencilAttachment = depthStencilAttachment_ptr,+          occlusionQuerySet = WGPUQuerySet nullPtr+        }++-- | Half open range. It includes the 'start' value but not the 'end' value.+data Range a = Range+  { rangeStart :: !a,+    rangeLength :: !a+  }+  deriving (Eq, Show)++-- | Begins recording of a render pass.+beginRenderPass ::+  -- | @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++  renderPassDescriptor_ptr <- rawPtr rpd+  renderPassEncoderRaw <-+    liftIO $+      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 ::+  -- | Render pass encoder on which to act.+  RenderPassEncoder ->+  -- | Render pipeline to set active.+  RenderPipeline ->+  -- | IO action which sets the active render pipeline.+  IO ()+renderPassSetPipeline renderPassEncoder renderPipeline = do+  let inst :: Instance+      inst = renderPassEncoderInst renderPassEncoder++  RawFun.wgpuRenderPassEncoderSetPipeline+    (wgpuHsInstance inst)+    (wgpuRenderPassEncoder renderPassEncoder)+    (wgpuRenderPipeline renderPipeline)++-- | Draws primitives from the active vertex buffers.+renderPassDraw ::+  -- | Render pass encoder on which to act.+  RenderPassEncoder ->+  -- | Range of vertices to draw.+  Range Word32 ->+  -- | Range of instances to draw.+  Range Word32 ->+  -- | IO action which stores the draw command.+  IO ()+renderPassDraw renderPassEncoder vertices instances = do+  let inst :: Instance+      inst = renderPassEncoderInst renderPassEncoder++  RawFun.wgpuRenderPassEncoderDraw+    (wgpuHsInstance inst)+    (wgpuRenderPassEncoder renderPassEncoder)+    (rangeLength (vertices :: Range Word32))+    (rangeLength (instances :: Range Word32))+    (rangeStart vertices)+    (rangeStart instances)++-- | Finish recording of a render pass.+endRenderPass ::+  -- | Render pass encoder on which to finish recording.+  RenderPassEncoder ->+  -- | IO action that finishes recording.+  IO ()+endRenderPass renderPassEncoder = do+  let inst :: Instance+      inst = renderPassEncoderInst renderPassEncoder++  RawFun.wgpuRenderPassEncoderEndPass+    (wgpuHsInstance inst)+    (wgpuRenderPassEncoder renderPassEncoder)
+ src-internal/WGPU/Internal/SMaybe.hs view
@@ -0,0 +1,33 @@+-- |+-- Module      : WGPU.Internal.SMaybe+-- Description : Strict maybe.+module WGPU.Internal.SMaybe+  ( -- * Types+    SMaybe (SNothing, SJust),++    -- * Functions+    fromSMaybe,+  )+where++-- | Strict version of the 'Maybe' type.+data SMaybe a+  = SNothing+  | SJust !a+  deriving (Eq, Show)++-- | Return a value from an 'SMaybe' with a default.+--+-- This function returns the 'SJust' value from an 'SMaybe', or the default+-- value if the 'SMaybe' is 'SNothing'.+fromSMaybe ::+  -- | Default value.+  a ->+  -- | 'SMaybe' from which to return the 'SJust' value if possible.+  SMaybe a ->+  -- | 'SJust' value, if present, or the default value, if not.+  a+fromSMaybe defaultValue sMaybe =+  case sMaybe of+    SNothing -> defaultValue+    SJust providedValue -> providedValue
+ src-internal/WGPU/Internal/Sampler.hs view
@@ -0,0 +1,7 @@+-- |+-- Module      : WGPU.Internal.Sampler+-- Description : Texture sampling.+module WGPU.Internal.Sampler+  (+  )+where
+ src-internal/WGPU/Internal/Shader.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : WGPU.Internal.Shader+-- Description : Shader modules.+module WGPU.Internal.Shader+  ( -- * Types+    ShaderModule,+    ShaderModuleDescriptor (..),+    ShaderSource (..),+    SPIRV (..),+    WGSL (..),+    ShaderEntryPoint (..),++    -- * Functions+    createShaderModule,+    createShaderModuleSPIRV,+    createShaderModuleWGSL,+  )+where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (evalContT)+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import Data.String (IsString)+import Data.Text (Text)+import Data.Word (Word32, Word8)+import Foreign (Ptr, castPtr, sizeOf)+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 qualified WGPU.Raw.Generated.Enum.WGPUSType as WGPUSType+import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPUShaderModuleDescriptor (WGPUShaderModuleDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUShaderModuleDescriptor as WGPUShaderModuleDescriptor+import WGPU.Raw.Generated.Struct.WGPUShaderModuleSPIRVDescriptor (WGPUShaderModuleSPIRVDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUShaderModuleSPIRVDescriptor as WGPUShaderModuleSPIRVDescriptor+import WGPU.Raw.Generated.Struct.WGPUShaderModuleWGSLDescriptor (WGPUShaderModuleWGSLDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUShaderModuleWGSLDescriptor as WGPUShaderModuleWGSLDescriptor+import WGPU.Raw.Types (WGPUShaderModule (WGPUShaderModule))++-------------------------------------------------------------------------------++-- | Handle to a compiled shader module.+newtype ShaderModule = ShaderModule {wgpuShaderModule :: WGPUShaderModule}++instance Show ShaderModule where+  show m =+    let ShaderModule (WGPUShaderModule ptr) = m+     in showWithPtr "ShaderModule" ptr++instance Eq ShaderModule where+  (==) m1 m2 =+    let ShaderModule (WGPUShaderModule m1_ptr) = m1+        ShaderModule (WGPUShaderModule m2_ptr) = m2+     in m1_ptr == m2_ptr++instance ToRaw ShaderModule WGPUShaderModule where+  raw = pure . wgpuShaderModule++-------------------------------------------------------------------------------++-- | Create a shader module from either SPIR-V or WGSL source code.+createShaderModule ::+  -- | 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+  shaderModuleDescriptor_ptr <- rawPtr smd+  rawShaderModule <-+    liftIO $+      RawFun.wgpuDeviceCreateShaderModule+        (wgpuHsInstance inst)+        (wgpuDevice device)+        shaderModuleDescriptor_ptr+  pure (ShaderModule rawShaderModule)++-- | Create a shader module from SPIR-V source code.+createShaderModuleSPIRV ::+  -- | Device for which the shader should be created.+  Device ->+  -- | Debugging label for the shader.+  Text ->+  -- | Shader source code (SPIR-V bytestring).+  SPIRV ->+  -- | IO action creating the shader module.+  IO ShaderModule+createShaderModuleSPIRV device label spirv =+  createShaderModule device smd+  where+    smd :: ShaderModuleDescriptor+    smd =+      ShaderModuleDescriptor+        { shaderLabel = label,+          source = ShaderSourceSPIRV spirv+        }++-- | Create a shader module from WGSL source code.+createShaderModuleWGSL ::+  -- | Device for which the shader should be created.+  Device ->+  -- | Debugging label for the shader.+  Text ->+  -- | Shader source code (WGSL source string).+  WGSL ->+  -- | IO action creating the shader module.+  IO ShaderModule+createShaderModuleWGSL device label wgsl =+  createShaderModule device smd+  where+    smd :: ShaderModuleDescriptor+    smd =+      ShaderModuleDescriptor+        { shaderLabel = label,+          source = ShaderSourceWGSL wgsl+        }++-------------------------------------------------------------------------------++-- | Descriptor for a shader module.+data ShaderModuleDescriptor = ShaderModuleDescriptor+  { -- | Debug label of the shader module.+    shaderLabel :: !Text,+    -- | Source code for the shader.+    source :: !ShaderSource+  }+  deriving (Eq, Show)++instance ToRaw ShaderModuleDescriptor WGPUShaderModuleDescriptor where+  raw ShaderModuleDescriptor {..} = do+    nextInChain_ptr <-+      case source of+        ShaderSourceSPIRV spirv -> do+          ptr <- rawPtr spirv+          rawPtr (PtrChain WGPUSType.ShaderModuleSPIRVDescriptor ptr)+        ShaderSourceWGSL wgsl -> do+          ptr <- rawPtr wgsl+          rawPtr (PtrChain WGPUSType.ShaderModuleWGSLDescriptor ptr)+    label_ptr <- rawPtr shaderLabel+    pure+      WGPUShaderModuleDescriptor.WGPUShaderModuleDescriptor+        { nextInChain = nextInChain_ptr,+          label = label_ptr+        }++-------------------------------------------------------------------------------++-- | Source for a shader module.+data ShaderSource+  = -- | Use shader source from a SPIRV module (pre-compiled).+    ShaderSourceSPIRV !SPIRV+  | -- | Use shader source from WGSL string.+    ShaderSourceWGSL !WGSL+  deriving (Eq, Show)++-- | Pre-compiled SPIRV module bytes.+newtype SPIRV = SPIRV ByteString deriving (Eq, Show)++instance ToRaw SPIRV WGPUShaderModuleSPIRVDescriptor where+  raw (SPIRV bs) =+    WGPUShaderModuleSPIRVDescriptor.WGPUShaderModuleSPIRVDescriptor+      <$> raw (EmptyChain WGPUSType.ShaderModuleSPIRVDescriptor)+      <*> pure+        ( fromIntegral $+            ByteString.length bs `div` sizeOf (undefined :: Word32)+        )+      <*> ((castPtr :: Ptr Word8 -> Ptr Word32) <$> rawPtr bs)++-- | WGSL shader source code.+newtype WGSL = WGSL Text deriving (Eq, Show)++instance ToRaw WGSL WGPUShaderModuleWGSLDescriptor where+  raw (WGSL txt) =+    WGPUShaderModuleWGSLDescriptor.WGPUShaderModuleWGSLDescriptor+      <$> raw (EmptyChain WGPUSType.ShaderModuleWGSLDescriptor)+      <*> rawPtr txt++-------------------------------------------------------------------------------++-- | Name of a shader entry point.+newtype ShaderEntryPoint = ShaderEntryPoint {unShaderEntryPoint :: Text}+  deriving (Eq, Show, IsString)++instance ToRawPtr ShaderEntryPoint CChar where+  rawPtr = rawPtr . unShaderEntryPoint
+ src-internal/WGPU/Internal/Surface.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- 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.Memory (ToRaw, raw, showWithPtr)+import qualified WGPU.Raw.GLFWSurface+import WGPU.Raw.Types (WGPUSurface (WGPUSurface))++-------------------------------------------------------------------------------++-- | Handle to a presentable surface.+--+-- A 'Surface' presents a platform-specific surface (eg. a window) on to which+-- rendered images may be presented. A 'Surface' can be created for a GLFW+-- window using 'createGLFWSurface'.+data Surface = Surface+  { surfaceInst :: !Instance,+    wgpuSurface :: !WGPUSurface+  }++instance Show Surface where+  show s =+    let Surface _ (WGPUSurface ptr) = s+     in showWithPtr "Surface" ptr++instance Eq Surface where+  (==) s1 s2 =+    let Surface _ (WGPUSurface s1_ptr) = s1+        Surface _ (WGPUSurface s2_ptr) = s2+     in s1_ptr == s2_ptr++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
+ src-internal/WGPU/Internal/SwapChain.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : WGPU.Internal.SwapChain+-- Description : Swap chain.+module WGPU.Internal.SwapChain+  ( -- * Types+    SwapChain,+    SwapChainDescriptor (..),+    PresentMode (..),++    -- * Functions+    getSwapChainPreferredFormat,+    createSwapChain,+    getSwapChainCurrentTextureView,+    swapChainPresent,+  )+where++import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Cont (evalContT)+import Data.Text (Text)+import Data.Word (Word32)+import Foreign (Ptr, freeHaskellFunPtr, 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.Surface (Surface, surfaceInst, wgpuSurface)+import WGPU.Internal.Texture (TextureFormat, TextureUsage, TextureView (TextureView), textureFormatFromRaw)+import WGPU.Raw.Generated.Enum.WGPUPresentMode (WGPUPresentMode)+import qualified WGPU.Raw.Generated.Enum.WGPUPresentMode as WGPUPresentMode+import WGPU.Raw.Generated.Enum.WGPUTextureFormat (WGPUTextureFormat (WGPUTextureFormat))+import WGPU.Raw.Generated.Enum.WGPUTextureUsage (WGPUTextureUsage (WGPUTextureUsage))+import qualified WGPU.Raw.Generated.Fun as RawFun+import WGPU.Raw.Generated.Struct.WGPUSwapChainDescriptor (WGPUSwapChainDescriptor)+import qualified WGPU.Raw.Generated.Struct.WGPUSwapChainDescriptor as WGPUSwapChainDescriptor+import WGPU.Raw.Types (WGPUSurfaceGetPreferredFormatCallback, WGPUSwapChain (WGPUSwapChain))++-------------------------------------------------------------------------------++data SwapChain = SwapChain+  { swapChainInst :: !Instance,+    wgpuSwapChain :: !WGPUSwapChain+  }++instance Show SwapChain where+  show s =+    let SwapChain _ (WGPUSwapChain ptr) = s+     in showWithPtr "SwapChain" ptr++instance Eq SwapChain where+  (==) s1 s2 =+    let SwapChain _ (WGPUSwapChain s1_ptr) = s1+        SwapChain _ (WGPUSwapChain s2_ptr) = s2+     in s1_ptr == s2_ptr++instance ToRaw SwapChain WGPUSwapChain where+  raw = pure . wgpuSwapChain++-------------------------------------------------------------------------------++-- | Describes a swapchain.+data SwapChainDescriptor = SwapChainDescriptor+  { -- | Debugging label for the swap chain.+    swapChainLabel :: !Text,+    -- | The usage of the swap chain. The only supported usage is+    --   'TextureUsageRenderAttachment'.+    usage :: !TextureUsage,+    -- | Texture format of the swap chain. The only guaranteed formats are+    -- 'TextureFormatBgra8Unorm' and 'TextureFormatBgra8UnormSrgb'. To+    -- determine the preferred texture format for a surface, use the+    -- 'getSwapChainPreferredFormat' function.+    swapChainFormat :: !TextureFormat,+    -- | Width of the swap chain. Must be the same size as the surface.+    width :: !Word32,+    -- | Height of the swap chain. Must be the same size as the surface.+    height :: !Word32,+    -- | Presentation mode of the swap chain.+    presentMode :: !PresentMode+  }+  deriving (Eq, Show)++instance ToRaw SwapChainDescriptor WGPUSwapChainDescriptor where+  raw SwapChainDescriptor {..} = do+    label_ptr <- rawPtr swapChainLabel+    WGPUTextureUsage n_usage <- raw usage+    n_format <- raw swapChainFormat+    n_presentMode <- raw presentMode+    pure+      WGPUSwapChainDescriptor.WGPUSwapChainDescriptor+        { nextInChain = nullPtr,+          label = label_ptr,+          usage = n_usage,+          format = n_format,+          width = width,+          height = height,+          presentMode = n_presentMode+        }++-------------------------------------------------------------------------------++-- | Behaviour of the presentation engine based on frame rate.+data PresentMode+  = -- | The presentation engine does __not__ wait for a vertical blanking+    -- period and the request is presented immediately. This is a low-latency+    -- presentation mode, but visible tearing may be observed. Will fallback to+    -- @Fifo@ if unavailable on the selected platform and backend. Not optimal+    -- for mobile.+    PresentModeImmediate+  | -- | The presentation engine waits for the next vertical blanking period to+    -- update the current image, but frames may be submitted without delay. This+    -- is a low-latency presentation mode and visible tearing will not be+    -- observed. Will fallback to Fifo if unavailable on the selected platform+    -- and backend. Not optimal for mobile.+    PresentModeMailbox+  | -- | The presentation engine waits for the next vertical blanking period to+    -- update the current image. The framerate will be capped at the display+    -- refresh rate, corresponding to the VSync. Tearing cannot be observed.+    -- Optimal for mobile.+    PresentModeFifo+  deriving (Eq, Show)++instance ToRaw PresentMode WGPUPresentMode where+  raw pm =+    pure $+      case pm of+        PresentModeImmediate -> WGPUPresentMode.Immediate+        PresentModeMailbox -> WGPUPresentMode.Mailbox+        PresentModeFifo -> WGPUPresentMode.Fifo++-------------------------------------------------------------------------------++-- | Returns an optimal texture format to use for the swapchain with this+--   adapter and surface.+getSwapChainPreferredFormat ::+  -- | @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+getSwapChainPreferredFormat surface adapter = do+  let inst :: Instance+      inst = surfaceInst surface++  textureFormatMVar :: MVar WGPUTextureFormat <- newEmptyMVar++  let textureFormatCallback :: WGPUTextureFormat -> Ptr () -> IO ()+      textureFormatCallback tf _ = putMVar textureFormatMVar tf++  textureFormatCallback_c <-+    mkSurfaceGetPreferredFormatCallback textureFormatCallback++  RawFun.wgpuSurfaceGetPreferredFormat+    (wgpuHsInstance inst)+    (wgpuSurface surface)+    (wgpuAdapter adapter)+    textureFormatCallback_c+    nullPtr++  textureFormat <- textureFormatFromRaw <$> takeMVar textureFormatMVar+  freeHaskellFunPtr textureFormatCallback_c+  pure textureFormat++foreign import ccall "wrapper"+  mkSurfaceGetPreferredFormatCallback ::+    (WGPUTextureFormat -> Ptr () -> IO ()) ->+    IO WGPUSurfaceGetPreferredFormatCallback++-------------------------------------------------------------------------------++-- | Createa a new 'SwapChain' which targets a 'Surface'.+--+-- To determine the preferred 'TextureFormat' for the 'Surface', use the+-- 'getSwapChainPreferredFormat' function.+createSwapChain ::+  -- | @Device@ for which the @SwapChain@ will be created.+  Device ->+  -- | @Surface@ for which the @SwapChain@ will be created.+  Surface ->+  -- | 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++  swapChainDescriptor_ptr <- rawPtr scd+  rawSwapChain <-+    liftIO $+      RawFun.wgpuDeviceCreateSwapChain+        (wgpuHsInstance inst)+        (wgpuDevice device)+        (wgpuSurface surface)+        swapChainDescriptor_ptr+  pure (SwapChain inst rawSwapChain)++-------------------------------------------------------------------------------++-- | Get the 'TextureView' for the current swap chain frame.+getSwapChainCurrentTextureView ::+  -- | Swap chain from which to fetch the current texture view.+  SwapChain ->+  -- | IO action which returns the current swap chain texture view.+  IO TextureView+getSwapChainCurrentTextureView swapChain = do+  let inst :: Instance+      inst = swapChainInst swapChain+  TextureView+    <$> RawFun.wgpuSwapChainGetCurrentTextureView+      (wgpuHsInstance inst)+      (wgpuSwapChain swapChain)++-------------------------------------------------------------------------------++-- | Present the latest swap chain image.+swapChainPresent ::+  -- | Swap chain to present.+  SwapChain ->+  -- | IO action which presents the swap chain image.+  IO ()+swapChainPresent swapChain = do+  let inst :: Instance+      inst = swapChainInst swapChain+  RawFun.wgpuSwapChainPresent (wgpuHsInstance inst) (wgpuSwapChain swapChain)
+ src-internal/WGPU/Internal/Texture.hs view
@@ -0,0 +1,273 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : WGPU.Internal.Texture+-- Description : Textures and texture views.+module WGPU.Internal.Texture+  ( -- * Types+    TextureView (..),+    TextureFormat (..),+    TextureUsage (..),+    TextureViewDimension (..),++    -- * Functions+    textureFormatFromRaw,+  )+where++import WGPU.Internal.Memory (ToRaw, raw, showWithPtr)+import WGPU.Raw.Generated.Enum.WGPUTextureFormat (WGPUTextureFormat)+import qualified WGPU.Raw.Generated.Enum.WGPUTextureFormat as WGPUTextureFormat+import WGPU.Raw.Generated.Enum.WGPUTextureUsage (WGPUTextureUsage)+import qualified WGPU.Raw.Generated.Enum.WGPUTextureUsage as WGPUTextureUsage+import WGPU.Raw.Generated.Enum.WGPUTextureViewDimension (WGPUTextureViewDimension)+import qualified WGPU.Raw.Generated.Enum.WGPUTextureViewDimension as WGPUTextureViewDimension+import WGPU.Raw.Types (WGPUTextureView (WGPUTextureView))++-------------------------------------------------------------------------------++-- | Handle to a texture view.+--+-- A 'TextureView' describes a texture and associated metadata needed by a+-- rendering pipeline or bind group.+newtype TextureView = TextureView {wgpuTextureView :: WGPUTextureView}++instance Show TextureView where+  show v =+    let TextureView (WGPUTextureView ptr) = v+     in showWithPtr "TextureView" ptr++instance Eq TextureView where+  (==) v1 v2 =+    let TextureView (WGPUTextureView v1_ptr) = v1+        TextureView (WGPUTextureView v2_ptr) = v2+     in v1_ptr == v2_ptr++instance ToRaw TextureView WGPUTextureView where+  raw = pure . wgpuTextureView++-------------------------------------------------------------------------------++-- | Dimensions of a particular texture view.+data TextureViewDimension+  = TextureViewDimension1D+  | TextureViewDimension2D+  | TextureViewDimension2DArray+  | TextureViewDimensionCube+  | TextureViewDimensionCubeArray+  | TextureViewDimension3D+  deriving (Eq, Show)++instance ToRaw TextureViewDimension WGPUTextureViewDimension where+  raw tvd =+    pure $+      case tvd of+        TextureViewDimension1D -> WGPUTextureViewDimension.D1D+        TextureViewDimension2D -> WGPUTextureViewDimension.D2D+        TextureViewDimension2DArray -> WGPUTextureViewDimension.D2DArray+        TextureViewDimensionCube -> WGPUTextureViewDimension.Cube+        TextureViewDimensionCubeArray -> WGPUTextureViewDimension.CubeArray+        TextureViewDimension3D -> WGPUTextureViewDimension.D3D++-------------------------------------------------------------------------------++-- | Different ways you can use a texture.+--+-- The usages determine from what kind of memory the texture is allocated, and+-- in what actions the texture can partake.+data TextureUsage+  = TextureUsageCopySrc+  | TextureUsageCopyDst+  | TextureUsageSampled+  | TextureUsageStorage+  | TextureUsageRenderAttachment+  deriving (Eq, Show)++instance ToRaw TextureUsage WGPUTextureUsage where+  raw tu =+    pure $+      case tu of+        TextureUsageCopySrc -> WGPUTextureUsage.CopySrc+        TextureUsageCopyDst -> WGPUTextureUsage.CopyDst+        TextureUsageSampled -> WGPUTextureUsage.Sampled+        TextureUsageStorage -> WGPUTextureUsage.Storage+        TextureUsageRenderAttachment -> WGPUTextureUsage.RenderAttachment++-------------------------------------------------------------------------------++-- | Texture data format.+data TextureFormat+  = TextureFormatR8Unorm+  | TextureFormatR8Snorm+  | TextureFormatR8Uint+  | TextureFormatR8Sint+  | TextureFormatR16Uint+  | TextureFormatR16Sint+  | TextureFormatR16Float+  | TextureFormatRG8Unorm+  | TextureFormatRG8Snorm+  | TextureFormatRG8Uint+  | TextureFormatRG8Sint+  | TextureFormatR32Float+  | TextureFormatR32Uint+  | TextureFormatR32Sint+  | TextureFormatRG16Uint+  | TextureFormatRG16Sint+  | TextureFormatRG16Float+  | TextureFormatRGBA8Unorm+  | TextureFormatRGBA8UnormSrgb+  | TextureFormatRGBA8Snorm+  | TextureFormatRGBA8Uint+  | TextureFormatRGBA8Sint+  | TextureFormatBGRA8Unorm+  | TextureFormatBGRA8UnormSrgb+  | TextureFormatRGB10A2Unorm+  | TextureFormatRG11B10Ufloat+  | TextureFormatRGB9E5Ufloat+  | TextureFormatRG32Float+  | TextureFormatRG32Uint+  | TextureFormatRG32Sint+  | TextureFormatRGBA16Uint+  | TextureFormatRGBA16Sint+  | TextureFormatRGBA16Float+  | TextureFormatRGBA32Float+  | TextureFormatRGBA32Uint+  | TextureFormatRGBA32Sint+  | TextureFormatDepth32Float+  | TextureFormatDepth24Plus+  | TextureFormatDepth24PlusStencil8+  | TextureFormatStencil8+  | TextureFormatBC1RGBAUnorm+  | TextureFormatBC1RGBAUnormSrgb+  | TextureFormatBC2RGBAUnorm+  | TextureFormatBC2RGBAUnormSrgb+  | TextureFormatBC3RGBAUnorm+  | TextureFormatBC3RGBAUnormSrgb+  | TextureFormatBC4RUnorm+  | TextureFormatBC4RSnorm+  | TextureFormatBC5RGUnorm+  | TextureFormatBC5RGSnorm+  | TextureFormatBC6HRGBUfloat+  | TextureFormatBC6HRGBFloat+  | TextureFormatBC7RGBAUnorm+  | TextureFormatBC7RGBAUnormSrgb+  deriving (Eq, Show)++instance ToRaw TextureFormat WGPUTextureFormat where+  raw tf =+    pure $+      case tf of+        TextureFormatR8Unorm -> WGPUTextureFormat.R8Unorm+        TextureFormatR8Snorm -> WGPUTextureFormat.R8Snorm+        TextureFormatR8Uint -> WGPUTextureFormat.R8Uint+        TextureFormatR8Sint -> WGPUTextureFormat.R8Sint+        TextureFormatR16Uint -> WGPUTextureFormat.R16Uint+        TextureFormatR16Sint -> WGPUTextureFormat.R16Sint+        TextureFormatR16Float -> WGPUTextureFormat.R16Float+        TextureFormatRG8Unorm -> WGPUTextureFormat.RG8Unorm+        TextureFormatRG8Snorm -> WGPUTextureFormat.RG8Snorm+        TextureFormatRG8Uint -> WGPUTextureFormat.RG8Uint+        TextureFormatRG8Sint -> WGPUTextureFormat.RG8Sint+        TextureFormatR32Float -> WGPUTextureFormat.R32Float+        TextureFormatR32Uint -> WGPUTextureFormat.R32Uint+        TextureFormatR32Sint -> WGPUTextureFormat.R32Sint+        TextureFormatRG16Uint -> WGPUTextureFormat.RG16Uint+        TextureFormatRG16Sint -> WGPUTextureFormat.RG16Sint+        TextureFormatRG16Float -> WGPUTextureFormat.RG16Float+        TextureFormatRGBA8Unorm -> WGPUTextureFormat.RGBA8Unorm+        TextureFormatRGBA8UnormSrgb -> WGPUTextureFormat.RGBA8UnormSrgb+        TextureFormatRGBA8Snorm -> WGPUTextureFormat.RGBA8Snorm+        TextureFormatRGBA8Uint -> WGPUTextureFormat.RGBA8Uint+        TextureFormatRGBA8Sint -> WGPUTextureFormat.RGBA8Sint+        TextureFormatBGRA8Unorm -> WGPUTextureFormat.BGRA8Unorm+        TextureFormatBGRA8UnormSrgb -> WGPUTextureFormat.BGRA8UnormSrgb+        TextureFormatRGB10A2Unorm -> WGPUTextureFormat.RGB10A2Unorm+        TextureFormatRG11B10Ufloat -> WGPUTextureFormat.RG11B10Ufloat+        TextureFormatRGB9E5Ufloat -> WGPUTextureFormat.RGB9E5Ufloat+        TextureFormatRG32Float -> WGPUTextureFormat.RG32Float+        TextureFormatRG32Uint -> WGPUTextureFormat.RG32Uint+        TextureFormatRG32Sint -> WGPUTextureFormat.RG32Sint+        TextureFormatRGBA16Uint -> WGPUTextureFormat.RGBA16Uint+        TextureFormatRGBA16Sint -> WGPUTextureFormat.RGBA16Sint+        TextureFormatRGBA16Float -> WGPUTextureFormat.RGBA16Float+        TextureFormatRGBA32Float -> WGPUTextureFormat.RGBA32Float+        TextureFormatRGBA32Uint -> WGPUTextureFormat.RGBA32Uint+        TextureFormatRGBA32Sint -> WGPUTextureFormat.RGBA32Sint+        TextureFormatDepth32Float -> WGPUTextureFormat.Depth32Float+        TextureFormatDepth24Plus -> WGPUTextureFormat.Depth24Plus+        TextureFormatDepth24PlusStencil8 ->+          WGPUTextureFormat.Depth24PlusStencil8+        TextureFormatStencil8 -> WGPUTextureFormat.Stencil8+        TextureFormatBC1RGBAUnorm -> WGPUTextureFormat.BC1RGBAUnorm+        TextureFormatBC1RGBAUnormSrgb -> WGPUTextureFormat.BC1RGBAUnormSrgb+        TextureFormatBC2RGBAUnorm -> WGPUTextureFormat.BC2RGBAUnorm+        TextureFormatBC2RGBAUnormSrgb -> WGPUTextureFormat.BC2RGBAUnormSrgb+        TextureFormatBC3RGBAUnorm -> WGPUTextureFormat.BC3RGBAUnorm+        TextureFormatBC3RGBAUnormSrgb -> WGPUTextureFormat.BC3RGBAUnormSrgb+        TextureFormatBC4RUnorm -> WGPUTextureFormat.BC4RUnorm+        TextureFormatBC4RSnorm -> WGPUTextureFormat.BC4RSnorm+        TextureFormatBC5RGUnorm -> WGPUTextureFormat.BC5RGUnorm+        TextureFormatBC5RGSnorm -> WGPUTextureFormat.BC5RGSnorm+        TextureFormatBC6HRGBUfloat -> WGPUTextureFormat.BC6HRGBUfloat+        TextureFormatBC6HRGBFloat -> WGPUTextureFormat.BC6HRGBFloat+        TextureFormatBC7RGBAUnorm -> WGPUTextureFormat.BC7RGBAUnorm+        TextureFormatBC7RGBAUnormSrgb -> WGPUTextureFormat.BC7RGBAUnormSrgb++textureFormatFromRaw :: WGPUTextureFormat -> TextureFormat+textureFormatFromRaw rt =+  case rt of+    WGPUTextureFormat.R8Unorm -> TextureFormatR8Unorm+    WGPUTextureFormat.R8Snorm -> TextureFormatR8Snorm+    WGPUTextureFormat.R8Uint -> TextureFormatR8Uint+    WGPUTextureFormat.R8Sint -> TextureFormatR8Sint+    WGPUTextureFormat.R16Uint -> TextureFormatR16Uint+    WGPUTextureFormat.R16Sint -> TextureFormatR16Sint+    WGPUTextureFormat.R16Float -> TextureFormatR16Float+    WGPUTextureFormat.RG8Unorm -> TextureFormatRG8Unorm+    WGPUTextureFormat.RG8Snorm -> TextureFormatRG8Snorm+    WGPUTextureFormat.RG8Uint -> TextureFormatRG8Uint+    WGPUTextureFormat.RG8Sint -> TextureFormatRG8Sint+    WGPUTextureFormat.R32Float -> TextureFormatR32Float+    WGPUTextureFormat.R32Uint -> TextureFormatR32Uint+    WGPUTextureFormat.R32Sint -> TextureFormatR32Sint+    WGPUTextureFormat.RG16Uint -> TextureFormatRG16Uint+    WGPUTextureFormat.RG16Sint -> TextureFormatRG16Sint+    WGPUTextureFormat.RG16Float -> TextureFormatRG16Float+    WGPUTextureFormat.RGBA8Unorm -> TextureFormatRGBA8Unorm+    WGPUTextureFormat.RGBA8UnormSrgb -> TextureFormatRGBA8UnormSrgb+    WGPUTextureFormat.RGBA8Snorm -> TextureFormatRGBA8Snorm+    WGPUTextureFormat.RGBA8Uint -> TextureFormatRGBA8Uint+    WGPUTextureFormat.RGBA8Sint -> TextureFormatRGBA8Sint+    WGPUTextureFormat.BGRA8Unorm -> TextureFormatBGRA8Unorm+    WGPUTextureFormat.BGRA8UnormSrgb -> TextureFormatBGRA8UnormSrgb+    WGPUTextureFormat.RGB10A2Unorm -> TextureFormatRGB10A2Unorm+    WGPUTextureFormat.RG11B10Ufloat -> TextureFormatRG11B10Ufloat+    WGPUTextureFormat.RGB9E5Ufloat -> TextureFormatRGB9E5Ufloat+    WGPUTextureFormat.RG32Float -> TextureFormatRG32Float+    WGPUTextureFormat.RG32Uint -> TextureFormatRG32Uint+    WGPUTextureFormat.RG32Sint -> TextureFormatRG32Sint+    WGPUTextureFormat.RGBA16Uint -> TextureFormatRGBA16Uint+    WGPUTextureFormat.RGBA16Sint -> TextureFormatRGBA16Sint+    WGPUTextureFormat.RGBA16Float -> TextureFormatRGBA16Float+    WGPUTextureFormat.RGBA32Float -> TextureFormatRGBA32Float+    WGPUTextureFormat.RGBA32Uint -> TextureFormatRGBA32Uint+    WGPUTextureFormat.RGBA32Sint -> TextureFormatRGBA32Sint+    WGPUTextureFormat.Depth32Float -> TextureFormatDepth32Float+    WGPUTextureFormat.Depth24Plus -> TextureFormatDepth24Plus+    WGPUTextureFormat.Depth24PlusStencil8 -> TextureFormatDepth24PlusStencil8+    WGPUTextureFormat.Stencil8 -> TextureFormatStencil8+    WGPUTextureFormat.BC1RGBAUnorm -> TextureFormatBC1RGBAUnorm+    WGPUTextureFormat.BC1RGBAUnormSrgb -> TextureFormatBC1RGBAUnormSrgb+    WGPUTextureFormat.BC2RGBAUnorm -> TextureFormatBC2RGBAUnorm+    WGPUTextureFormat.BC2RGBAUnormSrgb -> TextureFormatBC2RGBAUnormSrgb+    WGPUTextureFormat.BC3RGBAUnorm -> TextureFormatBC3RGBAUnorm+    WGPUTextureFormat.BC3RGBAUnormSrgb -> TextureFormatBC3RGBAUnormSrgb+    WGPUTextureFormat.BC4RUnorm -> TextureFormatBC4RUnorm+    WGPUTextureFormat.BC4RSnorm -> TextureFormatBC4RSnorm+    WGPUTextureFormat.BC5RGUnorm -> TextureFormatBC5RGUnorm+    WGPUTextureFormat.BC5RGSnorm -> TextureFormatBC5RGSnorm+    WGPUTextureFormat.BC6HRGBUfloat -> TextureFormatBC6HRGBUfloat+    WGPUTextureFormat.BC6HRGBFloat -> TextureFormatBC6HRGBFloat+    WGPUTextureFormat.BC7RGBAUnorm -> TextureFormatBC7RGBAUnorm+    WGPUTextureFormat.BC7RGBAUnormSrgb -> TextureFormatBC7RGBAUnormSrgb+    _ -> error $ "Unexpected WGPUTextureFormat" <> show rt
+ src/WGPU.hs view
@@ -0,0 +1,344 @@+-- |+-- Module      : WGPU+-- Description : WebGPU Native+-- License     : BSD-3-Clause+-- Copyright   : Copyright (C) Jonathan Merritt 2021+-- Maintainer  : Jonathan Merritt <j.s.merritt@gmail.com>+-- Stability   : experimental+-- Portability : macOS+--+-- Layout of this module should be guided by the evolving+-- <https://www.w3.org/TR/webgpu/ WebGPU Specification>.+module WGPU+  ( -- ** Introduction+    -- $introduction++    -- * Initialization #initialization#+    -- $initialization+    Instance,+    withInstance,++    -- * Surface #surface#+    -- $surface+    Surface,+    createGLFWSurface,++    -- * Adapter #adapter#+    -- $adapter+    Adapter,+    requestAdapter,++    -- * Device #device#+    -- $device+    Device,+    DeviceDescriptor (..),+    Limits (..),+    Features (..),+    requestDevice,++    -- * Textures and Views+    TextureView,+    TextureViewDimension (..),+    TextureFormat (..),+    TextureUsage (..),++    -- * Swapchain+    SwapChain,+    SwapChainDescriptor (..),+    PresentMode (..),+    getSwapChainPreferredFormat,+    createSwapChain,+    getSwapChainCurrentTextureView,+    swapChainPresent,++    -- * Samplers++    -- * Resource Binding+    BindGroupLayout,+    BindGroupLayoutDescriptor (..),+    BindGroupLayoutEntry (..),+    Binding (..),+    ShaderStage (..),+    BindingType (..),+    BufferBindingLayout (..),+    SamplerBindingLayout (..),+    TextureBindingLayout (..),+    StorageTextureBindingLayout (..),+    StorageTextureAccess (..),+    TextureSampleType (..),+    BufferBindingType (..),+    createBindGroupLayout,++    -- * Shader Modules+    ShaderModule,+    ShaderModuleDescriptor (..),+    ShaderSource (..),+    SPIRV (..),+    WGSL (..),+    ShaderEntryPoint (..),+    createShaderModule,+    createShaderModuleSPIRV,+    createShaderModuleWGSL,++    -- * Pipelines++    -- ** Compute++    -- ** Render+    PipelineLayout,+    RenderPipeline,+    PipelineLayoutDescriptor (..),+    RenderPipelineDescriptor (..),+    VertexFormat (..),+    VertexAttribute (..),+    InputStepMode (..),+    VertexBufferLayout (..),+    VertexState (..),+    PrimitiveTopology (..),+    IndexFormat (..),+    FrontFace (..),+    CullMode (..),+    PrimitiveState (..),+    StencilOperation (..),+    StencilState (..),+    DepthBiasState (..),+    DepthStencilState (..),+    MultisampleState (..),+    BlendFactor (..),+    BlendOperation (..),+    BlendComponent (..),+    BlendState (..),+    ColorWriteMask (..),+    ColorTargetState (..),+    FragmentState (..),+    createPipelineLayout,+    createRenderPipeline,+    colorWriteMaskAll,++    -- * Command Buffers+    CommandBuffer,++    -- * Command Encoding+    CommandEncoder,+    RenderPassEncoder,+    Color (..),+    LoadOp (..),+    StoreOp (..),+    Operations (..),+    RenderPassColorAttachment (..),+    RenderPassDepthStencilAttachment (..),+    RenderPassDescriptor (..),+    Range (..),+    createCommandEncoder,+    commandEncoderFinish,+    beginRenderPass,+    renderPassSetPipeline,+    renderPassDraw,+    endRenderPass,++    -- * Queue+    Queue,+    getQueue,+    queueSubmit,++    -- * Version+    Version (..),+    getVersion,+    versionToText,++    -- * Logging+    LogLevel (..),+    LogCallback,+    setLogLevel,+    logStdout,+    logLevelToText,++    -- * Multipurpose+    CompareFunction (..),++    -- * Extras++    -- ** Strict Maybe+    SMaybe (..),+  )+where++import WGPU.Internal.Adapter+import WGPU.Internal.Binding+import WGPU.Internal.Color+import WGPU.Internal.CommandBuffer+import WGPU.Internal.CommandEncoder+import WGPU.Internal.Device+import WGPU.Internal.Instance+import WGPU.Internal.Multipurpose+import WGPU.Internal.Pipeline+import WGPU.Internal.Queue+import WGPU.Internal.RenderPass+import WGPU.Internal.SMaybe+import WGPU.Internal.Shader+import WGPU.Internal.Surface+import WGPU.Internal.SwapChain+import WGPU.Internal.Texture++-------------------------------------------------------------------------------++-- $introduction+--+-- === Introduction to WebGPU+--+-- WebGPU is a future web standard for graphics and compute, developed by the+-- W3C. It is currently (August 2021) an emerging technology, and not yet+-- stable. In addition to its <https://www.w3.org/TR/webgpu/ JavaScript API>,+-- 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://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.+--+-- 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+-- available across platforms, but it is very low-level. In the opinion of the+-- author of this package, Vulkan is very difficult to use directly from+-- Haskell. It would benefit greatly from a shim layer which performs common+-- tasks and streamlines many operations. Not unexpectedly, that is exactly the+-- role that WebGPU native can play.+--+-- === Platform Support+--+-- Currently, only macOS (with the Metal backend) is supported. The limitation+-- is not fundamental and only exists because, so far, only macOS surface+-- creation has been implemented. In the future, other backends should be added.+--+-- === Dependence on GLFW-b+--+-- This package currently uses only+-- <https://hackage.haskell.org/package/GLFW-b GLFW-b>+-- for windowing and event processing. Clearly, it is undesirable to be+-- tied to only a single library for this purpose, when options like+-- <https://hackage.haskell.org/package/sdl2 sdl2> are available and might be+-- preferred by many users.+--+-- GFLW is used because it is the windowing library used in the C examples from+-- @wgpu-native@ and it exposes an API to obtain a pointer to the underlying+-- windowing system's native window. In the future, other options will be+-- investigated as time permits.+--+-- === Structure of Bindings+--+-- The bindings to @wgpu-native@ are structured in three packages:+--+--   1. The @wgpu-raw-hs-codegen@ package is a code generator for the raw+--      bindings. It creates all the packages named @WGPU.Raw.Generated.*@+--      (without exception!), using a custom code generator based on+--      `langage-c`. This package is not in Hackage, since it is only used+--      offline.+--+--   2. The <https://hackage.haskell.org/package/wgpu-raw-hs wgpu-raw-hs>+--      package provides raw bindings to @wgpu-native@. These raw bindings are+--      mostly auto-generated, but have some manual curation of top-level types+--      and function aliases. They are "raw" in the sense that they contain raw+--      pointers and are not usable without manual management of memory to+--      construct all the C structs that must be passed to the API.+--+--   3. The @wgpu-hs@ package (this one) provides high-level bindings. These+--      bindings are written manually. They are improvements on the raw+--      bindings in the following ways:+--+--       - There are no more raw @Ptr@ types. Memory for structs passed to the+--         raw API is managed using a type class (@ToRaw@) that encapsulates a+--         mapping between high-level API types and raw types. The possibility+--         to allocate memory as part of this conversion (and later free it) is+--         achieved by embedding conversion to the raw types inside the @ContT@+--         continuation monad.+--+--       - There are no callbacks. Several WebGPU native calls use callbacks to+--         indicate completion rather than blocking. The author decided that, in+--         the Haskell context, blocking was probably preferable. So,+--         internally, these calls are converted into a blocking form by waiting+--         on @MVar@s that are set by the callbacks.+--+--       - Several parts of the API are tweaked slightly to more closely+--         resemble the Rust API. This is done in cases where, for example, a+--         parameter to the C API is unused except in one branch of a sum type.+--         When this can be done easily enough, it is preferred to using the+--         flattened "union" approach.+--+--       - Names are de-duplicated. Where possible, names are identical to the C+--         API (sometimes with prefixes removed). However, where name conflicts+--         exist, names are changed to somewhat-idiomatic Haskell variants.+--+-- === Native Library Handling+--+-- The native library for @wgpu-native@ is not required at compile-time for this+-- package. Indeed, other packages containing executables that depend on this+-- one can be compiled without the native library! Instead, the library is+-- loaded dynamically and its symbols bound at runtime. This has the benefit+-- that the Haskell tooling need not be concerned with handling a Rust library+-- (yay!), but it is a point of common failure at runtime. To achieve this+-- independence, the header files for @wgpu-native@ are packaged inside+-- @wgpu-raw-hs@. Of course, care should be taken to ensure that a+-- fully-compatible version of the library is used at runtime.++-------------------------------------------------------------------------------++-- $initialization+--+-- The first step in using these Haskell bindings is to obtain an 'Instance'.+-- This acts as a handle to the rest of the API. An 'Instance' is obtained at+-- runtime by loading a dynamic library containing the WGPU binding symbols.+-- Currently, only the C\/Rust library from+-- <https://github.com/gfx-rs/wgpu-native wgpu-native> is supported.+--+-- To load the dynamic library and obtain an instance, use the+-- 'withInstance' bracketing function:+--+-- @+-- 'withInstance' "libwgpu_native.dylib" (Just 'logStdout') $ \inst -> do+--   -- set the logging level (optional)+--   'setLogLevel' inst 'Warn'+--   -- run the rest of the program...+-- @+--+-- After creating an 'Instance', you may next want to+-- <WGPU.html#g:surface create a surface>.++-------------------------------------------------------------------------------++-- $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.+--+-- Once you have a 'Surface', the next step is usually to+-- <WGPU.html#g:adapter request an adapter> that is compatible with it.++-------------------------------------------------------------------------------++-- $adapter+--+-- An 'Adapter' is a handle to a physical device. For example, a physical+-- display adaptor (GPU) or a software renderer. Currently you obtain an adapter+-- using 'requestAdapter', which requests an adapter that is compatible with an+-- existing 'Surface'.+--+-- After obtaining an adapter, you will typically want to+-- <WGPU.html#g:device request a device>.++-------------------------------------------------------------------------------++-- $device+--+-- A 'Device' is an open connection to a graphics and/or compute device. A+-- 'Device' is created using the 'requestDevice' function.+--+-- (According to the WebGPU API documentation, a 'Device' may also be "lost".+-- However, it's not yet clear how that event will be signalled to the C API,+-- nor how to handle it.)
+ wgpu-hs.cabal view
@@ -0,0 +1,91 @@+cabal-version:      3.0+name:               wgpu-hs+version:            0.1.0.0+synopsis:           WGPU+description:        A high-level binding to WGPU.+bug-reports:        https://github.com/lancelet/wgpu-hs/issues+license:            BSD-3-Clause+author:             Jonathan Merritt+maintainer:         j.s.merritt@gmail.com+copyright:          Copyright (C) Jonathan Merritt, 2021+category:           Graphics+extra-source-files: CHANGELOG.md++flag examples+  description: Build the examples+  default:     True+  manual:      True++common base+  default-language: Haskell2010+  build-depends:    base ^>=4.14.0.0++common ghc-options+  ghc-options:+    -Wall -Wcompat -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wredundant-constraints++library wgpu-hs-internal+  import:          base, ghc-options+  hs-source-dirs:  src-internal+  exposed-modules:+    WGPU.Internal.Adapter+    WGPU.Internal.Binding+    WGPU.Internal.ChainedStruct+    WGPU.Internal.Color+    WGPU.Internal.CommandBuffer+    WGPU.Internal.CommandEncoder+    WGPU.Internal.Device+    WGPU.Internal.Instance+    WGPU.Internal.Memory+    WGPU.Internal.Multipurpose+    WGPU.Internal.Pipeline+    WGPU.Internal.Queue+    WGPU.Internal.RenderPass+    WGPU.Internal.Sampler+    WGPU.Internal.Shader+    WGPU.Internal.SMaybe+    WGPU.Internal.Surface+    WGPU.Internal.SwapChain+    WGPU.Internal.Texture++  build-depends:+    , bytestring+    , data-default+    , GLFW-b+    , text+    , transformers+    , vector+    , wgpu-raw-hs++library+  import:          base, ghc-options+  hs-source-dirs:  src+  build-depends:+    , bytestring        ^>=0.10.12+    , data-default      ^>=0.7.1.1+    , GLFW-b            ^>=3.3.0+    , text              ^>=1.2.4+    , transformers      ^>=0.5.6+    , vector            ^>=0.12.3+    , wgpu-hs-internal+    , wgpu-raw-hs       ==0.1.0.3++  exposed-modules: WGPU++executable triangle+  import:         base, ghc-options++  if flag(examples)+    build-depends:+      , data-default  ^>=0.7.1.1+      , GLFW-b        ^>=3.3.0+      , text          ^>=1.2.4+      , transformers  ^>=0.5.6+      , wgpu-hs++  else+    buildable: False++  hs-source-dirs: examples/triangle+  main-is:        Main.hs