Experiment: use Data.Data to generate AttributeKeys.

1 files changed, 15 insertions, 1 deletions

diff --git a/MaskableStream.hs b/MaskableStream.hs
index 5274d28..10f4bff 100644
--- a/MaskableStream.hs
+++ b/MaskableStream.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE LambdaCase, RecordWildCards, KindSignatures, GADTs #-}
+{-# LANGUAGE LambdaCase, RecordWildCards, KindSignatures, GADTs, DeriveDataTypeable, StandaloneDeriving #-}
 
 -- TODO: Formulate this module as a patch against lambdacube-gl.
 
@@ -7,6 +7,7 @@ module MaskableStream where
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Writer
+import Data.Data
 import Data.Foldable
 import Data.Function
 import Data.Int
@@ -232,6 +233,8 @@ incrementalUpdateBuffer b byteoffset bytecount ptr = do
     glBufferSubData GL_ARRAY_BUFFER byteoffset bytecount ptr
     glBindBuffer GL_ARRAY_BUFFER 0
 
+instance Typeable c => Data (AttributeKey c) where
+
 data AttributeKey c = AttributeKey (TypeTag c) Buffer CPtrdiff
 
 attributeKey :: TypeTagable c => GPUData -> String -> Maybe (AttributeKey c)
@@ -249,6 +252,17 @@ attributeKey dta name = do
             Just $ AttributeKey typ b (fromIntegral off)
         _ -> Nothing
 
+lookupAttributeKey :: GPUData -> String -> Maybe (Some AttributeKey)
+lookupAttributeKey dta name = do
+    stream <- Map.lookup name (dStreams dta)
+    case stream of
+        Stream t b i _ _ -> do
+            let a = bufArrays b ! i
+                off = arrOffset a
+            This tt <- witnessType (fromStreamType t)
+            Just $ This (AttributeKey tt b (fromIntegral off))
+        _ -> Nothing
+
 (@<-) :: GLData a c => AttributeKey c -> a -> Writer [DSum AttributeKey GLUniformValue] ()
 k @<- v = tell [k :=> GLUniformValue v]