{-# LANGUAGE DeriveGeneric, DeriveAnyClass, CPP #-}
module TestCases where 

import GHC.Generics (Generic)
import Foreign.Storable.Generic
import Data.Int
import Data.Word
import Control.DeepSeq


data C1 = C1 Int32                 deriving (Show, Generic, GStorable, NFData)
data C2 = C2 Int8 Int32 Int16      deriving (Show, Generic, GStorable, NFData)
data C3 = C3 C2 Int64 C1           deriving (Show, Generic, GStorable, NFData)
data C4 = C4 Double Int8 C3        deriving (Show, Generic, GStorable, NFData)
data C5 = C5 Int32 C2 C4           deriving (Show, Generic, GStorable, NFData)

c1_def = C1 3
c2_def = C2 3 10 8
c3_def = C3 c2_def 11000 c1_def
c4_def = C4 0.312 3 c3_def 
c5_def = C5 100 c2_def c4_def 


data C1hw = C1hw Int32                 deriving (Show,Generic, NFData)
data C2hw = C2hw Int8 Int32 Int16      deriving (Show,Generic, NFData)
data C3hw = C3hw C2hw Int64 C1hw       deriving (Show,Generic, NFData)
data C4hw = C4hw Double Int8 C3hw      deriving (Show,Generic, NFData)
data C5hw = C5hw Int32 C2hw C4hw       deriving (Show,Generic, NFData)

c1hw_def = C1hw 3
c2hw_def = C2hw 3 10 8
c3hw_def = C3hw c2hw_def 11000 c1hw_def
c4hw_def = C4hw 0.312 3 c3hw_def 
c5hw_def = C5hw 100 c2hw_def c4hw_def 

instance Storable C1hw where
    sizeOf                         _ = 4
    alignment                      _ = 4
    peekByteOff ptr off              = C1hw <$> (peekByteOff ptr off :: IO Int32) 
    pokeByteOff ptr off (C1hw v) = pokeByteOff ptr off v

instance Storable C2hw where
    sizeOf                         _ = 12
    alignment                      _ = 4
    peekByteOff ptr off              = C2hw 
        <$> (peekByteOff ptr off        :: IO Int8 ) 
        <*> (peekByteOff ptr (off + 4)  :: IO Int32) 
        <*> (peekByteOff ptr (off + 8)  :: IO Int16) 
                                       
    pokeByteOff ptr off (C2hw i8a i32 i16) = do
        pokeByteOff ptr  off       i8a
        pokeByteOff ptr (off + 4)  i32
        pokeByteOff ptr (off + 8)  i16

instance Storable C3hw where
    sizeOf              _ = 32
    alignment           _ = 8
    peekByteOff ptr off = C3hw 
        <$> (peekByteOff ptr off        :: IO C2hw ) 
        <*> (peekByteOff ptr (off + 16) :: IO Int64) 
        <*> (peekByteOff ptr (off + 24) :: IO C1hw) 
                                       
    pokeByteOff ptr off (C3hw c2hw i64 c1hw) = do
        pokeByteOff ptr  off        c2hw
        pokeByteOff ptr (off + 16)  i64
        pokeByteOff ptr (off + 24)  c1hw

instance Storable C4hw where
    sizeOf              _ = 48
    alignment           _ = 8
    peekByteOff ptr off   = C4hw 
        <$> (peekByteOff ptr  off       :: IO Double)
        <*> (peekByteOff ptr (off + 8)  :: IO Int8  )
        <*> (peekByteOff ptr (off + 16) :: IO C3hw  )
    pokeByteOff ptr off (C4hw dbl i8 c3hw) = do
        pokeByteOff ptr  off       dbl
        pokeByteOff ptr (off + 8)  i8
        pokeByteOff ptr (off + 16) c3hw

instance Storable C5hw where 
    sizeOf              _ = 64
    alignment           _ = 8
    peekByteOff ptr off   = C5hw 
        <$> (peekByteOff ptr  off       :: IO Int32)
        <*> (peekByteOff ptr (off + 4 ) :: IO C2hw )
        <*> (peekByteOff ptr (off + 16) :: IO C4hw )
    pokeByteOff ptr off (C5hw i32 c2hw c4hw) = do
        pokeByteOff ptr  off       i32
        pokeByteOff ptr (off + 4)  c2hw
        pokeByteOff ptr (off + 16) c4hw

#ifdef GSTORABLE_SUMTYPES

data S1 = S1a Int32 | S1b Int16    deriving (Show, Generic, GStorable, NFData)
data S2 = S2a Int32 Int64 Int8 | S2b S1 Int8 Double
        | S2c Int32 Int8 Int16 Int8 | S2d S1 S1
        deriving (Show, Generic, GStorable, NFData)

s1_def = S1a 54
s2_def = S2b s1_def 32 1.5


data S1hw = S1hwa Int32 | S1hwb Int16  deriving (Show,Generic, NFData)
data S2hw = S2hwa Int32 Int64 Int8 | S2hwb S1hw Int8 Double
          | S2hwc Int32 Int8 Int16 Int8 | S2hwd S1hw S1hw
          deriving (Show, Generic, NFData)

s1hw_def = S1hwa 54
s2hw_def = S2hwb s1hw_def 32 1.5

instance Storable S1hw where
    sizeOf                         _ = 8
    alignment                      _ = 4
    peekByteOff ptr off              = do 
        let peek1 = S1hwa <$> (peekByteOff ptr (off+4) :: IO Int32)
            peek2 = S1hwb <$> (peekByteOff ptr (off+4) :: IO Int16)
        tag <- peekByteOff ptr off :: IO Word8 
        case tag of
            0 -> peek1
            1 -> peek2
            _ -> error "S1hw : Bad tag"
    pokeByteOff ptr off (S1hwa v) = pokeByteOff ptr off (0 :: Word8) >> pokeByteOff ptr (off+4) v
    pokeByteOff ptr off (S1hwb v) = pokeByteOff ptr off (1 :: Word8) >> pokeByteOff ptr (off+4) v

instance Storable S2hw where
    sizeOf                         _ = 32
    alignment                      _ = 8
    peekByteOff ptr off              = do 
        let peek1 = S2hwa <$> (peekByteOff ptr (off+ 8) :: IO Int32)
                          <*> (peekByteOff ptr (off+16) :: IO Int64)
                          <*> (peekByteOff ptr (off+24) :: IO  Int8)

            peek2 = S2hwb <$> (peekByteOff ptr (off+ 8) :: IO S1hw)
                          <*> (peekByteOff ptr (off+16) :: IO Int8)
                          <*> (peekByteOff ptr (off+24) :: IO Double)

            peek3 = S2hwc <$> (peekByteOff ptr (off+ 8) :: IO Int32)
                          <*> (peekByteOff ptr (off+12) :: IO  Int8)
                          <*> (peekByteOff ptr (off+16) :: IO Int16)
                          <*> (peekByteOff ptr (off+20) :: IO  Int8)

            peek4 = S2hwd <$> (peekByteOff ptr (off+ 8) :: IO S1hw)
                          <*> (peekByteOff ptr (off+16) :: IO S1hw)

        tag <- peekByteOff ptr off :: IO Word8 
        case tag of
            0 -> peek1
            1 -> peek2
            2 -> peek3
            3 -> peek4
            _ -> error "S1hw : Bad tag"

    pokeByteOff ptr off (S2hwa a b c) = do 
        pokeByteOff ptr  off     (0 :: Word8) 
        pokeByteOff ptr (off+ 8)  a
        pokeByteOff ptr (off+16)  b
        pokeByteOff ptr (off+24)  c
    pokeByteOff ptr off (S2hwb a b c) = do
        pokeByteOff ptr  off     (1 :: Word8) 
        pokeByteOff ptr (off+ 8)  a
        pokeByteOff ptr (off+16)  b
        pokeByteOff ptr (off+24)  c
    pokeByteOff ptr off (S2hwc a b c d) = do
        pokeByteOff ptr  off     (2 :: Word8) 
        pokeByteOff ptr (off+ 8)  a
        pokeByteOff ptr (off+12)  b
        pokeByteOff ptr (off+16)  c
        pokeByteOff ptr (off+24)  d
    pokeByteOff ptr off (S2hwd a b)     = do
        pokeByteOff ptr  off     (3 :: Word8) 
        pokeByteOff ptr (off+ 8)  a
        pokeByteOff ptr (off+16)  b

#endif