module Foreign.Storable.Generic () where
import Control.Monad
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import GHC.Generics
instance Storable a => Storable (U1 a) where
sizeOf _ = 0
alignment = sizeOf
peek _ = pure U1
poke _ _ = pure ()
instance (Storable (f a), Storable (g a)) => Storable ((f :*: g) a) where
sizeOf _ = sizeOf (undefined :: f a) + sizeOf (undefined :: g a)
alignment _ = gcd (sizeOf (undefined :: f a)) (sizeOf (undefined :: g a))
peek ptr = do
a <- peek (castPtr ptr)
b <- peekByteOff ptr (sizeOf (undefined :: f a))
pure $ a :*: b
poke ptr (a :*: b) = do
poke (castPtr ptr) a
pokeByteOff ptr (sizeOf (undefined :: f a)) b
instance (Storable (f a), Storable (g a)) => Storable ((f :+: g) a) where
sizeOf _ = 4 + sizeOf (undefined :: f a) `max` sizeOf (undefined :: g a)
alignment _ = gcd (sizeOf (undefined :: f a)) (sizeOf (undefined :: g a))
peek ptr = do
tag <- peek (castPtr ptr)
if (tag :: Word32) == 0
then pure L1 `ap` peekByteOff ptr 4
else pure R1 `ap` peekByteOff ptr 4
poke ptr (L1 val) = poke (castPtr ptr) (0 :: Word32) >> pokeByteOff ptr 4 val
poke ptr (R1 val) = poke (castPtr ptr) (1 :: Word32) >> pokeByteOff ptr 4 val
instance (Storable (f a)) => Storable (M1 i c f a) where
sizeOf _ = sizeOf (undefined :: f a)
alignment = sizeOf
peek ptr = pure M1 `ap` peek (castPtr ptr)
poke ptr (M1 val) = poke (castPtr ptr) val
instance (Storable (f a)) => Storable (K1 i (f a) a) where
sizeOf _ = sizeOf (undefined :: f a)
alignment = sizeOf
peek ptr = pure K1 `ap` peek (castPtr ptr)
poke ptr (K1 val) = poke (castPtr ptr) val