{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.Shader.Internal.Buffers where

import Data.Data
import Data.Singletons (SingI)
import Data.Text (Text)
import Data.Text qualified as T
import Foreign (Bits (shiftR), Ptr, Storable (pokeElemOff), Word32, Word8)
import GHC.Float (castFloatToWord32)
import GHC.Generics
import GHC.TypeLits (KnownNat, Nat, natVal)
import Mischief.Math.Vec qualified as Math
import Mischief.Shader.Internal.Singletons
import Mischief.Shader.Internal.State
import Mischief.Shader.Types qualified as ST

-- import Mischief.WGPU.Types.General (WGPUBufferDescriptor (..))

data Field' a = Field'

type family Field f a where
  Field GPU a = a
  Field CPU a = ToCPU a
  Field Internal a = Field' a

type family ToCPU a where
  ToCPU ST.Int = Int
  ToCPU ST.Float = Float
  ToCPU (Expr (VectorType 2 a)) = Math.V2 (ToCPU (Expr (Primitive a)))
  ToCPU (Expr (VectorType 3 a)) = Math.V3 (ToCPU (Expr (Primitive a)))
  ToCPU (Expr (VectorType 4 a)) = Math.V4 (ToCPU (Expr (Primitive a)))
  ToCPU (Expr (MatrixType 2 n)) = Math.V2 (ToCPU (Expr (VectorType n TFloat)))
  ToCPU (Expr (MatrixType 3 n)) = Math.V3 (ToCPU (Expr (VectorType n TFloat)))
  ToCPU (Expr (MatrixType 4 n)) = Math.V4 (ToCPU (Expr (VectorType n TFloat)))

type family AlignmentOf a where
  AlignmentOf ST.Int = 4
  AlignmentOf ST.Float = 4
  AlignmentOf (Expr (VectorType 2 a)) = 8
  AlignmentOf (Expr (VectorType 3 a)) = 16
  AlignmentOf (Expr (VectorType 4 a)) = 16
  AlignmentOf (Expr (MatrixType n 2)) = 8
  AlignmentOf (Expr (MatrixType n m)) = 16

type family SizeOf a where
  SizeOf ST.Int = 4
  SizeOf ST.Float = 4
  SizeOf (Expr (VectorType 2 a)) = 8
  SizeOf (Expr (VectorType 3 a)) = 12
  SizeOf (Expr (VectorType 4 a)) = 16
  SizeOf (ST.Mat 2 2) = 16
  SizeOf (ST.Mat 3 2) = 24
  SizeOf (ST.Mat 4 2) = 32
  SizeOf (ST.Mat 3 3) = 48
  SizeOf (ST.Mat 4 3) = 64
  SizeOf (ST.Mat 2 4) = 32
  SizeOf (ST.Mat 3 4) = 48
  SizeOf (ST.Mat 4 4) = 64

newtype Size = Size Nat deriving newtype (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show, Integer -> Size
Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Integer -> Size)
-> Num Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c- :: Size -> Size -> Size
- :: Size -> Size -> Size
$c* :: Size -> Size -> Size
* :: Size -> Size -> Size
$cnegate :: Size -> Size
negate :: Size -> Size
$cabs :: Size -> Size
abs :: Size -> Size
$csignum :: Size -> Size
signum :: Size -> Size
$cfromInteger :: Integer -> Size
fromInteger :: Integer -> Size
Num, Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Eq Size
Eq Size =>
(Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$c< :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord)

newtype Alignment = Alignment Nat deriving newtype (Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alignment -> ShowS
showsPrec :: Int -> Alignment -> ShowS
$cshow :: Alignment -> String
show :: Alignment -> String
$cshowList :: [Alignment] -> ShowS
showList :: [Alignment] -> ShowS
Show, Integer -> Alignment
Alignment -> Alignment
Alignment -> Alignment -> Alignment
(Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Integer -> Alignment)
-> Num Alignment
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Alignment -> Alignment -> Alignment
+ :: Alignment -> Alignment -> Alignment
$c- :: Alignment -> Alignment -> Alignment
- :: Alignment -> Alignment -> Alignment
$c* :: Alignment -> Alignment -> Alignment
* :: Alignment -> Alignment -> Alignment
$cnegate :: Alignment -> Alignment
negate :: Alignment -> Alignment
$cabs :: Alignment -> Alignment
abs :: Alignment -> Alignment
$csignum :: Alignment -> Alignment
signum :: Alignment -> Alignment
$cfromInteger :: Integer -> Alignment
fromInteger :: Integer -> Alignment
Num, Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment =>
(Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Alignment -> Alignment -> Ordering
compare :: Alignment -> Alignment -> Ordering
$c< :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
>= :: Alignment -> Alignment -> Bool
$cmax :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
min :: Alignment -> Alignment -> Alignment
Ord)

newtype Offset = Offset Nat deriving newtype (Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Offset -> ShowS
showsPrec :: Int -> Offset -> ShowS
$cshow :: Offset -> String
show :: Offset -> String
$cshowList :: [Offset] -> ShowS
showList :: [Offset] -> ShowS
Show, Integer -> Offset
Offset -> Offset
Offset -> Offset -> Offset
(Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset)
-> (Offset -> Offset)
-> (Offset -> Offset)
-> (Integer -> Offset)
-> Num Offset
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Offset -> Offset -> Offset
+ :: Offset -> Offset -> Offset
$c- :: Offset -> Offset -> Offset
- :: Offset -> Offset -> Offset
$c* :: Offset -> Offset -> Offset
* :: Offset -> Offset -> Offset
$cnegate :: Offset -> Offset
negate :: Offset -> Offset
$cabs :: Offset -> Offset
abs :: Offset -> Offset
$csignum :: Offset -> Offset
signum :: Offset -> Offset
$cfromInteger :: Integer -> Offset
fromInteger :: Integer -> Offset
Num, Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
/= :: Offset -> Offset -> Bool
Eq, Eq Offset
Eq Offset =>
(Offset -> Offset -> Ordering)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> Ord Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Offset -> Offset -> Ordering
compare :: Offset -> Offset -> Ordering
$c< :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
>= :: Offset -> Offset -> Bool
$cmax :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
min :: Offset -> Offset -> Offset
Ord)

newtype BufferStruct = BufferStruct [(Text, Text)]

class Bufferable a where
  dummyBuffer :: Integer -> a GPU
  default dummyBuffer :: (Generic (a GPU), GDummyBuffer (Rep (a GPU))) => Integer -> a GPU
  dummyBuffer Integer
i =
    let (Rep (a GPU) (ZonkAny 0)
x, Offset
_) = forall {k} (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
forall (f :: * -> *) p.
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
gDummyBuffer @(Rep (a GPU)) Integer
i Offset
0
     in Rep (a GPU) (ZonkAny 0) -> a GPU
forall a x. Generic a => Rep a x -> a
forall x. Rep (a GPU) x -> a GPU
to Rep (a GPU) (ZonkAny 0)
x

  getFields :: [(Text, Text)]
  default getFields :: (GGetFields (Rep (a GPU))) => [(Text, Text)]
  getFields =
    let ([(Text, Text)]
t, Offset Nat
offset) = forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: * -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @(Rep (a GPU)) Offset
0
        t' :: [(Text, Text)]
t' = Nat -> [(Text, Text)]
roundTo16Pad Nat
offset
     in [(Text, Text)]
t [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
t'

  getSize :: Int
  default getSize :: (GGetFields (Rep (a GPU))) => Int
  getSize =
    let Offset Nat
offset = ([(Text, Text)], Offset) -> Offset
forall a b. (a, b) -> b
snd (([(Text, Text)], Offset) -> Offset)
-> ([(Text, Text)], Offset) -> Offset
forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: * -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @(Rep (a GPU)) Offset
0
     in Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> Nat -> Int
forall a b. (a -> b) -> a -> b
$ Nat -> Nat
roundTo16 Nat
offset

  putBytes :: a CPU -> Ptr Word8 -> IO Int
  default putBytes :: (GGetBytes (Rep (a CPU)) (Rep (a GPU)), Generic (a CPU)) => a CPU -> Ptr Word8 -> IO Int
  putBytes a CPU
a Ptr Word8
ptr = do
    Offset x <- forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
forall (f :: * -> *) (g :: * -> *) p.
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes @(Rep (a CPU)) @(Rep (a GPU)) (a CPU -> Rep (a CPU) (ZonkAny 1)
forall x. a CPU -> Rep (a CPU) x
forall a x. Generic a => a -> Rep a x
from a CPU
a) Ptr Word8
ptr Offset
0
    x' <- roundTo16Bytes ptr x
    pure $ fromIntegral x'

roundTo16 :: Nat -> Nat
roundTo16 :: Nat -> Nat
roundTo16 Nat
x | Nat
x Nat -> Nat -> Nat
forall a. Integral a => a -> a -> a
`mod` Nat
16 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 = Nat
x
roundTo16 Nat
x = Nat -> Nat
roundTo16 (Nat
x Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
4)

roundTo16Pad :: Nat -> [(Text, Text)]
roundTo16Pad :: Nat -> [(Text, Text)]
roundTo16Pad Nat
x | Nat
x Nat -> Nat -> Nat
forall a. Integral a => a -> a -> a
`mod` Nat
16 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 = []
roundTo16Pad Nat
x = (Text
"p" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Nat -> String
forall a. Show a => a -> String
show Nat
x), Text
"f32") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Nat -> [(Text, Text)]
roundTo16Pad (Nat
x Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
4)

roundTo16Bytes :: Ptr Word8 -> Nat -> IO Nat
roundTo16Bytes :: Ptr Word8 -> Nat -> IO Nat
roundTo16Bytes Ptr Word8
_ Nat
x | Nat
x Nat -> Nat -> Nat
forall a. Integral a => a -> a -> a
`mod` Nat
16 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 = Nat -> IO Nat
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nat
x
roundTo16Bytes Ptr Word8
ptr Nat
x = do
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x) Word8
0
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
0
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
0
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
0
  Ptr Word8 -> Nat -> IO Nat
roundTo16Bytes Ptr Word8
ptr (Nat
x Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
4)

addPadding :: Offset -> Alignment -> [(Text, Text)]
addPadding :: Offset -> Alignment -> [(Text, Text)]
addPadding (Offset Nat
x) (Alignment Nat
y) | Nat
x Nat -> Nat -> Nat
forall a. Integral a => a -> a -> a
`mod` Nat
y Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 = []
addPadding Offset
x Alignment
y = (Text
"p" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Offset -> String
forall a. Show a => a -> String
show Offset
x), Text
"f32") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Offset -> Alignment -> [(Text, Text)]
addPadding (Offset
x Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
4) Alignment
y

addPaddingBytes :: Offset -> Alignment -> Ptr Word8 -> IO Offset
addPaddingBytes :: Offset -> Alignment -> Ptr Word8 -> IO Offset
addPaddingBytes (Offset Nat
x) (Alignment Nat
y) Ptr Word8
_ | Nat
x Nat -> Nat -> Nat
forall a. Integral a => a -> a -> a
`mod` Nat
y Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 = Offset -> IO Offset
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nat -> Offset
Offset Nat
x)
addPaddingBytes (Offset Nat
x) Alignment
y Ptr Word8
ptr = do
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0) Word8
0
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
0
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
0
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
0
  Offset -> Alignment -> Ptr Word8 -> IO Offset
addPaddingBytes (Nat -> Offset
Offset (Nat -> Offset) -> Nat -> Offset
forall a b. (a -> b) -> a -> b
$ Nat
x Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
4) Alignment
y Ptr Word8
ptr

class GGetFields f where
  gGetFields :: Offset -> ([(Text, Text)], Offset)

instance GGetFields V1 where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields Offset
_ = ([(Text, Text)], Offset)
forall a. HasCallStack => a
undefined

instance GGetFields U1 where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields Offset
_ = ([], Offset
0)

instance (GGetFields f, GGetFields g) => GGetFields (f :*: g) where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields Offset
offset =
    let ([(Text, Text)]
t, Offset
offset') = forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: k -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @f Offset
offset
        ([(Text, Text)]
t2, Offset
offset'') = forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: k -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @g (Offset -> ([(Text, Text)], Offset))
-> Offset -> ([(Text, Text)], Offset)
forall a b. (a -> b) -> a -> b
$ Offset
offset'
     in ([(Text, Text)]
t [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
t2, Offset
offset'')

instance {-# OVERLAPPING #-} (SingI a, KnownNat size, KnownNat alignment, SizeOf (Expr a) ~ size, AlignmentOf (Expr a) ~ alignment) => GGetFields (S1 u (K1 i (Expr a))) where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields (Offset Nat
offset) =
    let alignment :: Nat
alignment = Integer -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Nat) -> Integer -> Nat
forall a b. (a -> b) -> a -> b
$ Proxy alignment -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @alignment)
        size :: Nat
size = Integer -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Nat) -> Integer -> Nat
forall a b. (a -> b) -> a -> b
$ Proxy size -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @size)
        t :: [(Text, Text)]
t = Offset -> Alignment -> [(Text, Text)]
addPadding (Nat -> Offset
Offset Nat
offset) (Nat -> Alignment
Alignment Nat
alignment)
     in ([(Text, Text)]
t [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"q" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Nat -> String
forall a. Show a => a -> String
show (Nat -> String) -> Nat -> String
forall a b. (a -> b) -> a -> b
$ Nat
offset Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Text, Text)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
t) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
4), Expr a -> Text
forall (a :: Types). SingI a => Expr a -> Text
typeToWGSL (Expr a
forall a. HasCallStack => a
undefined :: Expr a))], Nat -> Offset
Offset (Nat -> Offset) -> Nat -> Offset
forall a b. (a -> b) -> a -> b
$ Nat
offset Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
size Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Text, Text)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
t) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
4)

instance (GGetFields (Rep f)) => GGetFields (S1 a (K1 x f)) where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields = forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: * -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @(Rep f)

instance (GGetFields c) => GGetFields (C1 i c) where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields = forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: k -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @c

instance (GGetFields f) => GGetFields (D1 a f) where
  gGetFields :: Offset -> ([(Text, Text)], Offset)
gGetFields = forall {k} (f :: k).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
forall (f :: k -> *).
GGetFields f =>
Offset -> ([(Text, Text)], Offset)
gGetFields @f

class GetBytes a where
  getBytes :: ToCPU a -> [Word8]

class GGetBytes f g where
  gGetBytes :: f p -> Ptr Word8 -> Offset -> IO Offset

instance GGetBytes V1 V1 where
  gGetBytes :: forall (p :: k). V1 p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes V1 p
_ Ptr Word8
_ Offset
_ = IO Offset
forall a. HasCallStack => a
undefined

instance GGetBytes U1 U1 where
  gGetBytes :: forall (p :: k). U1 p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes U1 p
_ Ptr Word8
_ Offset
_ = Offset -> IO Offset
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset
0

instance (GGetBytes f1 g1, GGetBytes f2 g2) => GGetBytes (f1 :*: f2) (g1 :*: g2) where
  gGetBytes :: forall (p :: k). (:*:) f1 f2 p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes (f1 p
a :*: f2 p
b) Ptr Word8
ptr Offset
offset = do
    offset' <- forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
forall (f :: k -> *) (g :: k -> *) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes @f1 @g1 f1 p
a Ptr Word8
ptr Offset
offset
    gGetBytes @f2 @g2 b ptr offset'

instance {-# OVERLAPPING #-} (GetBytes (Expr b), KnownNat alignment, SizeOf (Expr b) ~ size, AlignmentOf (Expr b) ~ alignment, a ~ ToCPU (Expr b)) => GGetBytes (S1 u (K1 i a)) (S1 u (K1 i (Expr b))) where
  gGetBytes :: forall (p :: k).
S1 u (K1 i a) p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes (M1 (K1 a
a)) Ptr Word8
ptr Offset
offset = do
    let alignment :: Alignment
alignment = Integer -> Alignment
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Alignment) -> Integer -> Alignment
forall a b. (a -> b) -> a -> b
$ Proxy alignment -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @alignment)
    offset' <- Offset -> Alignment -> Ptr Word8 -> IO Offset
addPaddingBytes Offset
offset Alignment
alignment Ptr Word8
ptr
    let bytes = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr b) a
ToCPU (Expr b)
a
    addBytes bytes ptr offset'

addBytes :: [Word8] -> Ptr Word8 -> Offset -> IO Offset
addBytes :: [Word8] -> Ptr Word8 -> Offset -> IO Offset
addBytes [] Ptr Word8
_ Offset
x = Offset -> IO Offset
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset
x
addBytes (Word8
w : [Word8]
ws) Ptr Word8
ptr (Offset Nat
x) = do
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
x) Word8
w
  [Word8] -> Ptr Word8 -> Offset -> IO Offset
addBytes [Word8]
ws Ptr Word8
ptr (Nat -> Offset
Offset (Nat -> Offset) -> Nat -> Offset
forall a b. (a -> b) -> a -> b
$ Nat
x Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1)

-- (t <> [("var", typeToWGSL (undefined :: Expr a))], Offset $ offset + size + fromIntegral (length t) * 4)

instance (GGetBytes (Rep f) (Rep g), Generic f) => GGetBytes (S1 a (K1 x f)) (S1 a' (K1 x' g)) where
  gGetBytes :: forall (p :: k).
S1 a (K1 x f) p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes (M1 (K1 f
a)) = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
forall (f :: * -> *) (g :: * -> *) p.
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes @(Rep f) @(Rep g) (f -> Rep f (ZonkAny 3)
forall x. f -> Rep f x
forall a x. Generic a => a -> Rep a x
from f
a)

instance (GGetBytes f g) => GGetBytes (C1 i f) (C1 i' g) where
  gGetBytes :: forall (p :: k). C1 i f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes (M1 f p
a) = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
forall (f :: k -> *) (g :: k -> *) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes @f @g f p
a

instance (GGetBytes f g) => GGetBytes (D1 a f) (D1 a' g) where
  gGetBytes :: forall (p :: k). D1 a f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes (M1 f p
a) = forall {k} {k} (f :: k -> *) (g :: k) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
forall (f :: k -> *) (g :: k -> *) (p :: k).
GGetBytes f g =>
f p -> Ptr Word8 -> Offset -> IO Offset
gGetBytes @f @g f p
a

word32ToWords8 :: Word32 -> [Word8]
-- word32ToWords8 x = [fromIntegral (x `shiftR` 24), fromIntegral (x `shiftR` 16), fromIntegral (x `shiftR` 8), fromIntegral x]
word32ToWords8 :: Word32 -> [Word8]
word32ToWords8 Word32
x = [Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
x Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8), Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
x Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16), Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
x Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)]

instance GetBytes ST.Int where
  getBytes :: ToCPU Int -> [Word8]
getBytes ToCPU Int
a = Word32 -> [Word8]
word32ToWords8 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ToCPU Int
a)

instance GetBytes ST.Float where
  getBytes :: ToCPU Float -> [Word8]
getBytes ToCPU Float
a = Word32 -> [Word8]
word32ToWords8 (Float -> Word32
castFloatToWord32 Float
ToCPU Float
a)

instance (GetBytes (Expr (Primitive b))) => GetBytes (Expr (VectorType 2 b)) where
  getBytes :: ToCPU (Expr ('VectorType 2 b)) -> [Word8]
getBytes (Math.V2 ToCPU (Expr ('Primitive b))
a ToCPU (Expr ('Primitive b))
b) = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
b

instance (GetBytes (Expr (Primitive b))) => GetBytes (Expr (VectorType 3 b)) where
  getBytes :: ToCPU (Expr ('VectorType 3 b)) -> [Word8]
getBytes (Math.V3 ToCPU (Expr ('Primitive b))
a ToCPU (Expr ('Primitive b))
b ToCPU (Expr ('Primitive b))
c) = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
b [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
c

instance (GetBytes (Expr (Primitive b))) => GetBytes (Expr (VectorType 4 b)) where
  getBytes :: ToCPU (Expr ('VectorType 4 b)) -> [Word8]
getBytes (Math.V4 ToCPU (Expr ('Primitive b))
a ToCPU (Expr ('Primitive b))
b ToCPU (Expr ('Primitive b))
c ToCPU (Expr ('Primitive b))
d) = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
b [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
c [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (Primitive b)) ToCPU (Expr ('Primitive b))
d

instance (GetBytes (Expr (VectorType a TFloat)), ToCPU (Expr (MatrixType 2 a)) ~ Math.V2 v0, MatFillerBytes a) => GetBytes (Expr (MatrixType 2 a)) where
  getBytes :: ToCPU (Expr ('MatrixType 2 a)) -> [Word8]
getBytes (Math.V2 v0
a v0
b) = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
b [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a

instance (GetBytes (Expr (VectorType a TFloat)), ToCPU (Expr (MatrixType 3 a)) ~ Math.V3 v0, MatFillerBytes a) => GetBytes (Expr (MatrixType 3 a)) where
  getBytes :: ToCPU (Expr ('MatrixType 3 a)) -> [Word8]
getBytes (Math.V3 v0
a v0
b v0
c) = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
b [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
c [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a

instance (GetBytes (Expr (VectorType a TFloat)), ToCPU (Expr (MatrixType 4 a)) ~ Math.V4 v0, MatFillerBytes a) => GetBytes (Expr (MatrixType 4 a)) where
  getBytes :: ToCPU (Expr ('MatrixType 4 a)) -> [Word8]
getBytes (Math.V4 v0
a v0
b v0
c v0
d) = forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
b [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
c [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall a. GetBytes a => ToCPU a -> [Word8]
getBytes @(Expr (VectorType a TFloat)) v0
ToCPU (Expr ('VectorType a 'TFloat))
d [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ forall (n :: Nat). MatFillerBytes n => [Word8]
matFillerBytes @a

class MatFillerBytes (n :: Nat) where
  matFillerBytes :: [Word8]

instance MatFillerBytes 2 where
  matFillerBytes :: [Word8]
matFillerBytes = []

instance MatFillerBytes 3 where
  matFillerBytes :: [Word8]
matFillerBytes = [Word8
0, Word8
0, Word8
0, Word8
0]

instance MatFillerBytes 4 where
  matFillerBytes :: [Word8]
matFillerBytes = []

class GDummyBuffer f where
  gDummyBuffer :: Integer -> Offset -> (f p, Offset)

instance GDummyBuffer V1 where
  gDummyBuffer :: forall (p :: k). Integer -> Offset -> (V1 p, Offset)
gDummyBuffer = Integer -> Offset -> (V1 p, Offset)
forall a. HasCallStack => a
undefined

instance GDummyBuffer U1 where
  gDummyBuffer :: forall (p :: k). Integer -> Offset -> (U1 p, Offset)
gDummyBuffer Integer
_ Offset
_ = (U1 p
forall k (p :: k). U1 p
U1, Offset
0)

instance (GDummyBuffer f, GDummyBuffer g) => GDummyBuffer (f :*: g) where
  gDummyBuffer :: forall (p :: k). Integer -> Offset -> ((:*:) f g p, Offset)
gDummyBuffer Integer
index Offset
offset = do
    let (f p
f, Offset
offset') = forall {k} (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
forall (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
gDummyBuffer @f Integer
index Offset
offset
    let (g p
g, Offset
offset'') = forall {k} (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
forall (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
gDummyBuffer @g Integer
index Offset
offset'
    (f p
f f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
g, Offset
offset'')

instance (GDummyBuffer f) => GDummyBuffer (D1 (MetaData s a b c) f) where
  gDummyBuffer :: forall (p :: k).
Integer -> Offset -> (D1 ('MetaData s a b c) f p, Offset)
gDummyBuffer Integer
index Offset
offset = do
    let (f p
f, Offset
offset') = forall {k} (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
forall (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
gDummyBuffer @f Integer
index Offset
offset
    (f p -> M1 D ('MetaData s a b c) f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f p
f, Offset
offset')

instance {-# OVERLAPPING #-} (KnownNat size, KnownNat alignment, SizeOf (Expr a) ~ size, AlignmentOf (Expr a) ~ alignment) => GDummyBuffer (S1 b (K1 x (Expr a))) where
  gDummyBuffer :: forall (p :: k).
Integer -> Offset -> (S1 b (K1 x (Expr a)) p, Offset)
gDummyBuffer Integer
index Offset
offset = do
    let alignment :: Nat
alignment = Integer -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Nat) -> Integer -> Nat
forall a b. (a -> b) -> a -> b
$ Proxy alignment -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @alignment)
    let size :: Integer
size = Proxy size -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @size)
    let t :: [(Text, Text)]
t = Offset -> Alignment -> [(Text, Text)]
addPadding Offset
offset (Nat -> Alignment
Alignment Nat
alignment)
    let offset' :: Offset
offset' = Offset
offset Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Nat -> Offset
Offset (Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Nat) -> Int -> Nat
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
t) Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
* Offset
4
    (K1 x (Expr a) p -> M1 S b (K1 x (Expr a)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 x (Expr a) p -> M1 S b (K1 x (Expr a)) p)
-> K1 x (Expr a) p -> M1 S b (K1 x (Expr a)) p
forall a b. (a -> b) -> a -> b
$ Expr a -> K1 x (Expr a) p
forall k i c (p :: k). c -> K1 i c p
K1 (Expr a -> K1 x (Expr a) p) -> Expr a -> K1 x (Expr a) p
forall a b. (a -> b) -> a -> b
$ Text -> Expr a
forall (a :: Types). Text -> Expr a
VarCustom (Text -> Expr a) -> Text -> Expr a
forall a b. (a -> b) -> a -> b
$ Text
"b" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
index) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".q" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Offset -> String
forall a. Show a => a -> String
show Offset
offset'), Offset
offset' Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Nat -> Offset
Offset (Integer -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size))

instance {-# OVERLAPPABLE #-} (GDummyBuffer (Rep f), Generic f) => GDummyBuffer (S1 b (K1 x f)) where
  gDummyBuffer :: forall (p :: k). Integer -> Offset -> (S1 b (K1 x f) p, Offset)
gDummyBuffer Integer
x Offset
y =
    let (Rep f (ZonkAny 2)
a, Offset
o) = forall {k} (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
forall (f :: * -> *) p.
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
gDummyBuffer @(Rep f) Integer
x Offset
y
     in (K1 x f p -> M1 S b (K1 x f) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 x f p -> M1 S b (K1 x f) p) -> K1 x f p -> M1 S b (K1 x f) p
forall a b. (a -> b) -> a -> b
$ f -> K1 x f p
forall k i c (p :: k). c -> K1 i c p
K1 (f -> K1 x f p) -> f -> K1 x f p
forall a b. (a -> b) -> a -> b
$ Rep f (ZonkAny 2) -> f
forall a x. Generic a => Rep a x -> a
forall x. Rep f x -> f
to Rep f (ZonkAny 2)
a, Offset
o)

instance (GDummyBuffer c) => GDummyBuffer (C1 i c) where
  gDummyBuffer :: forall (p :: k). Integer -> Offset -> (C1 i c p, Offset)
gDummyBuffer Integer
x Offset
y =
    let (c p
a, Offset
o) = forall {k} (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
forall (f :: k -> *) (p :: k).
GDummyBuffer f =>
Integer -> Offset -> (f p, Offset)
gDummyBuffer @c Integer
x Offset
y
     in (c p -> M1 C i c p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 c p
a, Offset
o)