{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Mischief.Shader.Internal.Bindings where

import Data.Bifunctor qualified
import Data.Data
import Data.Default (Default (def))
import Data.Kind
import Data.Primitive.Ptr
import Data.Singletons (SingI)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector.Storable qualified as VS
import Foreign (Bits ((.|.)), with)
import Foreign.C.ConstPtr
import GHC.Generics (Generic (Rep, from), K1 (K1), M1 (M1), U1 (U1), V1 (..), to, (:*:) ((:*:)))
import GHC.TypeLits
import Mischief.ECS (System)
import Mischief.Render.Buffer (Buffer (..), BufferDescriptor (..))
import Mischief.Render.Core
import Mischief.Render.Texture
import Mischief.Shader.Internal.Buffers qualified as Buffers
import Mischief.Shader.Internal.Singletons
import Mischief.Shader.Internal.State
import Mischief.Shader.Types hiding ((<>))
import Mischief.WGPU
import Mischief.WGPU.Opaque (WGPUBindGroup, WGPUBindGroupLayout)
import Mischief.WGPU.Types.Enums
import Mischief.WGPU.Types.General

-- data Binding (index :: Nat) a where
--   Binding :: forall b index. Expr (AssociatedExpr b) -> Binding index b
--   BindEntry :: WGPUBindGroupEntry -> Binding index b

-- data Uniform (index :: Nat) a where
--   Uniform :: forall b index. WGPUBindGroupEntry -> Uniform index b

newtype UniformBinding a = UniformBinding a

newtype NormalBinding a = NormalBinding a

type family Binding f a where
  Binding Internal b = NormalBinding b
  Binding CPU Sampler = Sampler
  Binding GPU Sampler = Expr TSampler
  Binding CPU Texture = TextureView
  Binding GPU Texture = Expr TTexture

type family Uniform f a where
  Uniform Internal b = UniformBinding b
  Uniform CPU (a b) = Buffer a
  Uniform GPU (Expr a) = Expr a
  Uniform GPU (a GPU) = a GPU

-- Uniform CPU

-- type family ToGpu a where
--   T

type family AssociatedExpr a where
  AssociatedExpr (Expr a) = a
  AssociatedExpr Texture = TTexture
  AssociatedExpr Sampler = TSampler

-- instance (KnownNat n, SingI (AssociatedExpr a)) => Default (Binding n a) where
--   def = Binding $ BindingVar (natVal (Proxy @n))

data BindingData
  = NormalData
      { BindingData -> Text
bType :: Text,
        BindingData -> Integer
index :: Integer
      }
  | UniformData
      { BindingData -> Text
structName :: Text,
        BindingData -> [(Text, Text)]
structFields :: [(Text, Text)],
        index :: Integer
      }
  deriving (Int -> BindingData -> ShowS
[BindingData] -> ShowS
BindingData -> String
(Int -> BindingData -> ShowS)
-> (BindingData -> String)
-> ([BindingData] -> ShowS)
-> Show BindingData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BindingData -> ShowS
showsPrec :: Int -> BindingData -> ShowS
$cshow :: BindingData -> String
show :: BindingData -> String
$cshowList :: [BindingData] -> ShowS
showList :: [BindingData] -> ShowS
Show)

newtype Bindings = Bindings [BindingData] deriving newtype (NonEmpty Bindings -> Bindings
Bindings -> Bindings -> Bindings
(Bindings -> Bindings -> Bindings)
-> (NonEmpty Bindings -> Bindings)
-> (forall b. Integral b => b -> Bindings -> Bindings)
-> Semigroup Bindings
forall b. Integral b => b -> Bindings -> Bindings
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Bindings -> Bindings -> Bindings
<> :: Bindings -> Bindings -> Bindings
$csconcat :: NonEmpty Bindings -> Bindings
sconcat :: NonEmpty Bindings -> Bindings
$cstimes :: forall b. Integral b => b -> Bindings -> Bindings
stimes :: forall b. Integral b => b -> Bindings -> Bindings
Semigroup, Int -> Bindings -> ShowS
[Bindings] -> ShowS
Bindings -> String
(Int -> Bindings -> ShowS)
-> (Bindings -> String) -> ([Bindings] -> ShowS) -> Show Bindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bindings -> ShowS
showsPrec :: Int -> Bindings -> ShowS
$cshow :: Bindings -> String
show :: Bindings -> String
$cshowList :: [Bindings] -> ShowS
showList :: [Bindings] -> ShowS
Show)

class (Typeable a) => Bindable a where
  collectBindings :: Nat -> Proxy (a Internal) -> (Bindings, Nat)
  default collectBindings :: (GCollectBindings (Rep (a Internal))) => Nat -> Proxy (a Internal) -> (Bindings, Nat)
  collectBindings Nat
n Proxy (a Internal)
_ = Proxy (Rep (a Internal)) -> Nat -> (Bindings, Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> (Bindings, Nat)
gCollectBindings (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (a Internal))) Nat
n

  collectLayouts :: Nat -> Proxy (a Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
  default collectLayouts :: (GCollectBindings (Rep (a Internal))) => Nat -> Proxy (a Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
  collectLayouts Nat
n Proxy (a Internal)
_ = Proxy (Rep (a Internal))
-> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (a Internal))) Nat
n

  collectEntries :: Nat -> a CPU -> ([WGPUBindGroupEntry], Nat)
  default collectEntries :: (GCollectEntries (Rep (a CPU)) (Rep (a Internal)), Generic (a CPU)) => Nat -> a CPU -> ([WGPUBindGroupEntry], Nat)
  collectEntries Nat
n a CPU
a = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
forall (f :: * -> *) (g :: * -> *) p.
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries @(Rep (a CPU)) @(Rep (a Internal)) (a CPU -> Rep (a CPU) (ZonkAny 0)
forall x. a CPU -> Rep (a CPU) x
forall a x. Generic a => a -> Rep a x
from a CPU
a) Nat
n

  dummyBinding :: Nat -> (a GPU, Nat)
  default dummyBinding :: (Generic (a GPU), GDummyBinding (Rep (a Internal)) (Rep (a GPU))) => Nat -> (a GPU, Nat)
  dummyBinding Nat
n = (Rep (a GPU) (ZonkAny 1) -> a GPU)
-> (Rep (a GPU) (ZonkAny 1), Nat) -> (a GPU, Nat)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first Rep (a GPU) (ZonkAny 1) -> a GPU
forall a x. Generic a => Rep a x -> a
forall x. Rep (a GPU) x -> a GPU
to ((Rep (a GPU) (ZonkAny 1), Nat) -> (a GPU, Nat))
-> (Rep (a GPU) (ZonkAny 1), Nat) -> (a GPU, Nat)
forall a b. (a -> b) -> a -> b
$ forall {k} {k} (f :: k) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
forall (f :: * -> *) (g :: * -> *) p.
GDummyBinding f g =>
Nat -> (g p, Nat)
gDummyBinding @(Rep (a Internal)) @(Rep (a GPU)) Nat
n

data ErasedBinding where
  ErasedBinding :: forall b (a :: Type) m. (Typeable m, Bindable b, Typeable b, Typeable a) => {()
materialType :: m, ()
material :: Proxy a, ()
binding :: Proxy b} -> ErasedBinding

instance Eq ErasedBinding where
  ErasedBinding m
_ Proxy a
a Proxy b
_ == :: ErasedBinding -> ErasedBinding -> Bool
== ErasedBinding m
_ Proxy a
b Proxy b
_ = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b

instance Ord ErasedBinding where
  compare :: ErasedBinding -> ErasedBinding -> Ordering
compare (ErasedBinding m
_ Proxy a
a Proxy b
_) (ErasedBinding m
_ Proxy a
b Proxy b
_) = TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a) (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b)

data ErasedBindingValue where
  ErasedBindingValue :: (Bindable b, Typeable b) => b CPU -> ErasedBindingValue

class CollectBindings a where
  collectBinding :: Proxy a -> Nat -> BindingData
  collectLayout :: Proxy a -> Nat -> WGPUBindGroupLayoutEntry

class GCollectBindings f where
  gCollectBindings :: Proxy f -> Nat -> (Bindings, Nat)
  gCollectLayouts :: Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)

instance GCollectBindings V1 where
  gCollectBindings :: Proxy V1 -> Nat -> (Bindings, Nat)
gCollectBindings Proxy V1
_ Nat
n = ([BindingData] -> Bindings
Bindings [], Nat
n)
  gCollectLayouts :: Proxy V1 -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts Proxy V1
_ Nat
n = ([], Nat
n)

instance GCollectBindings U1 where
  gCollectBindings :: Proxy U1 -> Nat -> (Bindings, Nat)
gCollectBindings Proxy U1
_ Nat
n = ([BindingData] -> Bindings
Bindings [], Nat
n)
  gCollectLayouts :: Proxy U1 -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts Proxy U1
_ Nat
n = ([], Nat
n)

instance (GCollectBindings f, GCollectBindings g) => GCollectBindings (f :*: g) where
  gCollectBindings :: Proxy (f :*: g) -> Nat -> (Bindings, Nat)
gCollectBindings Proxy (f :*: g)
_ Nat
n = do
    let (Bindings
a, Nat
n') = Proxy f -> Nat -> (Bindings, Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> (Bindings, Nat)
gCollectBindings (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @f) Nat
n
    let (Bindings
b, Nat
n'') = Proxy g -> Nat -> (Bindings, Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> (Bindings, Nat)
gCollectBindings (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @g) Nat
n'
    (Bindings
a Bindings -> Bindings -> Bindings
forall a. Semigroup a => a -> a -> a
<> Bindings
b, Nat
n'')
  gCollectLayouts :: Proxy (f :*: g) -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts Proxy (f :*: g)
_ Nat
n = do
    let ([WGPUBindGroupLayoutEntry]
a, Nat
n') = Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @f) Nat
n
    let ([WGPUBindGroupLayoutEntry]
b, Nat
n'') = Proxy g -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @g) Nat
n'
    ([WGPUBindGroupLayoutEntry]
a [WGPUBindGroupLayoutEntry]
-> [WGPUBindGroupLayoutEntry] -> [WGPUBindGroupLayoutEntry]
forall a. Semigroup a => a -> a -> a
<> [WGPUBindGroupLayoutEntry]
b, Nat
n'')

instance (CollectBindings c) => GCollectBindings (K1 i c) where
  gCollectBindings :: Proxy (K1 i c) -> Nat -> (Bindings, Nat)
gCollectBindings Proxy (K1 i c)
_ Nat
n = ([BindingData] -> Bindings
Bindings [Proxy c -> Nat -> BindingData
forall {k} (a :: k).
CollectBindings a =>
Proxy a -> Nat -> BindingData
collectBinding (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) Nat
n], Nat
n Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1)
  gCollectLayouts :: Proxy (K1 i c) -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts Proxy (K1 i c)
_ Nat
n = ([Proxy c -> Nat -> WGPUBindGroupLayoutEntry
forall {k} (a :: k).
CollectBindings a =>
Proxy a -> Nat -> WGPUBindGroupLayoutEntry
collectLayout (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) Nat
n], Nat
n Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1)

instance (GCollectBindings f) => GCollectBindings (M1 i t f) where
  gCollectBindings :: Proxy (M1 i t f) -> Nat -> (Bindings, Nat)
gCollectBindings Proxy (M1 i t f)
_ = Proxy f -> Nat -> (Bindings, Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> (Bindings, Nat)
gCollectBindings (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @f)
  gCollectLayouts :: Proxy (M1 i t f) -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts Proxy (M1 i t f)
_ = Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
forall {k} (f :: k).
GCollectBindings f =>
Proxy f -> Nat -> ([WGPUBindGroupLayoutEntry], Nat)
gCollectLayouts (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @f)

instance CollectBindings (NormalBinding Sampler) where
  collectBinding :: Proxy (NormalBinding Sampler) -> Nat -> BindingData
collectBinding Proxy (NormalBinding Sampler)
_ Nat
n = NormalData {bType :: Text
bType = String -> Text
T.pack String
"sampler", index :: Integer
index = Nat -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n}
  collectLayout :: Proxy (NormalBinding Sampler) -> Nat -> WGPUBindGroupLayoutEntry
collectLayout Proxy (NormalBinding Sampler)
_ Nat
n =
    WGPUBindGroupLayoutEntry
      { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
        binding :: Word32
binding = Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n,
        visibility :: WGPUShaderStage
visibility = WGPUShaderStage
wGPUShaderStage_Fragment WGPUShaderStage -> WGPUShaderStage -> WGPUShaderStage
forall a. Bits a => a -> a -> a
.|. WGPUShaderStage
wGPUShaderStage_Vertex,
        bindingArraySize :: Word32
bindingArraySize = Word32
0,
        buffer :: WGPUBufferBindingLayout
buffer = WGPUBufferBindingLayout
unusedBufferLayout,
        storageTexture :: WGPUStorageTextureBindingLayout
storageTexture = WGPUStorageTextureBindingLayout
unusedStorageTextureLayout,
        texture :: WGPUTextureBindingLayout
texture = WGPUTextureBindingLayout
unusedTextureLayout,
        sampler :: WGPUSamplerBindingLayout
sampler =
          WGPUSamplerBindingLayout
            { _type :: WGPUSamplerBindingType
_type = WGPUSamplerBindingType
wGPUSamplerBindingType_Filtering,
              nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr
            }
      }

instance CollectBindings (NormalBinding Texture) where
  collectBinding :: Proxy (NormalBinding Texture) -> Nat -> BindingData
collectBinding Proxy (NormalBinding Texture)
_ Nat
n = NormalData {bType :: Text
bType = String -> Text
T.pack String
"texture_2d<f32>", index :: Integer
index = Nat -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n}
  collectLayout :: Proxy (NormalBinding Texture) -> Nat -> WGPUBindGroupLayoutEntry
collectLayout Proxy (NormalBinding Texture)
_ Nat
n =
    WGPUBindGroupLayoutEntry
      { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
        binding :: Word32
binding = Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n,
        visibility :: WGPUShaderStage
visibility = WGPUShaderStage
wGPUShaderStage_Fragment WGPUShaderStage -> WGPUShaderStage -> WGPUShaderStage
forall a. Bits a => a -> a -> a
.|. WGPUShaderStage
wGPUShaderStage_Vertex,
        bindingArraySize :: Word32
bindingArraySize = Word32
0,
        buffer :: WGPUBufferBindingLayout
buffer = WGPUBufferBindingLayout
unusedBufferLayout,
        sampler :: WGPUSamplerBindingLayout
sampler = WGPUSamplerBindingLayout
unusedSamplerLayout,
        storageTexture :: WGPUStorageTextureBindingLayout
storageTexture = WGPUStorageTextureBindingLayout
unusedStorageTextureLayout,
        texture :: WGPUTextureBindingLayout
texture =
          WGPUTextureBindingLayout
            { sampleType :: WGPUTextureSampleType
sampleType = WGPUTextureSampleType
wGPUTextureSampleType_Float,
              multisampled :: WGPUBool
multisampled = WGPUBool
wgpuFalse,
              viewDimension :: WGPUTextureViewDimension
viewDimension = WGPUTextureViewDimension
wGPUTextureViewDimension_2D,
              nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr
            }
      }

instance (Buffers.Bufferable a, Typeable a) => CollectBindings (UniformBinding (a Internal)) where
  collectBinding :: Proxy (UniformBinding (a Internal)) -> Nat -> BindingData
collectBinding Proxy (UniformBinding (a Internal))
_ Nat
n =
    UniformData
      { structName :: Text
structName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @a),
        structFields :: [(Text, Text)]
structFields = forall (a :: * -> *). Bufferable a => [(Text, Text)]
Buffers.getFields @a,
        index :: Integer
index = Nat -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n
      }

  collectLayout :: Proxy (UniformBinding (a Internal))
-> Nat -> WGPUBindGroupLayoutEntry
collectLayout Proxy (UniformBinding (a Internal))
_ Nat
n =
    WGPUBindGroupLayoutEntry
      { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
        binding :: Word32
binding = Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n,
        visibility :: WGPUShaderStage
visibility = WGPUShaderStage
wGPUShaderStage_Fragment WGPUShaderStage -> WGPUShaderStage -> WGPUShaderStage
forall a. Bits a => a -> a -> a
.|. WGPUShaderStage
wGPUShaderStage_Vertex,
        bindingArraySize :: Word32
bindingArraySize = Word32
0,
        buffer :: WGPUBufferBindingLayout
buffer =
          WGPUBufferBindingLayout
            { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
              _type :: WGPUBufferBindingType
_type = WGPUBufferBindingType
wGPUBufferBindingType_Uniform,
              hasDynamicOffset :: WGPUBool
hasDynamicOffset = WGPUBool
wgpuFalse,
              minBindingSize :: Word64
minBindingSize = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *). Bufferable a => Int
Buffers.getSize @a
            },
        sampler :: WGPUSamplerBindingLayout
sampler = WGPUSamplerBindingLayout
unusedSamplerLayout,
        storageTexture :: WGPUStorageTextureBindingLayout
storageTexture = WGPUStorageTextureBindingLayout
unusedStorageTextureLayout,
        texture :: WGPUTextureBindingLayout
texture = WGPUTextureBindingLayout
unusedTextureLayout
      }

class CollectEntry a n where
  collectEntry :: a -> Nat -> WGPUBindGroupEntry

class GCollectEntries f g where
  gCollectEntries :: f p -> Nat -> ([WGPUBindGroupEntry], Nat)

instance GCollectEntries V1 V1 where
  gCollectEntries :: forall (p :: k). V1 p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries V1 p
_ Nat
n = ([], Nat
n)

instance GCollectEntries U1 U1 where
  gCollectEntries :: forall (p :: k). U1 p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries U1 p
_ Nat
n = ([], Nat
n)

instance (GCollectEntries f1 g1, GCollectEntries f2 g2) => GCollectEntries (f1 :*: f2) (g1 :*: g2) where
  gCollectEntries :: forall (p :: k).
(:*:) f1 f2 p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries (f1 p
f :*: f2 p
g) Nat
n = do
    let ([WGPUBindGroupEntry]
a, Nat
n') = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
forall (f :: k -> *) (g :: k -> *) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries @f1 @g1 f1 p
f Nat
n
    let ([WGPUBindGroupEntry]
b, Nat
n'') = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
forall (f :: k -> *) (g :: k -> *) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries @f2 @g2 f2 p
g Nat
n'
    ([WGPUBindGroupEntry]
a [WGPUBindGroupEntry]
-> [WGPUBindGroupEntry] -> [WGPUBindGroupEntry]
forall a. Semigroup a => a -> a -> a
<> [WGPUBindGroupEntry]
b, Nat
n'')

instance (CollectEntry c n) => GCollectEntries (K1 i c) (K1 i n) where
  gCollectEntries :: forall (p :: k). K1 i c p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries (K1 c
a) Nat
n = ([forall a n. CollectEntry a n => a -> Nat -> WGPUBindGroupEntry
forall {k} a (n :: k).
CollectEntry a n =>
a -> Nat -> WGPUBindGroupEntry
collectEntry @c @n c
a Nat
n], Nat
n Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1)

instance (GCollectEntries f n) => GCollectEntries (M1 i t f) (M1 i t n) where
  gCollectEntries :: forall (p :: k). M1 i t f p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries (M1 f p
a) = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
forall (f :: k -> *) (g :: k -> *) (p :: k).
GCollectEntries f g =>
f p -> Nat -> ([WGPUBindGroupEntry], Nat)
gCollectEntries @f @n f p
a

instance CollectEntry TextureView (NormalBinding b) where
  collectEntry :: TextureView -> Nat -> WGPUBindGroupEntry
collectEntry (TextureView Ptr WGPUTextureView
textureView) Nat
n =
    WGPUBindGroupEntry
      { binding :: Word32
binding = Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n,
        Ptr WGPUTextureView
textureView :: Ptr WGPUTextureView
textureView :: Ptr WGPUTextureView
textureView,
        size :: Word64
size = Word64
0,
        offset :: Word64
offset = Word64
0,
        sampler :: Ptr WGPUSampler
sampler = Ptr WGPUSampler
forall a. Ptr a
nullPtr,
        buffer :: Ptr WGPUBuffer
buffer = Ptr WGPUBuffer
forall a. Ptr a
nullPtr,
        nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr
      }

instance CollectEntry Sampler (NormalBinding b) where
  collectEntry :: Sampler -> Nat -> WGPUBindGroupEntry
collectEntry (Sampler Ptr WGPUSampler
sampler) Nat
n =
    WGPUBindGroupEntry
      { binding :: Word32
binding = Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n,
        textureView :: Ptr WGPUTextureView
textureView = Ptr WGPUTextureView
forall a. Ptr a
nullPtr,
        size :: Word64
size = Word64
0,
        offset :: Word64
offset = Word64
0,
        Ptr WGPUSampler
sampler :: Ptr WGPUSampler
sampler :: Ptr WGPUSampler
sampler,
        buffer :: Ptr WGPUBuffer
buffer = Ptr WGPUBuffer
forall a. Ptr a
nullPtr,
        nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr
      }

instance CollectEntry (Buffer a) (UniformBinding b) where
  collectEntry :: Buffer a -> Nat -> WGPUBindGroupEntry
collectEntry Buffer {Ptr WGPUBuffer
buffer :: Ptr WGPUBuffer
buffer :: forall {k} (a :: k). Buffer a -> Ptr WGPUBuffer
buffer, desc :: forall {k} (a :: k). Buffer a -> BufferDescriptor
desc = BufferDescriptor {Int
size :: Int
size :: BufferDescriptor -> Int
size}} Nat
n =
    WGPUBindGroupEntry
      { binding :: Word32
binding = Nat -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n,
        textureView :: Ptr WGPUTextureView
textureView = Ptr WGPUTextureView
forall a. Ptr a
nullPtr,
        size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size,
        offset :: Word64
offset = Word64
0,
        sampler :: Ptr WGPUSampler
sampler = Ptr WGPUSampler
forall a. Ptr a
nullPtr,
        Ptr WGPUBuffer
buffer :: Ptr WGPUBuffer
buffer :: Ptr WGPUBuffer
buffer,
        nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr
      }

class DummyBinding a b where
  dummyBinding' :: Nat -> b

class GDummyBinding f g where
  gDummyBinding :: Nat -> (g p, Nat)

instance GDummyBinding V1 V1 where
  gDummyBinding :: forall (p :: k). Nat -> (V1 p, Nat)
gDummyBinding = Nat -> (V1 p, Nat)
forall a. HasCallStack => a
undefined

instance GDummyBinding U1 U1 where
  gDummyBinding :: forall (p :: k). Nat -> (U1 p, Nat)
gDummyBinding Nat
n = (U1 p
forall k (p :: k). U1 p
U1, Nat
n)

instance (GDummyBinding f1 g1, GDummyBinding f2 g2) => GDummyBinding (f1 :*: f2) (g1 :*: g2) where
  gDummyBinding :: forall (p :: k). Nat -> ((:*:) g1 g2 p, Nat)
gDummyBinding Nat
n = do
    let (g1 p
a, Nat
n') = forall {k} {k} (f :: k) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
forall (f :: k -> *) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
gDummyBinding @f1 @g1 Nat
n
    let (g2 p
b, Nat
n'') = forall {k} {k} (f :: k) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
forall (f :: k -> *) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
gDummyBinding @f2 @g2 Nat
n'
    (g1 p
a g1 p -> g2 p -> (:*:) g1 g2 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g2 p
b, Nat
n'')

instance (DummyBinding a b) => GDummyBinding (K1 i a) (K1 i b) where
  gDummyBinding :: forall (p :: k). Nat -> (K1 i b p, Nat)
gDummyBinding Nat
n = let a :: b
a = forall {k} (a :: k) b. DummyBinding a b => Nat -> b
forall a b. DummyBinding a b => Nat -> b
dummyBinding' @a @b Nat
n in (b -> K1 i b p
forall k i c (p :: k). c -> K1 i c p
K1 b
a, Nat
n Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1)

instance (GDummyBinding a b) => GDummyBinding (M1 i t a) (M1 i t b) where
  gDummyBinding :: forall (p :: k). Nat -> (M1 i t b p, Nat)
gDummyBinding Nat
n = let (b p
a, Nat
n') = forall {k} {k} (f :: k) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
forall (f :: k -> *) (g :: k -> *) (p :: k).
GDummyBinding f g =>
Nat -> (g p, Nat)
gDummyBinding @a @b Nat
n in (b p -> M1 i t b p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 b p
a, Nat
n')

instance (SingI b) => DummyBinding (NormalBinding a) (Expr b) where
  dummyBinding' :: Nat -> Expr b
dummyBinding' Nat
n = Integer -> Expr b
forall (a :: Types). SingI a => Integer -> Expr a
BindingVar (Nat -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n)

instance (Buffers.Bufferable a) => DummyBinding (UniformBinding (a Internal)) (a GPU) where
  dummyBinding' :: Nat -> a GPU
dummyBinding' Nat
n = forall (a :: * -> *). Bufferable a => Integer -> a GPU
Buffers.dummyBuffer @a (Nat -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
n)

-- instance (KnownNat n) => Bindable (UniformBinding n Sampler) where
--   collectBindings _ = Bindings [BindingData {bType = T.pack "sampler", index = natVal (Proxy @n)}]
--   collectLayouts _ =
--     [ WGPUBindGroupLayoutEntry
--         { nextInChain = nullPtr,
--           binding = fromInteger (natVal (Proxy @n)),
--           visibility = wGPUShaderStage_Fragment,
--           bindingArraySize = 0,
--           buffer = unusedBufferLayout,
--           storageTexture = unusedStorageTextureLayout,
--           texture = unusedTextureLayout,
--           sampler =
--             WGPUSamplerBindingLayout
--               { _type = wGPUSamplerBindingType_Filtering,
--                 nextInChain = nullPtr
--               }
--         }
--     ]

--   collectEntries (UniformBinding a) = [bind a]

-- -- instance (KnownNat n, SingI b, f Internal ~ UniformBinding n a', f GPU ~ Expr b) => ToDummy f where
-- --   dummyB = BindingVar (natVal (Proxy @n))

-- instance (KnownNat n) => Bindable (UniformBinding n Texture) where
--   collectBindings _ = Bindings [BindingData {bType = T.pack "texture_2d<f32>", index = natVal (Proxy @n)}]
--   collectLayouts _ =
--     [ WGPUBindGroupLayoutEntry
--         { nextInChain = nullPtr,
--           binding = fromInteger (natVal (Proxy @n)),
--           visibility = wGPUShaderStage_Fragment,
--           bindingArraySize = 0,
--           buffer = unusedBufferLayout,
--           sampler = unusedSamplerLayout,
--           storageTexture = unusedStorageTextureLayout,
--           texture =
--             WGPUTextureBindingLayout
--               { sampleType = wGPUTextureSampleType_Float,
--                 multisampled = wgpuFalse,
--                 viewDimension = wGPUTextureViewDimension_2D,
--                 nextInChain = nullPtr
--               }
--         }
--     ]

--   collectEntries (UniformBinding a) = [bind a]

-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))

-- instance Bindable ()

-- instance (KnownNat n, SingI (Primitive a)) => Bindable (UniformBinding n (Expr (Primitive a))) where
--   collectBindings _ = Bindings [BindingData {bType = typeToWGSL (undefined :: Expr (Primitive a)), index = natVal (Proxy @n)}]
--   collectLayouts _ = undefined

--   collectEntries (UniformBinding a) = [bind a]

-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))

-- instance (KnownNat n, SingI (VectorType m a)) => Bindable (UniformBinding n (Expr (VectorType m a))) where
--   collectBindings _ = Bindings [BindingData {bType = typeToWGSL (undefined :: Expr (VectorType m a)), index = natVal (Proxy @n)}]
--   collectLayouts _ = undefined

--   collectEntries (UniformBinding a) = [bind a]

-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))

-- instance (KnownNat n, SingI (ArrayType m a)) => Bindable (UniformBinding n (Expr (ArrayType m a))) where
--   collectBindings _ = Bindings [BindingData {bType = typeToWGSL (undefined :: Expr (ArrayType m a)), index = natVal (Proxy @n)}]
--   collectLayouts _ = undefined

--   collectEntries (UniformBinding a) = [bind a]

-- -- dummyB = Binding $ BindingVar (natVal (Proxy @n))

collectAllLayouts :: Nat -> [ErasedBinding] -> [WGPUBindGroupLayoutEntry]
collectAllLayouts :: Nat -> [ErasedBinding] -> [WGPUBindGroupLayoutEntry]
collectAllLayouts Nat
_ [] = []
collectAllLayouts Nat
n (ErasedBinding m
_ (Proxy a
_ :: Proxy m) (Proxy b
_ :: Proxy b) : [ErasedBinding]
xs) =
  let ([WGPUBindGroupLayoutEntry]
x, Nat
n') = Nat -> Proxy (b Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
forall (a :: * -> *).
Bindable a =>
Nat -> Proxy (a Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
collectLayouts Nat
n (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(b Internal))
   in [WGPUBindGroupLayoutEntry]
x [WGPUBindGroupLayoutEntry]
-> [WGPUBindGroupLayoutEntry] -> [WGPUBindGroupLayoutEntry]
forall a. [a] -> [a] -> [a]
++ Nat -> [ErasedBinding] -> [WGPUBindGroupLayoutEntry]
collectAllLayouts Nat
n' [ErasedBinding]
xs

createBindLayout :: [ErasedBinding] -> RenderDevice -> IO BindLayout
createBindLayout :: [ErasedBinding] -> RenderDevice -> IO BindLayout
createBindLayout [ErasedBinding]
b (RenderDevice Ptr WGPUDevice
device) = do
  let layouts :: Vector WGPUBindGroupLayoutEntry
layouts = [WGPUBindGroupLayoutEntry] -> Vector WGPUBindGroupLayoutEntry
forall a. Storable a => [a] -> Vector a
VS.fromList ([WGPUBindGroupLayoutEntry] -> Vector WGPUBindGroupLayoutEntry)
-> [WGPUBindGroupLayoutEntry] -> Vector WGPUBindGroupLayoutEntry
forall a b. (a -> b) -> a -> b
$ Nat -> [ErasedBinding] -> [WGPUBindGroupLayoutEntry]
collectAllLayouts Nat
0 [ErasedBinding]
b

  String -> (WGPUStringView -> IO BindLayout) -> IO BindLayout
forall a. String -> (WGPUStringView -> IO a) -> IO a
withWGPUString String
"bind group layout" ((WGPUStringView -> IO BindLayout) -> IO BindLayout)
-> (WGPUStringView -> IO BindLayout) -> IO BindLayout
forall a b. (a -> b) -> a -> b
$ \WGPUStringView
label -> do
    x <- Vector WGPUBindGroupLayoutEntry
-> (Ptr WGPUBindGroupLayoutEntry -> IO (Ptr WGPUBindGroupLayout))
-> IO (Ptr WGPUBindGroupLayout)
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector WGPUBindGroupLayoutEntry
layouts ((Ptr WGPUBindGroupLayoutEntry -> IO (Ptr WGPUBindGroupLayout))
 -> IO (Ptr WGPUBindGroupLayout))
-> (Ptr WGPUBindGroupLayoutEntry -> IO (Ptr WGPUBindGroupLayout))
-> IO (Ptr WGPUBindGroupLayout)
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUBindGroupLayoutEntry
entries -> do
      let desc :: WGPUBindGroupLayoutDescriptor
desc =
            WGPUBindGroupLayoutDescriptor
              { entryCount :: CSize
entryCount = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Vector WGPUBindGroupLayoutEntry -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector WGPUBindGroupLayoutEntry
layouts,
                entries :: ConstPtr WGPUBindGroupLayoutEntry
entries = Ptr WGPUBindGroupLayoutEntry -> ConstPtr WGPUBindGroupLayoutEntry
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr WGPUBindGroupLayoutEntry
entries,
                WGPUStringView
label :: WGPUStringView
label :: WGPUStringView
label,
                nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr
              }
      WGPUBindGroupLayoutDescriptor
-> (Ptr WGPUBindGroupLayoutDescriptor
    -> IO (Ptr WGPUBindGroupLayout))
-> IO (Ptr WGPUBindGroupLayout)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with WGPUBindGroupLayoutDescriptor
desc ((Ptr WGPUBindGroupLayoutDescriptor
  -> IO (Ptr WGPUBindGroupLayout))
 -> IO (Ptr WGPUBindGroupLayout))
-> (Ptr WGPUBindGroupLayoutDescriptor
    -> IO (Ptr WGPUBindGroupLayout))
-> IO (Ptr WGPUBindGroupLayout)
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUBindGroupLayoutDescriptor
desc -> Ptr WGPUDevice
-> ConstPtr WGPUBindGroupLayoutDescriptor
-> IO (Ptr WGPUBindGroupLayout)
wgpuDeviceCreateBindGroupLayout Ptr WGPUDevice
device (Ptr WGPUBindGroupLayoutDescriptor
-> ConstPtr WGPUBindGroupLayoutDescriptor
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr WGPUBindGroupLayoutDescriptor
desc)

    pure (BindLayout x)

collectAllEntries :: Nat -> [ErasedBindingValue] -> [WGPUBindGroupEntry]
collectAllEntries :: Nat -> [ErasedBindingValue] -> [WGPUBindGroupEntry]
collectAllEntries Nat
_ [] = []
collectAllEntries Nat
n (ErasedBindingValue b CPU
b : [ErasedBindingValue]
xs) =
  let ([WGPUBindGroupEntry]
x, Nat
n') = Nat -> b CPU -> ([WGPUBindGroupEntry], Nat)
forall (a :: * -> *).
Bindable a =>
Nat -> a CPU -> ([WGPUBindGroupEntry], Nat)
collectEntries Nat
n b CPU
b
   in [WGPUBindGroupEntry]
x [WGPUBindGroupEntry]
-> [WGPUBindGroupEntry] -> [WGPUBindGroupEntry]
forall a. [a] -> [a] -> [a]
++ Nat -> [ErasedBindingValue] -> [WGPUBindGroupEntry]
collectAllEntries Nat
n' [ErasedBindingValue]
xs

createBindGroup :: RenderDevice -> BindLayout -> [ErasedBindingValue] -> IO (Ptr WGPUBindGroup)
createBindGroup :: RenderDevice
-> BindLayout -> [ErasedBindingValue] -> IO (Ptr WGPUBindGroup)
createBindGroup (RenderDevice Ptr WGPUDevice
device) (BindLayout Ptr WGPUBindGroupLayout
bindGroupLayout) [ErasedBindingValue]
b = do
  let entries :: Vector WGPUBindGroupEntry
entries = [WGPUBindGroupEntry] -> Vector WGPUBindGroupEntry
forall a. Storable a => [a] -> Vector a
VS.fromList ([WGPUBindGroupEntry] -> Vector WGPUBindGroupEntry)
-> [WGPUBindGroupEntry] -> Vector WGPUBindGroupEntry
forall a b. (a -> b) -> a -> b
$ Nat -> [ErasedBindingValue] -> [WGPUBindGroupEntry]
collectAllEntries Nat
0 [ErasedBindingValue]
b

  String
-> (WGPUStringView -> IO (Ptr WGPUBindGroup))
-> IO (Ptr WGPUBindGroup)
forall a. String -> (WGPUStringView -> IO a) -> IO a
withWGPUString String
"bind group" ((WGPUStringView -> IO (Ptr WGPUBindGroup))
 -> IO (Ptr WGPUBindGroup))
-> (WGPUStringView -> IO (Ptr WGPUBindGroup))
-> IO (Ptr WGPUBindGroup)
forall a b. (a -> b) -> a -> b
$ \WGPUStringView
label -> do
    Vector WGPUBindGroupEntry
-> (Ptr WGPUBindGroupEntry -> IO (Ptr WGPUBindGroup))
-> IO (Ptr WGPUBindGroup)
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector WGPUBindGroupEntry
entries ((Ptr WGPUBindGroupEntry -> IO (Ptr WGPUBindGroup))
 -> IO (Ptr WGPUBindGroup))
-> (Ptr WGPUBindGroupEntry -> IO (Ptr WGPUBindGroup))
-> IO (Ptr WGPUBindGroup)
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUBindGroupEntry
entries' -> do
      let desc :: WGPUBindGroupDescriptor
desc =
            WGPUBindGroupDescriptor
              { layout :: Ptr WGPUBindGroupLayout
layout = Ptr WGPUBindGroupLayout
bindGroupLayout,
                entryCount :: CSize
entryCount = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Vector WGPUBindGroupEntry -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector WGPUBindGroupEntry
entries,
                label :: WGPUStringView
label = WGPUStringView
label,
                nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
                entries :: ConstPtr WGPUBindGroupEntry
entries = Ptr WGPUBindGroupEntry -> ConstPtr WGPUBindGroupEntry
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr WGPUBindGroupEntry
entries'
              }

      WGPUBindGroupDescriptor
-> (Ptr WGPUBindGroupDescriptor -> IO (Ptr WGPUBindGroup))
-> IO (Ptr WGPUBindGroup)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with WGPUBindGroupDescriptor
desc ((Ptr WGPUBindGroupDescriptor -> IO (Ptr WGPUBindGroup))
 -> IO (Ptr WGPUBindGroup))
-> (Ptr WGPUBindGroupDescriptor -> IO (Ptr WGPUBindGroup))
-> IO (Ptr WGPUBindGroup)
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUBindGroupDescriptor
desc -> Ptr WGPUDevice
-> ConstPtr WGPUBindGroupDescriptor -> IO (Ptr WGPUBindGroup)
wgpuDeviceCreateBindGroup Ptr WGPUDevice
device (Ptr WGPUBindGroupDescriptor -> ConstPtr WGPUBindGroupDescriptor
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr WGPUBindGroupDescriptor
desc)

-- class (Bindable link) => ConvertBindings link where
--   type CpuBind link
--   type GpuBind link
--   toLink :: CpuBind link -> link
--   mkGpu :: GpuBind link

-- bind :: a -> WGPUBindGroupEntry
-- bind = undefined

-- instance (KnownNat n) => ConvertBindings (UniformBinding (n :: Nat) Texture) where
--   type CpuBind (UniformBinding (n :: Nat) Texture) = TextureView
--   type GpuBind (UniformBinding (n :: Nat) Texture) = Expr TTexture
--   toLink (TextureView view) =
--     Uniform
--       WGPUBindGroupEntry
--         { binding = fromInteger (natVal (Proxy @n)),
--           textureView = view,
--           size = 0,
--           offset = 0,
--           sampler = nullPtr,
--           buffer = nullPtr,
--           nextInChain = nullPtr
--         }

--   mkGpu = BindingVar (natVal (Proxy @n))

-- instance (KnownNat n) => ConvertBindings (Uniform (n :: Nat) Sampler) where
--   type CpuBind (Uniform (n :: Nat) Sampler) = Sampler
--   type GpuBind (Uniform (n :: Nat) Sampler) = Expr TSampler
--   toLink (Sampler sampler) =
--     Uniform
--       WGPUBindGroupEntry
--         { binding = fromInteger (natVal (Proxy @n)),
--           textureView = nullPtr,
--           size = 0,
--           offset = 0,
--           sampler = sampler,
--           buffer = nullPtr,
--           nextInChain = nullPtr
--         }

--   mkGpu = BindingVar (natVal (Proxy @n))

-- class GMkDummy i o where
--   gMkDummy :: o

-- instance GMkDummy (K1 a b c) (K1 a b c) where