{-# 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 {BindGroupLayout -> WGPUBindGroupLayout
wgpuBindGroupLayout :: WGPUBindGroupLayout}

instance Show BindGroupLayout where
  show :: BindGroupLayout -> String
show BindGroupLayout
b =
    let BindGroupLayout (WGPUBindGroupLayout Ptr ()
ptr) = BindGroupLayout
b
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"BindGroupLayout" Ptr ()
ptr

instance Eq BindGroupLayout where
  == :: BindGroupLayout -> BindGroupLayout -> Bool
(==) BindGroupLayout
b1 BindGroupLayout
b2 =
    let BindGroupLayout (WGPUBindGroupLayout Ptr ()
b1_ptr) = BindGroupLayout
b1
        BindGroupLayout (WGPUBindGroupLayout Ptr ()
b2_ptr) = BindGroupLayout
b2
     in Ptr ()
b1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
b2_ptr

instance ToRaw BindGroupLayout WGPUBindGroupLayout where
  raw :: BindGroupLayout -> ContT c IO WGPUBindGroupLayout
raw = WGPUBindGroupLayout -> ContT c IO WGPUBindGroupLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBindGroupLayout -> ContT c IO WGPUBindGroupLayout)
-> (BindGroupLayout -> WGPUBindGroupLayout)
-> BindGroupLayout
-> ContT c IO WGPUBindGroupLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindGroupLayout -> WGPUBindGroupLayout
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 -> BindGroupLayoutDescriptor -> IO BindGroupLayout
createBindGroupLayout Device
device BindGroupLayoutDescriptor
ld = ContT BindGroupLayout IO BindGroupLayout -> IO BindGroupLayout
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT BindGroupLayout IO BindGroupLayout -> IO BindGroupLayout)
-> ContT BindGroupLayout IO BindGroupLayout -> IO BindGroupLayout
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
      inst :: Instance
inst = Device -> Instance
deviceInst Device
device

  Ptr WGPUBindGroupLayoutDescriptor
bindGroupLayoutDescriptor_ptr <- BindGroupLayoutDescriptor
-> ContT BindGroupLayout IO (Ptr WGPUBindGroupLayoutDescriptor)
forall a b c. ToRawPtr a b => a -> ContT c IO (Ptr b)
rawPtr BindGroupLayoutDescriptor
ld
  WGPUBindGroupLayout
rawBindGroupLayout <-
    IO WGPUBindGroupLayout
-> ContT BindGroupLayout IO WGPUBindGroupLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WGPUBindGroupLayout
 -> ContT BindGroupLayout IO WGPUBindGroupLayout)
-> IO WGPUBindGroupLayout
-> ContT BindGroupLayout IO WGPUBindGroupLayout
forall a b. (a -> b) -> a -> b
$
      WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUBindGroupLayoutDescriptor
-> IO WGPUBindGroupLayout
RawFun.wgpuDeviceCreateBindGroupLayout
        (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
        (Device -> WGPUDevice
wgpuDevice Device
device)
        Ptr WGPUBindGroupLayoutDescriptor
bindGroupLayoutDescriptor_ptr
  BindGroupLayout -> ContT BindGroupLayout IO BindGroupLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBindGroupLayout -> BindGroupLayout
BindGroupLayout WGPUBindGroupLayout
rawBindGroupLayout)

-------------------------------------------------------------------------------

-- | Describes a 'BindGroupLayout'.
data BindGroupLayoutDescriptor = BindGroupLayoutDescriptor
  { -- | Debug label of the bind group layout.
    BindGroupLayoutDescriptor -> Text
bindGroupLabel :: !Text,
    -- | Sequence of entries in this bind group layout.
    BindGroupLayoutDescriptor -> Vector BindGroupLayoutEntry
entries :: Vector BindGroupLayoutEntry
  }
  deriving (BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool
(BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool)
-> (BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool)
-> Eq BindGroupLayoutDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool
$c/= :: BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool
== :: BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool
$c== :: BindGroupLayoutDescriptor -> BindGroupLayoutDescriptor -> Bool
Eq, Int -> BindGroupLayoutDescriptor -> ShowS
[BindGroupLayoutDescriptor] -> ShowS
BindGroupLayoutDescriptor -> String
(Int -> BindGroupLayoutDescriptor -> ShowS)
-> (BindGroupLayoutDescriptor -> String)
-> ([BindGroupLayoutDescriptor] -> ShowS)
-> Show BindGroupLayoutDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindGroupLayoutDescriptor] -> ShowS
$cshowList :: [BindGroupLayoutDescriptor] -> ShowS
show :: BindGroupLayoutDescriptor -> String
$cshow :: BindGroupLayoutDescriptor -> String
showsPrec :: Int -> BindGroupLayoutDescriptor -> ShowS
$cshowsPrec :: Int -> BindGroupLayoutDescriptor -> ShowS
Show)

instance ToRaw BindGroupLayoutDescriptor WGPUBindGroupLayoutDescriptor where
  raw :: BindGroupLayoutDescriptor
-> ContT c IO WGPUBindGroupLayoutDescriptor
raw BindGroupLayoutDescriptor {Text
Vector BindGroupLayoutEntry
entries :: Vector BindGroupLayoutEntry
bindGroupLabel :: Text
entries :: BindGroupLayoutDescriptor -> Vector BindGroupLayoutEntry
bindGroupLabel :: BindGroupLayoutDescriptor -> Text
..} = do
    Ptr CChar
label_ptr <- Text -> ContT c IO (Ptr CChar)
forall a b c. ToRawPtr a b => a -> ContT c IO (Ptr b)
rawPtr Text
bindGroupLabel
    let n_entryCount :: Word32
n_entryCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector BindGroupLayoutEntry -> Int)
-> Vector BindGroupLayoutEntry
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BindGroupLayoutEntry -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector BindGroupLayoutEntry -> Word32)
-> Vector BindGroupLayoutEntry -> Word32
forall a b. (a -> b) -> a -> b
$ Vector BindGroupLayoutEntry
entries
    Ptr WGPUBindGroupLayoutEntry
entries_ptr <- Vector BindGroupLayoutEntry
-> ContT c IO (Ptr WGPUBindGroupLayoutEntry)
forall (v :: * -> *) a b c.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT c IO (Ptr b)
rawArrayPtr Vector BindGroupLayoutEntry
entries
    WGPUBindGroupLayoutDescriptor
-> ContT c IO WGPUBindGroupLayoutDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUBindGroupLayoutDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> Word32
-> Ptr WGPUBindGroupLayoutEntry
-> WGPUBindGroupLayoutDescriptor
WGPUBindGroupLayoutDescriptor.WGPUBindGroupLayoutDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          entryCount :: Word32
entryCount = Word32
n_entryCount,
          entries :: Ptr WGPUBindGroupLayoutEntry
entries = Ptr WGPUBindGroupLayoutEntry
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.
    BindGroupLayoutEntry -> Binding
binding :: !Binding,
    -- | Which shader stages can see this binding.
    BindGroupLayoutEntry -> ShaderStage
visibility :: !ShaderStage,
    -- | Type of the binding.
    BindGroupLayoutEntry -> BindingType
bindGroupLayoutEntryType :: !BindingType
  }
  deriving (BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool
(BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool)
-> (BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool)
-> Eq BindGroupLayoutEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool
$c/= :: BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool
== :: BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool
$c== :: BindGroupLayoutEntry -> BindGroupLayoutEntry -> Bool
Eq, Int -> BindGroupLayoutEntry -> ShowS
[BindGroupLayoutEntry] -> ShowS
BindGroupLayoutEntry -> String
(Int -> BindGroupLayoutEntry -> ShowS)
-> (BindGroupLayoutEntry -> String)
-> ([BindGroupLayoutEntry] -> ShowS)
-> Show BindGroupLayoutEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindGroupLayoutEntry] -> ShowS
$cshowList :: [BindGroupLayoutEntry] -> ShowS
show :: BindGroupLayoutEntry -> String
$cshow :: BindGroupLayoutEntry -> String
showsPrec :: Int -> BindGroupLayoutEntry -> ShowS
$cshowsPrec :: Int -> BindGroupLayoutEntry -> ShowS
Show)

instance ToRaw BindGroupLayoutEntry WGPUBindGroupLayoutEntry where
  raw :: BindGroupLayoutEntry -> ContT c IO WGPUBindGroupLayoutEntry
raw BindGroupLayoutEntry {BindingType
ShaderStage
Binding
bindGroupLayoutEntryType :: BindingType
visibility :: ShaderStage
binding :: Binding
bindGroupLayoutEntryType :: BindGroupLayoutEntry -> BindingType
visibility :: BindGroupLayoutEntry -> ShaderStage
binding :: BindGroupLayoutEntry -> Binding
..} = do
    Word32
n_binding <- Binding -> ContT c IO Word32
forall a b c. ToRaw a b => a -> ContT c IO b
raw Binding
binding
    Word32
n_visibility <- ShaderStage -> ContT c IO Word32
forall a b c. ToRaw a b => a -> ContT c IO b
raw ShaderStage
visibility
    (WGPUBufferBindingLayout
n_buffer, WGPUSamplerBindingLayout
n_sampler, WGPUTextureBindingLayout
n_texture, WGPUStorageTextureBindingLayout
n_storageTexture) <-
      case BindingType
bindGroupLayoutEntryType of
        BindingTypeBuffer BufferBindingLayout
bbl -> do
          WGPUBufferBindingLayout
nn_buffer <- BufferBindingLayout -> ContT c IO WGPUBufferBindingLayout
forall a b c. ToRaw a b => a -> ContT c IO b
raw BufferBindingLayout
bbl
          (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
 WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
-> ContT
     c
     IO
     (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
      WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBufferBindingLayout
nn_buffer, WGPUSamplerBindingLayout
noSampler, WGPUTextureBindingLayout
noTexture, WGPUStorageTextureBindingLayout
noStorageTexture)
        BindingTypeSampler SamplerBindingLayout
sbl -> do
          WGPUSamplerBindingLayout
nn_sampler <- SamplerBindingLayout -> ContT c IO WGPUSamplerBindingLayout
forall a b c. ToRaw a b => a -> ContT c IO b
raw SamplerBindingLayout
sbl
          (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
 WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
-> ContT
     c
     IO
     (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
      WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBufferBindingLayout
noBuffer, WGPUSamplerBindingLayout
nn_sampler, WGPUTextureBindingLayout
noTexture, WGPUStorageTextureBindingLayout
noStorageTexture)
        BindingTypeTexture TextureBindingLayout
tbl -> do
          WGPUTextureBindingLayout
nn_texture <- TextureBindingLayout -> ContT c IO WGPUTextureBindingLayout
forall a b c. ToRaw a b => a -> ContT c IO b
raw TextureBindingLayout
tbl
          (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
 WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
-> ContT
     c
     IO
     (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
      WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBufferBindingLayout
noBuffer, WGPUSamplerBindingLayout
noSampler, WGPUTextureBindingLayout
nn_texture, WGPUStorageTextureBindingLayout
noStorageTexture)
        BindingTypeStorageTexture StorageTextureBindingLayout
stbl -> do
          WGPUStorageTextureBindingLayout
nn_storageTexture <- StorageTextureBindingLayout
-> ContT c IO WGPUStorageTextureBindingLayout
forall a b c. ToRaw a b => a -> ContT c IO b
raw StorageTextureBindingLayout
stbl
          (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
 WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
-> ContT
     c
     IO
     (WGPUBufferBindingLayout, WGPUSamplerBindingLayout,
      WGPUTextureBindingLayout, WGPUStorageTextureBindingLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBufferBindingLayout
noBuffer, WGPUSamplerBindingLayout
noSampler, WGPUTextureBindingLayout
noTexture, WGPUStorageTextureBindingLayout
nn_storageTexture)
    WGPUBindGroupLayoutEntry -> ContT c IO WGPUBindGroupLayoutEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUBindGroupLayoutEntry :: Ptr WGPUChainedStruct
-> Word32
-> Word32
-> WGPUBufferBindingLayout
-> WGPUSamplerBindingLayout
-> WGPUTextureBindingLayout
-> WGPUStorageTextureBindingLayout
-> WGPUBindGroupLayoutEntry
WGPUBindGroupLayoutEntry.WGPUBindGroupLayoutEntry
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          binding :: Word32
binding = Word32
n_binding,
          visibility :: Word32
visibility = Word32
n_visibility,
          buffer :: WGPUBufferBindingLayout
buffer = WGPUBufferBindingLayout
n_buffer,
          sampler :: WGPUSamplerBindingLayout
sampler = WGPUSamplerBindingLayout
n_sampler,
          texture :: WGPUTextureBindingLayout
texture = WGPUTextureBindingLayout
n_texture,
          storageTexture :: WGPUStorageTextureBindingLayout
storageTexture = WGPUStorageTextureBindingLayout
n_storageTexture
        }
    where
      noBuffer :: WGPUBufferBindingLayout
      noBuffer :: WGPUBufferBindingLayout
noBuffer =
        WGPUBufferBindingLayout :: Ptr WGPUChainedStruct
-> WGPUBufferBindingType
-> CBool
-> Word64
-> WGPUBufferBindingLayout
WGPUBufferBindingLayout.WGPUBufferBindingLayout
          { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
            typ :: WGPUBufferBindingType
typ = WGPUBufferBindingType
forall a. (Eq a, Num a) => a
WGPUBufferBindingType.Undefined,
            hasDynamicOffset :: CBool
hasDynamicOffset = Word8 -> CBool
CBool Word8
0,
            minBindingSize :: Word64
minBindingSize = Word64
0
          }

      noSampler :: WGPUSamplerBindingLayout
      noSampler :: WGPUSamplerBindingLayout
noSampler =
        WGPUSamplerBindingLayout :: Ptr WGPUChainedStruct
-> WGPUSamplerBindingType -> WGPUSamplerBindingLayout
WGPUSamplerBindingLayout.WGPUSamplerBindingLayout
          { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
            typ :: WGPUSamplerBindingType
typ = WGPUSamplerBindingType
forall a. (Eq a, Num a) => a
WGPUSamplerBindingType.Undefined
          }

      noTexture :: WGPUTextureBindingLayout
      noTexture :: WGPUTextureBindingLayout
noTexture =
        WGPUTextureBindingLayout :: Ptr WGPUChainedStruct
-> WGPUTextureSampleType
-> WGPUTextureViewDimension
-> CBool
-> WGPUTextureBindingLayout
WGPUTextureBindingLayout.WGPUTextureBindingLayout
          { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
            sampleType :: WGPUTextureSampleType
sampleType = WGPUTextureSampleType
forall a. (Eq a, Num a) => a
WGPUTextureSampleType.Undefined,
            viewDimension :: WGPUTextureViewDimension
viewDimension = WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.Undefined,
            multisampled :: CBool
multisampled = Word8 -> CBool
CBool Word8
0
          }

      noStorageTexture :: WGPUStorageTextureBindingLayout
      noStorageTexture :: WGPUStorageTextureBindingLayout
noStorageTexture =
        WGPUStorageTextureBindingLayout :: Ptr WGPUChainedStruct
-> WGPUStorageTextureAccess
-> WGPUTextureFormat
-> WGPUTextureViewDimension
-> WGPUStorageTextureBindingLayout
WGPUStorageTextureBindingLayout.WGPUStorageTextureBindingLayout
          { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
            access :: WGPUStorageTextureAccess
access = WGPUStorageTextureAccess
forall a. (Eq a, Num a) => a
WGPUStorageTextureAccess.Undefined,
            format :: WGPUTextureFormat
format = WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.Undefined,
            viewDimension :: WGPUTextureViewDimension
viewDimension = WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.Undefined
          }

-------------------------------------------------------------------------------

-- | Binding index.
--
-- This must match a shader index, and be unique inside a binding group
-- layout.
newtype Binding = Binding {Binding -> Word32
unBinding :: Word32} deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show)

instance ToRaw Binding Word32 where
  raw :: Binding -> ContT c IO Word32
raw = Word32 -> ContT c IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> ContT c IO Word32)
-> (Binding -> Word32) -> Binding -> ContT c IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> Word32
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.
    ShaderStage -> Bool
stageVertex :: !Bool,
    -- | Binding is visible from the fragment shader of a render pipeline.
    ShaderStage -> Bool
stageFragment :: !Bool,
    -- | Binding is visible from the compute shader of a compute pipeline.
    ShaderStage -> Bool
stageCompute :: !Bool
  }
  deriving (ShaderStage -> ShaderStage -> Bool
(ShaderStage -> ShaderStage -> Bool)
-> (ShaderStage -> ShaderStage -> Bool) -> Eq ShaderStage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderStage -> ShaderStage -> Bool
$c/= :: ShaderStage -> ShaderStage -> Bool
== :: ShaderStage -> ShaderStage -> Bool
$c== :: ShaderStage -> ShaderStage -> Bool
Eq, Int -> ShaderStage -> ShowS
[ShaderStage] -> ShowS
ShaderStage -> String
(Int -> ShaderStage -> ShowS)
-> (ShaderStage -> String)
-> ([ShaderStage] -> ShowS)
-> Show ShaderStage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderStage] -> ShowS
$cshowList :: [ShaderStage] -> ShowS
show :: ShaderStage -> String
$cshow :: ShaderStage -> String
showsPrec :: Int -> ShaderStage -> ShowS
$cshowsPrec :: Int -> ShaderStage -> ShowS
Show)

instance ToRaw ShaderStage WGPUShaderStageFlags where
  raw :: ShaderStage -> ContT c IO Word32
raw ShaderStage {Bool
stageCompute :: Bool
stageFragment :: Bool
stageVertex :: Bool
stageCompute :: ShaderStage -> Bool
stageFragment :: ShaderStage -> Bool
stageVertex :: ShaderStage -> Bool
..} =
    Word32 -> ContT c IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> ContT c IO Word32) -> Word32 -> ContT c IO Word32
forall a b. (a -> b) -> a -> b
$
      (if Bool
stageVertex then Word32
forall a. (Eq a, Num a) => a
WGPUShaderStage.Vertex else Word32
0)
        Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (if Bool
stageFragment then Word32
forall a. (Eq a, Num a) => a
WGPUShaderStage.Fragment else Word32
0)
        Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (if Bool
stageCompute then Word32
forall a. (Eq a, Num a) => a
WGPUShaderStage.Compute else Word32
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 (BindingType -> BindingType -> Bool
(BindingType -> BindingType -> Bool)
-> (BindingType -> BindingType -> Bool) -> Eq BindingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingType -> BindingType -> Bool
$c/= :: BindingType -> BindingType -> Bool
== :: BindingType -> BindingType -> Bool
$c== :: BindingType -> BindingType -> Bool
Eq, Int -> BindingType -> ShowS
[BindingType] -> ShowS
BindingType -> String
(Int -> BindingType -> ShowS)
-> (BindingType -> String)
-> ([BindingType] -> ShowS)
-> Show BindingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindingType] -> ShowS
$cshowList :: [BindingType] -> ShowS
show :: BindingType -> String
$cshow :: BindingType -> String
showsPrec :: Int -> BindingType -> ShowS
$cshowsPrec :: Int -> BindingType -> ShowS
Show)

-------------------------------------------------------------------------------

-- | A buffer binding.
data BufferBindingLayout = BufferBindingLayout
  { -- | Sub-type of the buffer binding.
    BufferBindingLayout -> BufferBindingType
bindingBufferLayoutType :: !BufferBindingType,
    -- | Indicates that the binding has a dynamic offset. One offset must be
    --   passed when setting the bind group in the render pass.
    BufferBindingLayout -> Bool
hasDynamicOffset :: !Bool,
    -- | Minimum size of a corresponding buffer binding required to match this
    --   entry.
    BufferBindingLayout -> SMaybe Word64
minBindingSize :: !(SMaybe Word64)
  }
  deriving (BufferBindingLayout -> BufferBindingLayout -> Bool
(BufferBindingLayout -> BufferBindingLayout -> Bool)
-> (BufferBindingLayout -> BufferBindingLayout -> Bool)
-> Eq BufferBindingLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufferBindingLayout -> BufferBindingLayout -> Bool
$c/= :: BufferBindingLayout -> BufferBindingLayout -> Bool
== :: BufferBindingLayout -> BufferBindingLayout -> Bool
$c== :: BufferBindingLayout -> BufferBindingLayout -> Bool
Eq, Int -> BufferBindingLayout -> ShowS
[BufferBindingLayout] -> ShowS
BufferBindingLayout -> String
(Int -> BufferBindingLayout -> ShowS)
-> (BufferBindingLayout -> String)
-> ([BufferBindingLayout] -> ShowS)
-> Show BufferBindingLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferBindingLayout] -> ShowS
$cshowList :: [BufferBindingLayout] -> ShowS
show :: BufferBindingLayout -> String
$cshow :: BufferBindingLayout -> String
showsPrec :: Int -> BufferBindingLayout -> ShowS
$cshowsPrec :: Int -> BufferBindingLayout -> ShowS
Show)

instance ToRaw BufferBindingLayout WGPUBufferBindingLayout where
  raw :: BufferBindingLayout -> ContT c IO WGPUBufferBindingLayout
raw BufferBindingLayout {Bool
SMaybe Word64
BufferBindingType
minBindingSize :: SMaybe Word64
hasDynamicOffset :: Bool
bindingBufferLayoutType :: BufferBindingType
minBindingSize :: BufferBindingLayout -> SMaybe Word64
hasDynamicOffset :: BufferBindingLayout -> Bool
bindingBufferLayoutType :: BufferBindingLayout -> BufferBindingType
..} = do
    WGPUBufferBindingType
n_typ <- BufferBindingType -> ContT c IO WGPUBufferBindingType
forall a b c. ToRaw a b => a -> ContT c IO b
raw BufferBindingType
bindingBufferLayoutType
    CBool
n_hasDynamicOffset <- Bool -> ContT c IO CBool
forall a b c. ToRaw a b => a -> ContT c IO b
raw Bool
hasDynamicOffset
    WGPUBufferBindingLayout -> ContT c IO WGPUBufferBindingLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUBufferBindingLayout :: Ptr WGPUChainedStruct
-> WGPUBufferBindingType
-> CBool
-> Word64
-> WGPUBufferBindingLayout
WGPUBufferBindingLayout.WGPUBufferBindingLayout
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          typ :: WGPUBufferBindingType
typ = WGPUBufferBindingType
n_typ,
          hasDynamicOffset :: CBool
hasDynamicOffset = CBool
n_hasDynamicOffset,
          minBindingSize :: Word64
minBindingSize = Word64 -> SMaybe Word64 -> Word64
forall a. a -> SMaybe a -> a
fromSMaybe Word64
0 SMaybe Word64
minBindingSize
        }

-------------------------------------------------------------------------------

-- | A sampler binding that can be used to sample a texture.
data SamplerBindingLayout
  = SamplerBindingLayoutFiltering
  | SamplerBindingLayoutNonFiltering
  | SamplerBindingLayoutComparison
  deriving (SamplerBindingLayout -> SamplerBindingLayout -> Bool
(SamplerBindingLayout -> SamplerBindingLayout -> Bool)
-> (SamplerBindingLayout -> SamplerBindingLayout -> Bool)
-> Eq SamplerBindingLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerBindingLayout -> SamplerBindingLayout -> Bool
$c/= :: SamplerBindingLayout -> SamplerBindingLayout -> Bool
== :: SamplerBindingLayout -> SamplerBindingLayout -> Bool
$c== :: SamplerBindingLayout -> SamplerBindingLayout -> Bool
Eq, Int -> SamplerBindingLayout -> ShowS
[SamplerBindingLayout] -> ShowS
SamplerBindingLayout -> String
(Int -> SamplerBindingLayout -> ShowS)
-> (SamplerBindingLayout -> String)
-> ([SamplerBindingLayout] -> ShowS)
-> Show SamplerBindingLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplerBindingLayout] -> ShowS
$cshowList :: [SamplerBindingLayout] -> ShowS
show :: SamplerBindingLayout -> String
$cshow :: SamplerBindingLayout -> String
showsPrec :: Int -> SamplerBindingLayout -> ShowS
$cshowsPrec :: Int -> SamplerBindingLayout -> ShowS
Show)

instance ToRaw SamplerBindingLayout WGPUSamplerBindingLayout where
  raw :: SamplerBindingLayout -> ContT c IO WGPUSamplerBindingLayout
raw SamplerBindingLayout
sbl =
    WGPUSamplerBindingLayout -> ContT c IO WGPUSamplerBindingLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUSamplerBindingLayout -> ContT c IO WGPUSamplerBindingLayout)
-> WGPUSamplerBindingLayout -> ContT c IO WGPUSamplerBindingLayout
forall a b. (a -> b) -> a -> b
$
      WGPUSamplerBindingLayout :: Ptr WGPUChainedStruct
-> WGPUSamplerBindingType -> WGPUSamplerBindingLayout
WGPUSamplerBindingLayout.WGPUSamplerBindingLayout
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          typ :: WGPUSamplerBindingType
typ =
            case SamplerBindingLayout
sbl of
              SamplerBindingLayout
SamplerBindingLayoutFiltering ->
                WGPUSamplerBindingType
forall a. (Eq a, Num a) => a
WGPUSamplerBindingType.Filtering
              SamplerBindingLayout
SamplerBindingLayoutNonFiltering ->
                WGPUSamplerBindingType
forall a. (Eq a, Num a) => a
WGPUSamplerBindingType.NonFiltering
              SamplerBindingLayout
SamplerBindingLayoutComparison ->
                WGPUSamplerBindingType
forall a. (Eq a, Num a) => a
WGPUSamplerBindingType.Comparison
        }

-------------------------------------------------------------------------------

-- | A texture binding.
data TextureBindingLayout = TextureBindingLayout
  { -- | Sample type of the texture binding.
    TextureBindingLayout -> TextureSampleType
sampleType :: !TextureSampleType,
    -- | Dimension of the texture view that is going to be sampled.
    TextureBindingLayout -> TextureViewDimension
textureViewDimension :: !TextureViewDimension,
    -- | True if the texture has a sample count greater than 1.
    TextureBindingLayout -> Bool
multiSampled :: !Bool
  }
  deriving (TextureBindingLayout -> TextureBindingLayout -> Bool
(TextureBindingLayout -> TextureBindingLayout -> Bool)
-> (TextureBindingLayout -> TextureBindingLayout -> Bool)
-> Eq TextureBindingLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureBindingLayout -> TextureBindingLayout -> Bool
$c/= :: TextureBindingLayout -> TextureBindingLayout -> Bool
== :: TextureBindingLayout -> TextureBindingLayout -> Bool
$c== :: TextureBindingLayout -> TextureBindingLayout -> Bool
Eq, Int -> TextureBindingLayout -> ShowS
[TextureBindingLayout] -> ShowS
TextureBindingLayout -> String
(Int -> TextureBindingLayout -> ShowS)
-> (TextureBindingLayout -> String)
-> ([TextureBindingLayout] -> ShowS)
-> Show TextureBindingLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureBindingLayout] -> ShowS
$cshowList :: [TextureBindingLayout] -> ShowS
show :: TextureBindingLayout -> String
$cshow :: TextureBindingLayout -> String
showsPrec :: Int -> TextureBindingLayout -> ShowS
$cshowsPrec :: Int -> TextureBindingLayout -> ShowS
Show)

instance ToRaw TextureBindingLayout WGPUTextureBindingLayout where
  raw :: TextureBindingLayout -> ContT c IO WGPUTextureBindingLayout
raw TextureBindingLayout {Bool
TextureViewDimension
TextureSampleType
multiSampled :: Bool
textureViewDimension :: TextureViewDimension
sampleType :: TextureSampleType
multiSampled :: TextureBindingLayout -> Bool
textureViewDimension :: TextureBindingLayout -> TextureViewDimension
sampleType :: TextureBindingLayout -> TextureSampleType
..} = do
    WGPUTextureSampleType
n_sampleType <- TextureSampleType -> ContT c IO WGPUTextureSampleType
forall a b c. ToRaw a b => a -> ContT c IO b
raw TextureSampleType
sampleType
    WGPUTextureViewDimension
n_viewDimension <- TextureViewDimension -> ContT c IO WGPUTextureViewDimension
forall a b c. ToRaw a b => a -> ContT c IO b
raw TextureViewDimension
textureViewDimension
    CBool
n_multisampled <- Bool -> ContT c IO CBool
forall a b c. ToRaw a b => a -> ContT c IO b
raw Bool
multiSampled
    WGPUTextureBindingLayout -> ContT c IO WGPUTextureBindingLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUTextureBindingLayout :: Ptr WGPUChainedStruct
-> WGPUTextureSampleType
-> WGPUTextureViewDimension
-> CBool
-> WGPUTextureBindingLayout
WGPUTextureBindingLayout.WGPUTextureBindingLayout
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          sampleType :: WGPUTextureSampleType
sampleType = WGPUTextureSampleType
n_sampleType,
          viewDimension :: WGPUTextureViewDimension
viewDimension = WGPUTextureViewDimension
n_viewDimension,
          multisampled :: CBool
multisampled = CBool
n_multisampled
        }

-------------------------------------------------------------------------------

-- | A storage texture binding.
data StorageTextureBindingLayout = StorageTextureBindingLayout
  { -- | Permitted access to this texture.
    StorageTextureBindingLayout -> StorageTextureAccess
access :: !StorageTextureAccess,
    -- | Format of the texture.
    StorageTextureBindingLayout -> TextureFormat
storageTextureFormat :: !TextureFormat,
    -- | Dimension of the texture view that is going to be sampled.
    StorageTextureBindingLayout -> TextureViewDimension
storageTextureViewDimension :: !TextureViewDimension
  }
  deriving (StorageTextureBindingLayout -> StorageTextureBindingLayout -> Bool
(StorageTextureBindingLayout
 -> StorageTextureBindingLayout -> Bool)
-> (StorageTextureBindingLayout
    -> StorageTextureBindingLayout -> Bool)
-> Eq StorageTextureBindingLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageTextureBindingLayout -> StorageTextureBindingLayout -> Bool
$c/= :: StorageTextureBindingLayout -> StorageTextureBindingLayout -> Bool
== :: StorageTextureBindingLayout -> StorageTextureBindingLayout -> Bool
$c== :: StorageTextureBindingLayout -> StorageTextureBindingLayout -> Bool
Eq, Int -> StorageTextureBindingLayout -> ShowS
[StorageTextureBindingLayout] -> ShowS
StorageTextureBindingLayout -> String
(Int -> StorageTextureBindingLayout -> ShowS)
-> (StorageTextureBindingLayout -> String)
-> ([StorageTextureBindingLayout] -> ShowS)
-> Show StorageTextureBindingLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageTextureBindingLayout] -> ShowS
$cshowList :: [StorageTextureBindingLayout] -> ShowS
show :: StorageTextureBindingLayout -> String
$cshow :: StorageTextureBindingLayout -> String
showsPrec :: Int -> StorageTextureBindingLayout -> ShowS
$cshowsPrec :: Int -> StorageTextureBindingLayout -> ShowS
Show)

instance ToRaw StorageTextureBindingLayout WGPUStorageTextureBindingLayout where
  raw :: StorageTextureBindingLayout
-> ContT c IO WGPUStorageTextureBindingLayout
raw StorageTextureBindingLayout {TextureFormat
TextureViewDimension
StorageTextureAccess
storageTextureViewDimension :: TextureViewDimension
storageTextureFormat :: TextureFormat
access :: StorageTextureAccess
storageTextureViewDimension :: StorageTextureBindingLayout -> TextureViewDimension
storageTextureFormat :: StorageTextureBindingLayout -> TextureFormat
access :: StorageTextureBindingLayout -> StorageTextureAccess
..} = do
    WGPUStorageTextureAccess
n_access <- StorageTextureAccess -> ContT c IO WGPUStorageTextureAccess
forall a b c. ToRaw a b => a -> ContT c IO b
raw StorageTextureAccess
access
    WGPUTextureFormat
n_format <- TextureFormat -> ContT c IO WGPUTextureFormat
forall a b c. ToRaw a b => a -> ContT c IO b
raw TextureFormat
storageTextureFormat
    WGPUTextureViewDimension
n_viewDimension <- TextureViewDimension -> ContT c IO WGPUTextureViewDimension
forall a b c. ToRaw a b => a -> ContT c IO b
raw TextureViewDimension
storageTextureViewDimension
    WGPUStorageTextureBindingLayout
-> ContT c IO WGPUStorageTextureBindingLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUStorageTextureBindingLayout :: Ptr WGPUChainedStruct
-> WGPUStorageTextureAccess
-> WGPUTextureFormat
-> WGPUTextureViewDimension
-> WGPUStorageTextureBindingLayout
WGPUStorageTextureBindingLayout.WGPUStorageTextureBindingLayout
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          access :: WGPUStorageTextureAccess
access = WGPUStorageTextureAccess
n_access,
          format :: WGPUTextureFormat
format = WGPUTextureFormat
n_format,
          viewDimension :: WGPUTextureViewDimension
viewDimension = WGPUTextureViewDimension
n_viewDimension
        }

-------------------------------------------------------------------------------

-- | Specific method of allowed access to a storage texture.
data StorageTextureAccess
  = StorageTextureAccessReadOnly
  | StorageTextureAccessWriteOnly
  | StorageTextureAccessReadWrite
  deriving (StorageTextureAccess -> StorageTextureAccess -> Bool
(StorageTextureAccess -> StorageTextureAccess -> Bool)
-> (StorageTextureAccess -> StorageTextureAccess -> Bool)
-> Eq StorageTextureAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageTextureAccess -> StorageTextureAccess -> Bool
$c/= :: StorageTextureAccess -> StorageTextureAccess -> Bool
== :: StorageTextureAccess -> StorageTextureAccess -> Bool
$c== :: StorageTextureAccess -> StorageTextureAccess -> Bool
Eq, Int -> StorageTextureAccess -> ShowS
[StorageTextureAccess] -> ShowS
StorageTextureAccess -> String
(Int -> StorageTextureAccess -> ShowS)
-> (StorageTextureAccess -> String)
-> ([StorageTextureAccess] -> ShowS)
-> Show StorageTextureAccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageTextureAccess] -> ShowS
$cshowList :: [StorageTextureAccess] -> ShowS
show :: StorageTextureAccess -> String
$cshow :: StorageTextureAccess -> String
showsPrec :: Int -> StorageTextureAccess -> ShowS
$cshowsPrec :: Int -> StorageTextureAccess -> ShowS
Show)

instance ToRaw StorageTextureAccess WGPUStorageTextureAccess where
  raw :: StorageTextureAccess -> ContT c IO WGPUStorageTextureAccess
raw StorageTextureAccess
sta =
    WGPUStorageTextureAccess -> ContT c IO WGPUStorageTextureAccess
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUStorageTextureAccess -> ContT c IO WGPUStorageTextureAccess)
-> WGPUStorageTextureAccess -> ContT c IO WGPUStorageTextureAccess
forall a b. (a -> b) -> a -> b
$
      case StorageTextureAccess
sta of
        StorageTextureAccess
StorageTextureAccessReadOnly -> WGPUStorageTextureAccess
forall a. (Eq a, Num a) => a
WGPUStorageTextureAccess.ReadOnly
        StorageTextureAccess
StorageTextureAccessWriteOnly -> WGPUStorageTextureAccess
forall a. (Eq a, Num a) => a
WGPUStorageTextureAccess.WriteOnly
        StorageTextureAccess
StorageTextureAccessReadWrite -> WGPUStorageTextureAccess
forall a. (Eq a, Num a) => a
WGPUStorageTextureAccess.Undefined -- ?

-------------------------------------------------------------------------------

-- | Specific type of a sample in a texture binding.
data TextureSampleType
  = TextureSampleTypeFloat {TextureSampleType -> Bool
filterable :: !Bool}
  | TextureSampleTypeDepth
  | TextureSampleTypeSignedInt
  | TextureSampleTypeUnsignedInt
  deriving (TextureSampleType -> TextureSampleType -> Bool
(TextureSampleType -> TextureSampleType -> Bool)
-> (TextureSampleType -> TextureSampleType -> Bool)
-> Eq TextureSampleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureSampleType -> TextureSampleType -> Bool
$c/= :: TextureSampleType -> TextureSampleType -> Bool
== :: TextureSampleType -> TextureSampleType -> Bool
$c== :: TextureSampleType -> TextureSampleType -> Bool
Eq, Int -> TextureSampleType -> ShowS
[TextureSampleType] -> ShowS
TextureSampleType -> String
(Int -> TextureSampleType -> ShowS)
-> (TextureSampleType -> String)
-> ([TextureSampleType] -> ShowS)
-> Show TextureSampleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureSampleType] -> ShowS
$cshowList :: [TextureSampleType] -> ShowS
show :: TextureSampleType -> String
$cshow :: TextureSampleType -> String
showsPrec :: Int -> TextureSampleType -> ShowS
$cshowsPrec :: Int -> TextureSampleType -> ShowS
Show)

instance ToRaw TextureSampleType WGPUTextureSampleType where
  raw :: TextureSampleType -> ContT c IO WGPUTextureSampleType
raw TextureSampleType
tt =
    WGPUTextureSampleType -> ContT c IO WGPUTextureSampleType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureSampleType -> ContT c IO WGPUTextureSampleType)
-> WGPUTextureSampleType -> ContT c IO WGPUTextureSampleType
forall a b. (a -> b) -> a -> b
$
      case TextureSampleType
tt of
        TextureSampleTypeFloat Bool
False -> WGPUTextureSampleType
forall a. (Eq a, Num a) => a
WGPUTextureSampleType.UnfilterableFloat
        TextureSampleTypeFloat Bool
True -> WGPUTextureSampleType
forall a. (Eq a, Num a) => a
WGPUTextureSampleType.Float
        TextureSampleType
TextureSampleTypeDepth -> WGPUTextureSampleType
forall a. (Eq a, Num a) => a
WGPUTextureSampleType.Depth
        TextureSampleType
TextureSampleTypeSignedInt -> WGPUTextureSampleType
forall a. (Eq a, Num a) => a
WGPUTextureSampleType.Sint
        TextureSampleType
TextureSampleTypeUnsignedInt -> WGPUTextureSampleType
forall a. (Eq a, Num a) => a
WGPUTextureSampleType.Uint

-------------------------------------------------------------------------------

-- | Specific type of a buffer binding.
data BufferBindingType
  = Uniform
  | Storage {BufferBindingType -> Bool
readOnly :: !Bool}
  deriving (BufferBindingType -> BufferBindingType -> Bool
(BufferBindingType -> BufferBindingType -> Bool)
-> (BufferBindingType -> BufferBindingType -> Bool)
-> Eq BufferBindingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufferBindingType -> BufferBindingType -> Bool
$c/= :: BufferBindingType -> BufferBindingType -> Bool
== :: BufferBindingType -> BufferBindingType -> Bool
$c== :: BufferBindingType -> BufferBindingType -> Bool
Eq, Int -> BufferBindingType -> ShowS
[BufferBindingType] -> ShowS
BufferBindingType -> String
(Int -> BufferBindingType -> ShowS)
-> (BufferBindingType -> String)
-> ([BufferBindingType] -> ShowS)
-> Show BufferBindingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferBindingType] -> ShowS
$cshowList :: [BufferBindingType] -> ShowS
show :: BufferBindingType -> String
$cshow :: BufferBindingType -> String
showsPrec :: Int -> BufferBindingType -> ShowS
$cshowsPrec :: Int -> BufferBindingType -> ShowS
Show)

instance ToRaw BufferBindingType WGPUBufferBindingType where
  raw :: BufferBindingType -> ContT c IO WGPUBufferBindingType
raw BufferBindingType
bt =
    WGPUBufferBindingType -> ContT c IO WGPUBufferBindingType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBufferBindingType -> ContT c IO WGPUBufferBindingType)
-> WGPUBufferBindingType -> ContT c IO WGPUBufferBindingType
forall a b. (a -> b) -> a -> b
$
      case BufferBindingType
bt of
        BufferBindingType
Uniform -> WGPUBufferBindingType
forall a. (Eq a, Num a) => a
WGPUBufferBindingType.Uniform
        Storage Bool
False -> WGPUBufferBindingType
forall a. (Eq a, Num a) => a
WGPUBufferBindingType.Storage
        Storage Bool
True -> WGPUBufferBindingType
forall a. (Eq a, Num a) => a
WGPUBufferBindingType.ReadOnlyStorage