{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : WGPU.Classy
-- Description : Get parameters from readers.
--
-- WGPU commands commonly take parameters such as the 'Instance', 'Device', etc,
-- which are relatively unchanged across multiple commands. This module provides
-- a way to supply those parameters from a 'MonadReader'. Useful for the truly
-- lazy among us.
module WGPU.Classy
  ( -- * Constraints
    HasInstance,
    HasSurface,
    HasAdapter,
    HasDevice,
    HasSwapChain,
    HasCommandEncoder,
    HasRenderPassEncoder,
    HasQueue,

    -- * Classes

    -- * Lifted Functions

    -- ** Adapter
    requestAdapter,
    getAdapterProperties,

    -- ** Device
    requestDevice,

    -- ** Buffer
    createBuffer,
    createBufferInit,

    -- ** Texture
    createTexture,
    createView,

    -- ** Swapchain
    getSwapChainPreferredFormat,
    createSwapChain,
    getSwapChainCurrentTextureView,
    swapChainPresent,

    -- ** Samplers
    createSampler,

    -- ** Resource Binding
    createBindGroup,
    createBindGroupLayout,

    -- ** Shader Modules
    createShaderModule,
    createShaderModuleSPIRV,
    createShaderModuleWGSL,

    -- ** Pipelines

    -- *** Render
    createPipelineLayout,
    createRenderPipeline,

    -- ** Command Encoding
    createCommandEncoder,
    commandEncoderFinish,
    beginRenderPass,
    renderPassSetPipeline,
    renderPassDraw,
    renderPassSetBindGroup,
    renderPassSetIndexBuffer,
    renderPassSetVertexBuffer,
    renderPassDrawIndexed,
    endRenderPass,

    -- ** Queue
    getQueue,
    queueSubmit,
    queueSubmit',
    queueWriteTexture,
    queueWriteBuffer,

    -- ** Version
    getVersion,

    -- ** Logging
    connectLog,
    disconnectLog,
    setLogLevel,

    -- * Reader Contexts
    addEnv,

    -- * Building

    -- ** Command Encoding
    buildCommandBuffer,
    buildRenderPass,
  )
where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)
import Data.Has (Has, getter)
import Data.Int (Int32)
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Word (Word32, Word64)
import WGPU
  ( Adapter,
    AdapterProperties,
    BindGroup,
    BindGroupDescriptor,
    BindGroupLayout,
    BindGroupLayoutDescriptor,
    Buffer,
    BufferDescriptor,
    BufferUsage,
    CommandBuffer,
    CommandEncoder,
    Device,
    DeviceDescriptor,
    Extent3D,
    ImageCopyTexture,
    IndexFormat,
    Instance,
    LogLevel,
    PipelineLayout,
    PipelineLayoutDescriptor,
    Queue,
    Range,
    ReadableMemoryBuffer,
    RenderPassDescriptor,
    RenderPassEncoder,
    RenderPipeline,
    RenderPipelineDescriptor,
    SPIRV,
    Sampler,
    SamplerDescriptor,
    ShaderModule,
    ShaderModuleDescriptor,
    Surface,
    SwapChain,
    SwapChainDescriptor,
    Texture,
    TextureDataLayout,
    TextureDescriptor,
    TextureFormat,
    TextureView,
    TextureViewDescriptor,
    Version,
    WGSL,
  )
import qualified WGPU

-------------------------------------------------------------------------------
-- Constraint Synonyms

type RIO r m = (MonadIO m, MonadReader r m)

type HasInstance r m = (RIO r m, Has Instance r)

type HasSurface r m = (RIO r m, Has Surface r)

type HasAdapter r m = (RIO r m, Has Adapter r)

type HasDevice r m = (RIO r m, Has Device r)

type HasTexture r m = (RIO r m, Has Texture r)

type HasSwapChain r m = (RIO r m, Has SwapChain r)

type HasCommandEncoder r m = (RIO r m, Has CommandEncoder r)

type HasRenderPassEncoder r m = (RIO r m, Has RenderPassEncoder r)

type HasQueue r m = (RIO r m, Has Queue r)

access :: (Has q r, MonadReader r m) => (q -> m a) -> m a
access :: (q -> m a) -> m a
access q -> m a
action = (r -> q) -> m q
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> q
forall a t. Has a t => t -> a
getter m q -> (q -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= q -> m a
action
{-# INLINEABLE access #-}

access2 :: (Has q r, MonadReader r m) => (q -> b -> m a) -> b -> m a
access2 :: (q -> b -> m a) -> b -> m a
access2 q -> b -> m a
action b
y = (r -> q) -> m q
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> q
forall a t. Has a t => t -> a
getter m q -> (q -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
x -> q -> b -> m a
action q
x b
y
{-# INLINEABLE access2 #-}

access3 :: (Has q r, MonadReader r m) => (q -> b -> c -> m a) -> b -> c -> m a
access3 :: (q -> b -> c -> m a) -> b -> c -> m a
access3 q -> b -> c -> m a
action b
y c
z = (r -> q) -> m q
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> q
forall a t. Has a t => t -> a
getter m q -> (q -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
x -> q -> b -> c -> m a
action q
x b
y c
z
{-# INLINEABLE access3 #-}

access4 ::
  (Has q r, MonadReader r m) =>
  (q -> b -> c -> d -> m a) ->
  b ->
  c ->
  d ->
  m a
access4 :: (q -> b -> c -> d -> m a) -> b -> c -> d -> m a
access4 q -> b -> c -> d -> m a
action b
x c
y d
z = (r -> q) -> m q
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> q
forall a t. Has a t => t -> a
getter m q -> (q -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
w -> q -> b -> c -> d -> m a
action q
w b
x c
y d
z
{-# INLINEABLE access4 #-}

access5 ::
  (Has q r, MonadReader r m) =>
  (q -> b -> c -> d -> e -> m a) ->
  b ->
  c ->
  d ->
  e ->
  m a
access5 :: (q -> b -> c -> d -> e -> m a) -> b -> c -> d -> e -> m a
access5 q -> b -> c -> d -> e -> m a
action b
w c
x d
y e
z = (r -> q) -> m q
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> q
forall a t. Has a t => t -> a
getter m q -> (q -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
v -> q -> b -> c -> d -> e -> m a
action q
v b
w c
x d
y e
z
{-# INLINEABLE access5 #-}

-------------------------------------------------------------------------------
-- Adapter

requestAdapter :: HasSurface r m => m (Maybe Adapter)
requestAdapter :: m (Maybe Adapter)
requestAdapter = (Surface -> m (Maybe Adapter)) -> m (Maybe Adapter)
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access Surface -> m (Maybe Adapter)
forall (m :: * -> *). MonadIO m => Surface -> m (Maybe Adapter)
WGPU.requestAdapter
{-# INLINEABLE requestAdapter #-}

getAdapterProperties :: HasAdapter r m => m AdapterProperties
getAdapterProperties :: m AdapterProperties
getAdapterProperties = (Adapter -> m AdapterProperties) -> m AdapterProperties
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access Adapter -> m AdapterProperties
forall (m :: * -> *). MonadIO m => Adapter -> m AdapterProperties
WGPU.getAdapterProperties
{-# INLINEABLE getAdapterProperties #-}

-------------------------------------------------------------------------------
-- Device

requestDevice :: HasAdapter r m => DeviceDescriptor -> m (Maybe Device)
requestDevice :: DeviceDescriptor -> m (Maybe Device)
requestDevice = (Adapter -> DeviceDescriptor -> m (Maybe Device))
-> DeviceDescriptor -> m (Maybe Device)
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Adapter -> DeviceDescriptor -> m (Maybe Device)
forall (m :: * -> *).
MonadIO m =>
Adapter -> DeviceDescriptor -> m (Maybe Device)
WGPU.requestDevice
{-# INLINEABLE requestDevice #-}

-------------------------------------------------------------------------------
-- Buffer

createBuffer :: HasDevice r m => BufferDescriptor -> m Buffer
createBuffer :: BufferDescriptor -> m Buffer
createBuffer = (Device -> BufferDescriptor -> m Buffer)
-> BufferDescriptor -> m Buffer
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> BufferDescriptor -> m Buffer
forall (m :: * -> *).
MonadIO m =>
Device -> BufferDescriptor -> m Buffer
WGPU.createBuffer
{-# INLINEABLE createBuffer #-}

createBufferInit ::
  (HasDevice r m, ReadableMemoryBuffer a) =>
  Text ->
  BufferUsage ->
  a ->
  m Buffer
createBufferInit :: Text -> BufferUsage -> a -> m Buffer
createBufferInit = (Device -> Text -> BufferUsage -> a -> m Buffer)
-> Text -> BufferUsage -> a -> m Buffer
forall q r (m :: * -> *) b c d a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> d -> m a) -> b -> c -> d -> m a
access4 Device -> Text -> BufferUsage -> a -> m Buffer
forall a (m :: * -> *).
(MonadIO m, ReadableMemoryBuffer a) =>
Device -> Text -> BufferUsage -> a -> m Buffer
WGPU.createBufferInit
{-# INLINEABLE createBufferInit #-}

-------------------------------------------------------------------------------
-- Texture

createTexture :: HasDevice r m => TextureDescriptor -> m Texture
createTexture :: TextureDescriptor -> m Texture
createTexture = (Device -> TextureDescriptor -> m Texture)
-> TextureDescriptor -> m Texture
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> TextureDescriptor -> m Texture
forall (m :: * -> *).
MonadIO m =>
Device -> TextureDescriptor -> m Texture
WGPU.createTexture
{-# INLINEABLE createTexture #-}

createView :: HasTexture r m => TextureViewDescriptor -> m TextureView
createView :: TextureViewDescriptor -> m TextureView
createView = (Texture -> TextureViewDescriptor -> m TextureView)
-> TextureViewDescriptor -> m TextureView
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Texture -> TextureViewDescriptor -> m TextureView
forall (m :: * -> *).
MonadIO m =>
Texture -> TextureViewDescriptor -> m TextureView
WGPU.createView
{-# INLINEABLE createView #-}

-------------------------------------------------------------------------------
-- Swapchain

getSwapChainPreferredFormat ::
  (HasSurface r m, HasAdapter r m) =>
  m TextureFormat
getSwapChainPreferredFormat :: m TextureFormat
getSwapChainPreferredFormat =
  (Adapter -> m TextureFormat) -> m TextureFormat
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access ((Adapter -> m TextureFormat) -> m TextureFormat)
-> ((Surface -> Adapter -> m TextureFormat)
    -> Adapter -> m TextureFormat)
-> (Surface -> Adapter -> m TextureFormat)
-> m TextureFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Surface -> Adapter -> m TextureFormat)
-> Adapter -> m TextureFormat
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 ((Surface -> Adapter -> m TextureFormat) -> m TextureFormat)
-> (Surface -> Adapter -> m TextureFormat) -> m TextureFormat
forall a b. (a -> b) -> a -> b
$ Surface -> Adapter -> m TextureFormat
forall (m :: * -> *).
MonadIO m =>
Surface -> Adapter -> m TextureFormat
WGPU.getSwapChainPreferredFormat
{-# INLINEABLE getSwapChainPreferredFormat #-}

createSwapChain ::
  (HasDevice r m, HasSurface r m) =>
  SwapChainDescriptor ->
  m SwapChain
createSwapChain :: SwapChainDescriptor -> m SwapChain
createSwapChain = (Surface -> SwapChainDescriptor -> m SwapChain)
-> SwapChainDescriptor -> m SwapChain
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 ((Surface -> SwapChainDescriptor -> m SwapChain)
 -> SwapChainDescriptor -> m SwapChain)
-> ((Device -> Surface -> SwapChainDescriptor -> m SwapChain)
    -> Surface -> SwapChainDescriptor -> m SwapChain)
-> (Device -> Surface -> SwapChainDescriptor -> m SwapChain)
-> SwapChainDescriptor
-> m SwapChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Device -> Surface -> SwapChainDescriptor -> m SwapChain)
-> Surface -> SwapChainDescriptor -> m SwapChain
forall q r (m :: * -> *) b c a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> m a) -> b -> c -> m a
access3 ((Device -> Surface -> SwapChainDescriptor -> m SwapChain)
 -> SwapChainDescriptor -> m SwapChain)
-> (Device -> Surface -> SwapChainDescriptor -> m SwapChain)
-> SwapChainDescriptor
-> m SwapChain
forall a b. (a -> b) -> a -> b
$ Device -> Surface -> SwapChainDescriptor -> m SwapChain
forall (m :: * -> *).
MonadIO m =>
Device -> Surface -> SwapChainDescriptor -> m SwapChain
WGPU.createSwapChain
{-# INLINEABLE createSwapChain #-}

getSwapChainCurrentTextureView :: HasSwapChain r m => m TextureView
getSwapChainCurrentTextureView :: m TextureView
getSwapChainCurrentTextureView = (SwapChain -> m TextureView) -> m TextureView
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access SwapChain -> m TextureView
forall (m :: * -> *). MonadIO m => SwapChain -> m TextureView
WGPU.getSwapChainCurrentTextureView
{-# INLINEABLE getSwapChainCurrentTextureView #-}

swapChainPresent :: HasSwapChain r m => m ()
swapChainPresent :: m ()
swapChainPresent = (SwapChain -> m ()) -> m ()
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access SwapChain -> m ()
forall (m :: * -> *). MonadIO m => SwapChain -> m ()
WGPU.swapChainPresent
{-# INLINEABLE swapChainPresent #-}

-------------------------------------------------------------------------------
-- Samplers

createSampler :: (HasDevice r m) => SamplerDescriptor -> m Sampler
createSampler :: SamplerDescriptor -> m Sampler
createSampler = (Device -> SamplerDescriptor -> m Sampler)
-> SamplerDescriptor -> m Sampler
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> SamplerDescriptor -> m Sampler
forall (m :: * -> *).
MonadIO m =>
Device -> SamplerDescriptor -> m Sampler
WGPU.createSampler
{-# INLINEABLE createSampler #-}

-------------------------------------------------------------------------------
-- Resource Binding

createBindGroup :: HasDevice r m => BindGroupDescriptor -> m BindGroup
createBindGroup :: BindGroupDescriptor -> m BindGroup
createBindGroup = (Device -> BindGroupDescriptor -> m BindGroup)
-> BindGroupDescriptor -> m BindGroup
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> BindGroupDescriptor -> m BindGroup
forall (m :: * -> *).
MonadIO m =>
Device -> BindGroupDescriptor -> m BindGroup
WGPU.createBindGroup
{-# INLINEABLE createBindGroup #-}

createBindGroupLayout ::
  HasDevice r m =>
  BindGroupLayoutDescriptor ->
  m BindGroupLayout
createBindGroupLayout :: BindGroupLayoutDescriptor -> m BindGroupLayout
createBindGroupLayout = (Device -> BindGroupLayoutDescriptor -> m BindGroupLayout)
-> BindGroupLayoutDescriptor -> m BindGroupLayout
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> BindGroupLayoutDescriptor -> m BindGroupLayout
forall (m :: * -> *).
MonadIO m =>
Device -> BindGroupLayoutDescriptor -> m BindGroupLayout
WGPU.createBindGroupLayout
{-# INLINEABLE createBindGroupLayout #-}

-------------------------------------------------------------------------------
-- Shader Modules

createShaderModule :: HasDevice r m => ShaderModuleDescriptor -> m ShaderModule
createShaderModule :: ShaderModuleDescriptor -> m ShaderModule
createShaderModule = (Device -> ShaderModuleDescriptor -> m ShaderModule)
-> ShaderModuleDescriptor -> m ShaderModule
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> ShaderModuleDescriptor -> m ShaderModule
forall (m :: * -> *).
MonadIO m =>
Device -> ShaderModuleDescriptor -> m ShaderModule
WGPU.createShaderModule
{-# INLINEABLE createShaderModule #-}

createShaderModuleSPIRV :: HasDevice r m => Text -> SPIRV -> m ShaderModule
createShaderModuleSPIRV :: Text -> SPIRV -> m ShaderModule
createShaderModuleSPIRV = (Device -> Text -> SPIRV -> m ShaderModule)
-> Text -> SPIRV -> m ShaderModule
forall q r (m :: * -> *) b c a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> m a) -> b -> c -> m a
access3 Device -> Text -> SPIRV -> m ShaderModule
forall (m :: * -> *).
MonadIO m =>
Device -> Text -> SPIRV -> m ShaderModule
WGPU.createShaderModuleSPIRV
{-# INLINEABLE createShaderModuleSPIRV #-}

createShaderModuleWGSL :: HasDevice r m => Text -> WGSL -> m ShaderModule
createShaderModuleWGSL :: Text -> WGSL -> m ShaderModule
createShaderModuleWGSL = (Device -> Text -> WGSL -> m ShaderModule)
-> Text -> WGSL -> m ShaderModule
forall q r (m :: * -> *) b c a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> m a) -> b -> c -> m a
access3 Device -> Text -> WGSL -> m ShaderModule
forall (m :: * -> *).
MonadIO m =>
Device -> Text -> WGSL -> m ShaderModule
WGPU.createShaderModuleWGSL
{-# INLINEABLE createShaderModuleWGSL #-}

-------------------------------------------------------------------------------
-- Render Pipelines

createPipelineLayout ::
  HasDevice r m =>
  PipelineLayoutDescriptor ->
  m PipelineLayout
createPipelineLayout :: PipelineLayoutDescriptor -> m PipelineLayout
createPipelineLayout = (Device -> PipelineLayoutDescriptor -> m PipelineLayout)
-> PipelineLayoutDescriptor -> m PipelineLayout
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> PipelineLayoutDescriptor -> m PipelineLayout
forall (m :: * -> *).
MonadIO m =>
Device -> PipelineLayoutDescriptor -> m PipelineLayout
WGPU.createPipelineLayout
{-# INLINEABLE createPipelineLayout #-}

createRenderPipeline ::
  HasDevice r m =>
  RenderPipelineDescriptor ->
  m RenderPipeline
createRenderPipeline :: RenderPipelineDescriptor -> m RenderPipeline
createRenderPipeline = (Device -> RenderPipelineDescriptor -> m RenderPipeline)
-> RenderPipelineDescriptor -> m RenderPipeline
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> RenderPipelineDescriptor -> m RenderPipeline
forall (m :: * -> *).
MonadIO m =>
Device -> RenderPipelineDescriptor -> m RenderPipeline
WGPU.createRenderPipeline
{-# INLINEABLE createRenderPipeline #-}

-------------------------------------------------------------------------------
-- Command Encoding (Lifted)

createCommandEncoder :: HasDevice r m => Text -> m CommandEncoder
createCommandEncoder :: Text -> m CommandEncoder
createCommandEncoder = (Device -> Text -> m CommandEncoder) -> Text -> m CommandEncoder
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Device -> Text -> m CommandEncoder
forall (m :: * -> *).
MonadIO m =>
Device -> Text -> m CommandEncoder
WGPU.createCommandEncoder
{-# INLINEABLE createCommandEncoder #-}

commandEncoderFinish :: HasCommandEncoder r m => Text -> m CommandBuffer
commandEncoderFinish :: Text -> m CommandBuffer
commandEncoderFinish = (CommandEncoder -> Text -> m CommandBuffer)
-> Text -> m CommandBuffer
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 CommandEncoder -> Text -> m CommandBuffer
forall (m :: * -> *).
MonadIO m =>
CommandEncoder -> Text -> m CommandBuffer
WGPU.commandEncoderFinish
{-# INLINEABLE commandEncoderFinish #-}

beginRenderPass ::
  HasCommandEncoder r m =>
  RenderPassDescriptor ->
  m RenderPassEncoder
beginRenderPass :: RenderPassDescriptor -> m RenderPassEncoder
beginRenderPass = (CommandEncoder -> RenderPassDescriptor -> m RenderPassEncoder)
-> RenderPassDescriptor -> m RenderPassEncoder
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 CommandEncoder -> RenderPassDescriptor -> m RenderPassEncoder
forall (m :: * -> *).
MonadIO m =>
CommandEncoder -> RenderPassDescriptor -> m RenderPassEncoder
WGPU.beginRenderPass
{-# INLINEABLE beginRenderPass #-}

renderPassSetPipeline :: HasRenderPassEncoder r m => RenderPipeline -> m ()
renderPassSetPipeline :: RenderPipeline -> m ()
renderPassSetPipeline = (RenderPassEncoder -> RenderPipeline -> m ())
-> RenderPipeline -> m ()
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 RenderPassEncoder -> RenderPipeline -> m ()
forall (m :: * -> *).
MonadIO m =>
RenderPassEncoder -> RenderPipeline -> m ()
WGPU.renderPassSetPipeline
{-# INLINEABLE renderPassSetPipeline #-}

renderPassDraw ::
  HasRenderPassEncoder r m =>
  Range Word32 ->
  Range Word32 ->
  m ()
renderPassDraw :: Range Word32 -> Range Word32 -> m ()
renderPassDraw = (RenderPassEncoder -> Range Word32 -> Range Word32 -> m ())
-> Range Word32 -> Range Word32 -> m ()
forall q r (m :: * -> *) b c a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> m a) -> b -> c -> m a
access3 RenderPassEncoder -> Range Word32 -> Range Word32 -> m ()
forall (m :: * -> *).
MonadIO m =>
RenderPassEncoder -> Range Word32 -> Range Word32 -> m ()
WGPU.renderPassDraw
{-# INLINEABLE renderPassDraw #-}

renderPassSetBindGroup ::
  HasRenderPassEncoder r m =>
  Word32 ->
  BindGroup ->
  Vector Word32 ->
  m ()
renderPassSetBindGroup :: Word32 -> BindGroup -> Vector Word32 -> m ()
renderPassSetBindGroup = (RenderPassEncoder -> Word32 -> BindGroup -> Vector Word32 -> m ())
-> Word32 -> BindGroup -> Vector Word32 -> m ()
forall q r (m :: * -> *) b c d a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> d -> m a) -> b -> c -> d -> m a
access4 RenderPassEncoder -> Word32 -> BindGroup -> Vector Word32 -> m ()
forall (m :: * -> *).
MonadIO m =>
RenderPassEncoder -> Word32 -> BindGroup -> Vector Word32 -> m ()
WGPU.renderPassSetBindGroup
{-# INLINEABLE renderPassSetBindGroup #-}

renderPassSetIndexBuffer ::
  HasRenderPassEncoder r m =>
  Buffer ->
  IndexFormat ->
  Word64 ->
  Word64 ->
  m ()
renderPassSetIndexBuffer :: Buffer -> IndexFormat -> Word64 -> Word64 -> m ()
renderPassSetIndexBuffer = (RenderPassEncoder
 -> Buffer -> IndexFormat -> Word64 -> Word64 -> m ())
-> Buffer -> IndexFormat -> Word64 -> Word64 -> m ()
forall q r (m :: * -> *) b c d e a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> d -> e -> m a) -> b -> c -> d -> e -> m a
access5 RenderPassEncoder
-> Buffer -> IndexFormat -> Word64 -> Word64 -> m ()
forall (m :: * -> *).
MonadIO m =>
RenderPassEncoder
-> Buffer -> IndexFormat -> Word64 -> Word64 -> m ()
WGPU.renderPassSetIndexBuffer
{-# INLINEABLE renderPassSetIndexBuffer #-}

renderPassSetVertexBuffer ::
  HasRenderPassEncoder r m =>
  Word32 ->
  Buffer ->
  Word64 ->
  Word64 ->
  m ()
renderPassSetVertexBuffer :: Word32 -> Buffer -> Word64 -> Word64 -> m ()
renderPassSetVertexBuffer = (RenderPassEncoder -> Word32 -> Buffer -> Word64 -> Word64 -> m ())
-> Word32 -> Buffer -> Word64 -> Word64 -> m ()
forall q r (m :: * -> *) b c d e a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> d -> e -> m a) -> b -> c -> d -> e -> m a
access5 RenderPassEncoder -> Word32 -> Buffer -> Word64 -> Word64 -> m ()
forall (m :: * -> *).
MonadIO m =>
RenderPassEncoder -> Word32 -> Buffer -> Word64 -> Word64 -> m ()
WGPU.renderPassSetVertexBuffer
{-# INLINEABLE renderPassSetVertexBuffer #-}

renderPassDrawIndexed ::
  HasRenderPassEncoder r m =>
  Range Word32 ->
  Int32 ->
  Range Word32 ->
  m ()
renderPassDrawIndexed :: Range Word32 -> Int32 -> Range Word32 -> m ()
renderPassDrawIndexed = (RenderPassEncoder
 -> Range Word32 -> Int32 -> Range Word32 -> m ())
-> Range Word32 -> Int32 -> Range Word32 -> m ()
forall q r (m :: * -> *) b c d a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> d -> m a) -> b -> c -> d -> m a
access4 RenderPassEncoder -> Range Word32 -> Int32 -> Range Word32 -> m ()
forall (m :: * -> *).
MonadIO m =>
RenderPassEncoder -> Range Word32 -> Int32 -> Range Word32 -> m ()
WGPU.renderPassDrawIndexed
{-# INLINEABLE renderPassDrawIndexed #-}

endRenderPass :: HasRenderPassEncoder r m => m ()
endRenderPass :: m ()
endRenderPass = (RenderPassEncoder -> m ()) -> m ()
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access RenderPassEncoder -> m ()
forall (m :: * -> *). MonadIO m => RenderPassEncoder -> m ()
WGPU.endRenderPass
{-# INLINEABLE endRenderPass #-}

-------------------------------------------------------------------------------
-- Queue

getQueue :: HasDevice r m => m Queue
getQueue :: m Queue
getQueue = (Device -> m Queue) -> m Queue
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access Device -> m Queue
forall (m :: * -> *). MonadIO m => Device -> m Queue
WGPU.getQueue
{-# INLINEABLE getQueue #-}

queueSubmit :: HasQueue r m => Vector CommandBuffer -> m ()
queueSubmit :: Vector CommandBuffer -> m ()
queueSubmit = (Queue -> Vector CommandBuffer -> m ())
-> Vector CommandBuffer -> m ()
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Queue -> Vector CommandBuffer -> m ()
forall (m :: * -> *).
MonadIO m =>
Queue -> Vector CommandBuffer -> m ()
WGPU.queueSubmit
{-# INLINEABLE queueSubmit #-}

-- | Fetch the queue from a device and submit command buffers to it.
queueSubmit' :: HasDevice r m => Vector CommandBuffer -> m ()
queueSubmit' :: Vector CommandBuffer -> m ()
queueSubmit' = ReaderT (Queue, r) m () -> m ()
forall r (m :: * -> *).
HasDevice r m =>
ReaderT (Queue, r) m () -> m ()
buildQueue (ReaderT (Queue, r) m () -> m ())
-> (Vector CommandBuffer -> ReaderT (Queue, r) m ())
-> Vector CommandBuffer
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector CommandBuffer -> ReaderT (Queue, r) m ()
forall r (m :: * -> *).
HasQueue r m =>
Vector CommandBuffer -> m ()
queueSubmit
{-# INLINEABLE queueSubmit' #-}

queueWriteTexture ::
  (HasQueue r m, ReadableMemoryBuffer a) =>
  ImageCopyTexture ->
  TextureDataLayout ->
  Extent3D ->
  a ->
  m ()
queueWriteTexture :: ImageCopyTexture -> TextureDataLayout -> Extent3D -> a -> m ()
queueWriteTexture = (Queue
 -> ImageCopyTexture -> TextureDataLayout -> Extent3D -> a -> m ())
-> ImageCopyTexture -> TextureDataLayout -> Extent3D -> a -> m ()
forall q r (m :: * -> *) b c d e a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> d -> e -> m a) -> b -> c -> d -> e -> m a
access5 Queue
-> ImageCopyTexture -> TextureDataLayout -> Extent3D -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, ReadableMemoryBuffer a) =>
Queue
-> ImageCopyTexture -> TextureDataLayout -> Extent3D -> a -> m ()
WGPU.queueWriteTexture
{-# INLINEABLE queueWriteTexture #-}

queueWriteBuffer ::
  (HasQueue r m, ReadableMemoryBuffer a) =>
  Buffer ->
  a ->
  m ()
queueWriteBuffer :: Buffer -> a -> m ()
queueWriteBuffer = (Queue -> Buffer -> a -> m ()) -> Buffer -> a -> m ()
forall q r (m :: * -> *) b c a.
(Has q r, MonadReader r m) =>
(q -> b -> c -> m a) -> b -> c -> m a
access3 Queue -> Buffer -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, ReadableMemoryBuffer a) =>
Queue -> Buffer -> a -> m ()
WGPU.queueWriteBuffer
{-# INLINEABLE queueWriteBuffer #-}

-------------------------------------------------------------------------------
-- Version

getVersion :: HasInstance r m => m Version
getVersion :: m Version
getVersion = (Instance -> m Version) -> m Version
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access Instance -> m Version
forall (m :: * -> *). MonadIO m => Instance -> m Version
WGPU.getVersion

-------------------------------------------------------------------------------
-- Logging

connectLog :: HasInstance r m => m ()
connectLog :: m ()
connectLog = (Instance -> m ()) -> m ()
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access Instance -> m ()
forall (m :: * -> *). MonadIO m => Instance -> m ()
WGPU.connectLog
{-# INLINEABLE connectLog #-}

disconnectLog :: HasInstance r m => m ()
disconnectLog :: m ()
disconnectLog = (Instance -> m ()) -> m ()
forall q r (m :: * -> *) a.
(Has q r, MonadReader r m) =>
(q -> m a) -> m a
access Instance -> m ()
forall (m :: * -> *). MonadIO m => Instance -> m ()
WGPU.disconnectLog
{-# INLINEABLE disconnectLog #-}

setLogLevel :: HasInstance r m => LogLevel -> m ()
setLogLevel :: LogLevel -> m ()
setLogLevel = (Instance -> LogLevel -> m ()) -> LogLevel -> m ()
forall q r (m :: * -> *) b a.
(Has q r, MonadReader r m) =>
(q -> b -> m a) -> b -> m a
access2 Instance -> LogLevel -> m ()
forall (m :: * -> *). MonadIO m => Instance -> LogLevel -> m ()
WGPU.setLogLevel
{-# INLINEABLE setLogLevel #-}

-------------------------------------------------------------------------------
-- Reader Contexts

-- | Add 'q' into the reader environment.
addEnv :: MonadReader r m => q -> ReaderT (q, r) m a -> m a
addEnv :: q -> ReaderT (q, r) m a -> m a
addEnv q
x ReaderT (q, r) m a
action = m r
forall r (m :: * -> *). MonadReader r m => m r
ask m r -> (r -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r
env -> ReaderT (q, r) m a -> (q, r) -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (q, r) m a
action (q
x, r
env)
{-# INLINEABLE addEnv #-}

-------------------------------------------------------------------------------
-- Building

-- | Build a 'CommandBuffer' by running actions in an environment that has
-- access to a 'CommandEncoder'.
buildCommandBuffer ::
  forall r m.
  HasDevice r m =>
  -- | Debugging label for the command encoder.
  Text ->
  -- | Debugging label for the command buffer.
  Text ->
  -- | Action to configure the 'CommandEncoder'.
  ReaderT (CommandEncoder, r) m () ->
  -- | Completed 'CommandBuffer'.
  m CommandBuffer
buildCommandBuffer :: Text -> Text -> ReaderT (CommandEncoder, r) m () -> m CommandBuffer
buildCommandBuffer Text
commandEncoderLabel Text
commandBufferLabel ReaderT (CommandEncoder, r) m ()
build = do
  CommandEncoder
commandEncoder <- Text -> m CommandEncoder
forall r (m :: * -> *). HasDevice r m => Text -> m CommandEncoder
createCommandEncoder Text
commandEncoderLabel
  CommandEncoder
-> ReaderT (CommandEncoder, r) m CommandBuffer -> m CommandBuffer
forall r (m :: * -> *) q a.
MonadReader r m =>
q -> ReaderT (q, r) m a -> m a
addEnv CommandEncoder
commandEncoder (ReaderT (CommandEncoder, r) m ()
build ReaderT (CommandEncoder, r) m ()
-> ReaderT (CommandEncoder, r) m CommandBuffer
-> ReaderT (CommandEncoder, r) m CommandBuffer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ReaderT (CommandEncoder, r) m CommandBuffer
forall r (m :: * -> *).
HasCommandEncoder r m =>
Text -> m CommandBuffer
commandEncoderFinish Text
commandBufferLabel)
{-# INLINEABLE buildCommandBuffer #-}

-- | Build a render pass by running actions in an environment that has access
-- to a 'RenderPassEncoder'.
buildRenderPass ::
  forall r m.
  HasCommandEncoder r m =>
  RenderPassDescriptor ->
  ReaderT (RenderPassEncoder, r) m () ->
  m ()
buildRenderPass :: RenderPassDescriptor -> ReaderT (RenderPassEncoder, r) m () -> m ()
buildRenderPass RenderPassDescriptor
renderPassDescriptor ReaderT (RenderPassEncoder, r) m ()
build = do
  RenderPassEncoder
renderPassEncoder <- RenderPassDescriptor -> m RenderPassEncoder
forall r (m :: * -> *).
HasCommandEncoder r m =>
RenderPassDescriptor -> m RenderPassEncoder
beginRenderPass RenderPassDescriptor
renderPassDescriptor
  RenderPassEncoder -> ReaderT (RenderPassEncoder, r) m () -> m ()
forall r (m :: * -> *) q a.
MonadReader r m =>
q -> ReaderT (q, r) m a -> m a
addEnv RenderPassEncoder
renderPassEncoder (ReaderT (RenderPassEncoder, r) m ()
build ReaderT (RenderPassEncoder, r) m ()
-> ReaderT (RenderPassEncoder, r) m ()
-> ReaderT (RenderPassEncoder, r) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT (RenderPassEncoder, r) m ()
forall r (m :: * -> *). HasRenderPassEncoder r m => m ()
endRenderPass)
{-# INLINEABLE buildRenderPass #-}

-- | Build a queue by running actions in an environment that has access to a
-- `Queue`.
buildQueue :: HasDevice r m => ReaderT (Queue, r) m () -> m ()
buildQueue :: ReaderT (Queue, r) m () -> m ()
buildQueue ReaderT (Queue, r) m ()
action = m Queue
forall r (m :: * -> *). HasDevice r m => m Queue
getQueue m Queue -> (Queue -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Queue
queue -> Queue -> ReaderT (Queue, r) m () -> m ()
forall r (m :: * -> *) q a.
MonadReader r m =>
q -> ReaderT (q, r) m a -> m a
addEnv Queue
queue ReaderT (Queue, r) m ()
action
{-# INLINEABLE buildQueue #-}