Support for working with ElField.

Fixed benchmark.

Data/Vinyl/Derived.hs

@@ -1,18 +1,55 @@
 {-# LANGUAGE DataKinds  #-}
+{-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE GADTs      #-}
 {-# LANGUAGE PolyKinds  #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Data.Vinyl.Derived where
 
+import Data.Proxy
 import Data.Vinyl.Core
 import Data.Vinyl.Functor
-
+import Foreign.Ptr (castPtr)
+import Foreign.Storable
 import GHC.TypeLits
 
 data ElField (field :: (Symbol, *)) where
-  Field :: KnownSymbol s => t -> ElField '(s,t)
+  Field :: KnownSymbol s => !t -> ElField '(s,t)
 
 type FieldRec = Rec ElField
 type HList = Rec Identity
 type LazyHList = Rec Thunk
+
+deriving instance Eq t => Eq (ElField '(s,t))
+deriving instance Ord t => Ord (ElField '(s,t))
+
+instance Show t => Show (ElField '(s,t)) where
+  show (Field x) = (symbolVal (Proxy::Proxy s))++" :-> "++show x
+
+-- | Get the data payload of an 'ElField'.
+getField :: ElField '(s,t) -> t
+getField (Field x) = x
+
+-- | 'ElField' is isomorphic to a functor something like @Compose
+-- ElField ('(,) s)@.
+fieldMap :: (a -> b) -> ElField '(s,a) -> ElField '(s,b)
+fieldMap f (Field x) = Field (f x)
+{-# INLINE fieldMap #-}
+
+-- | Lens for an 'ElField''s data payload.
+rfield :: Functor f => (a -> f b) -> ElField '(s,a) -> f (ElField '(s,b))
+rfield f (Field x) = fmap Field (f x)
+{-# INLINE rfield #-}
+
+-- | Shorthand for a 'FieldRec' with a single field.
+(=::) :: KnownSymbol s => proxy '(s,a) -> a -> FieldRec '[ '(s,a) ]
+(=::) _ x = Field x :& RNil
+
+instance forall s t. (KnownSymbol s, Storable t)
+    => Storable (ElField '(s,t)) where
+  sizeOf _ = sizeOf (undefined::t)
+  alignment _ = alignment (undefined::t)
+  peek ptr = Field `fmap` peek (castPtr ptr)
+  poke ptr (Field x) = poke (castPtr ptr) x

benchmarks/StorableBench.hs

@@ -11,10 +11,10 @@ import Control.Applicative
 import Control.Lens
 import Control.Monad (when)
 import qualified Data.Foldable as F
+import Data.Proxy
 import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as VM
 import Data.Vinyl
-import Data.Vinyl.Universe.Field
 import Foreign.Ptr (castPtr)
 import Foreign.Storable (Storable(..))
 import Linear (V2, V3, _y)
@@ -28,23 +28,23 @@ randVec n g = VM.replicateM n (uniform g) >>=
 randVecStd :: (Storable a, Variate a) => Int -> IO (V.Vector a)
 randVecStd = withSystemRandom . randVec
 
-vNorm :: SField ("normal" ::: V3 a)
-vNorm = SField
+vNorm :: Proxy '("normal", V3 a)
+vNorm = Proxy
 
-type MyFields a = [ "pos" ::: V3 a, "tex" ::: V2 a, "normal" ::: V3 a ]
-type MyVertex a = PlainRec ElField (MyFields a)
+type MyFields a = [ '("pos", V3 a), '("tex", V2 a), '("normal", V3 a) ]
+type MyVertex a = FieldRec (MyFields a)
 
 doubleNviL :: V.Vector (MyVertex Float) -> V.Vector (MyVertex Float)
-doubleNviL = V.map (rLens vNorm . _y *~ (2::Float))
+doubleNviL = V.map (rlens vNorm . rfield . _y *~ (2::Float))
 
 vinylNSumL :: (Num a, Storable a) => V.Vector (MyVertex a) -> a
-vinylNSumL = V.sum . V.map (F.sum . view (rLens vNorm))
+vinylNSumL = V.sum . V.map (F.sum . view (rlens vNorm . rfield))
 
 doubleNvi :: V.Vector (MyVertex Float) -> V.Vector (MyVertex Float)
-doubleNvi = V.map (rMod vNorm (_y *~ (2::Float)))
+doubleNvi = V.map (rlens vNorm . rfield . _y *~ (2::Float))
 
 vinylNSum :: (Num a, Storable a) => V.Vector (MyVertex a) -> a
-vinylNSum = V.sum . V.map (F.sum . rGet vNorm)
+vinylNSum = V.sum . V.map (F.sum . view rfield . rget vNorm)
 
 main :: IO ()
 main = do vals <- randVecStd $ n * 8 :: IO (V.Vector Float)