Add PrimStorable for deriving getting a Storable instance from a Prim instance (#136)

* Add PrimStorable for deriving getting a Storable instance from a Prim instance

* fix name of example type in docs for PrimStorable

* add tests to be run once GHC 8.6 comes out

Author: andrewthad

Data/Primitive/Types.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP, UnboxedTuples, MagicHash, DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 #if __GLASGOW_HASKELL__ >= 800
 {-# LANGUAGE TypeInType #-}
 #endif
@@ -22,6 +23,7 @@ module Data.Primitive.Types (
   sizeOf, alignment,
 
   Addr(..),
+  PrimStorable(..)
 ) where
 
 import Control.Monad.Primitive
@@ -55,8 +57,11 @@ import GHC.Prim
 import Data.Typeable ( Typeable )
 import Data.Data ( Data(..) )
 import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType )
+import Foreign.Storable (Storable)
 import Numeric
 
+import qualified Foreign.Storable as FS
+
 -- | A machine address
 data Addr = Addr Addr# deriving ( Typeable )
 
@@ -130,6 +135,28 @@ sizeOf x = I# (sizeOf# x)
 alignment :: Prim a => a -> Int
 alignment x = I# (alignment# x)
 
+-- | Newtype that uses a 'Prim' instance to give rise to a 'Storable' instance.
+-- This type is intended to be used with the @DerivingVia@ extension available
+-- in GHC 8.6 and up. For example, consider a user-defined 'Prim' instance for
+-- a multi-word data type.
+--
+-- > data Uuid = Uuid Word64 Word64
+-- >   deriving Storable via (PrimStorable Uuid)
+-- > instance Prim Uuid where ...
+--
+-- Writing the 'Prim' instance is tedious and unavoidable, but the 'Storable'
+-- instance comes for free once the 'Prim' instance is written.
+newtype PrimStorable a = PrimStorable { getPrimStorable :: a }
+
+instance Prim a => Storable (PrimStorable a) where
+  sizeOf _ = sizeOf (undefined :: a)
+  alignment _ = alignment (undefined :: a)
+  peekElemOff (Ptr addr#) (I# i#) =
+    primitive $ \s0# -> case readOffAddr# addr# i# s0# of
+      (# s1, x #) -> (# s1, PrimStorable x #)
+  pokeElemOff (Ptr addr#) (I# i#) (PrimStorable a) = primitive_ $ \s# ->
+    writeOffAddr# addr# i# a s#
+
 #define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, set_arr, idx_addr, rd_addr, wr_addr, set_addr) \
 instance Prim (ty) where {                                      \
   sizeOf# _ = unI# sz                                           \

test/main.hs

@@ -119,6 +119,9 @@ main = do
       , TQC.testProperty "mapMaybePrimArrayP" (QCCL.mapMaybeMProp int16 int32 mapMaybePrimArrayP)
 #endif
       ]
+    -- , testGroup "PrimStorable"
+    --   [ lawsToTest (QCC.storableLaws (Proxy :: Proxy Derived))
+    --   ]
     ]
 
 int16 :: Proxy Int16
@@ -276,3 +279,12 @@ iforM_ xs0 f = go 0 xs0 where
   go !_ [] = return ()
   go !ix (x : xs) = f ix x >> go (ix + 1) xs
 
+-- TODO: Uncomment this out when GHC 8.6 is release. Also, uncomment
+-- the corresponding PrimStorable test group above.
+--
+-- newtype Derived = Derived Int16
+--   deriving newtype (Prim)
+--   deriving Storable via (PrimStorable Derived)
+
+
+