Add tests for TH derivation with recordSyntaxWithHeader is enabled

- Add roundtrip tests for nested records
- Add compatibility tests

test/Streamly/Test/Data/Serialize.hs

@@ -28,18 +28,15 @@ import Streamly.Data.Serialize (Serialize)
 import Streamly.Test.Data.Serialize.TH (genDatatype)
 
 import qualified Streamly.Internal.Data.Serialize.TH as Serialize
-    ( deriveSerializeWith
-#ifdef ENABLE_constructorTagAsString
-    , Config(..)
-#endif
-    , defaultConfig
-    )
 
 import Data.Functor.Identity (Identity (..))
 
 import qualified Streamly.Internal.Data.Array as Array
 import qualified Streamly.Internal.Data.Serialize as Serialize
 
+import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0
+import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1
+
 import Test.Hspec.QuickCheck
 import Test.QuickCheck
 import Test.Hspec as H
@@ -115,6 +112,47 @@ $(Serialize.deriveSerializeWith
 instance Arbitrary a => Arbitrary (BinTree a) where
   arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
 
+--------------------------------------------------------------------------------
+-- Record syntax type
+--------------------------------------------------------------------------------
+
+upgradeRec :: (a -> b) -> CompatV0.Rec a -> CompatV1.Rec b
+upgradeRec f val =
+    CompatV1.Rec
+        { CompatV1.initialField = CompatV0.initialField val
+        , CompatV1.otherField = f (CompatV0.otherField val)
+        , CompatV1.theLastField = CompatV0.theLastField val
+        , CompatV1.aNewField = Nothing
+        }
+
+upgradeRiver :: CompatV0.River -> CompatV1.River
+upgradeRiver = read . show
+
+downgradeRec  :: (a -> b) -> CompatV1.Rec a -> CompatV0.Rec b
+downgradeRec f val =
+    CompatV0.Rec
+        { CompatV0.initialField = CompatV1.initialField val
+        , CompatV0.otherField = f (CompatV1.otherField val)
+        , CompatV0.theLastField = CompatV1.theLastField val
+        }
+
+downgradeRiver :: CompatV1.River -> CompatV0.River
+downgradeRiver = read . show
+
+testCompatibility ::
+       CompatV0.Rec (CompatV0.Rec CompatV0.River)
+    -> CompatV1.Rec (CompatV1.Rec CompatV1.River)
+    -> IO ()
+testCompatibility v0 v1 = do
+    let upgradedV0 = upgradeRec (upgradeRec upgradeRiver) v0
+        downgradedV1 = downgradeRec (downgradeRec downgradeRiver) v1
+
+    res <- poke v0
+    peekAndVerify res upgradedV0
+
+    res1 <- poke v1
+    peekAndVerify res1 downgradedV1
+
 --------------------------------------------------------------------------------
 -- Test helpers
 --------------------------------------------------------------------------------
@@ -204,6 +242,12 @@ testCases = do
     prop "Array Int"
         $ \(x :: [Int]) -> roundtrip (Array.fromList x)
 
+    prop "Compatible Record"
+        $ \(a :: CompatV1.Rec (CompatV0.Rec CompatV1.River)) -> roundtrip a
+
+    prop "Compatibility"
+        $ \a b -> testCompatibility a b
+
     limitQC
         $ prop "CustomDatatype"
         $ \(x :: CustomDatatype) -> roundtrip x

test/Streamly/Test/Data/Serialize/CompatV0.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Streamly.Test.Data.Serialize.CompatV0
+    ( Rec(..)
+    , River(..)
+    ) where
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+import Test.QuickCheck (Arbitrary, arbitrary, elements)
+import Streamly.Internal.Data.Serialize (Serialize)
+import qualified Streamly.Internal.Data.Serialize.TH as Serialize
+
+--------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------
+
+data Rec a =
+    Rec
+        { initialField :: Int
+        , otherField :: a
+        , theLastField :: Maybe String
+        }
+    deriving (Eq, Show)
+
+instance Arbitrary a => Arbitrary (Rec a) where
+    arbitrary = Rec <$> arbitrary <*> arbitrary <*> arbitrary
+
+$(Serialize.deriveSerializeWith
+      (Serialize.defaultConfig {Serialize.recordSyntaxWithHeader = True})
+      [d|instance Serialize a => Serialize (Rec a)|])
+
+data River
+    = Ganga
+    | Yamuna
+    | Godavari
+    deriving (Eq, Show, Read)
+
+instance Arbitrary River where
+    arbitrary = elements [Ganga, Yamuna, Godavari]
+
+$(Serialize.deriveSerializeWith
+      (Serialize.defaultConfig {Serialize.constructorTagAsString = True})
+      [d|instance Serialize River|])

test/Streamly/Test/Data/Serialize/CompatV1.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Streamly.Test.Data.Serialize.CompatV1
+    ( Rec(..)
+    , River(..)
+    ) where
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+import Test.QuickCheck (Arbitrary, arbitrary, elements)
+import Streamly.Internal.Data.Serialize (Serialize)
+import qualified Streamly.Internal.Data.Serialize.TH as Serialize
+
+--------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------
+
+data Rec a =
+    Rec
+        { initialField :: Int
+        , otherField :: a
+        , theLastField :: Maybe String
+        , aNewField :: Maybe Char
+        }
+    deriving (Eq, Show)
+
+instance Arbitrary a => Arbitrary (Rec a) where
+    arbitrary = Rec <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+$(Serialize.deriveSerializeWith
+      (Serialize.defaultConfig {Serialize.recordSyntaxWithHeader = True})
+      [d|instance Serialize a => Serialize (Rec a)|])
+
+data River
+    = Yamuna
+    | Krishna
+    | Godavari
+    | Ganga
+    deriving (Eq, Show, Read)
+
+instance Arbitrary River where
+    arbitrary = elements [Ganga, Yamuna, Godavari]
+
+$(Serialize.deriveSerializeWith
+      (Serialize.defaultConfig {Serialize.constructorTagAsString = True})
+      [d|instance Serialize River|])

test/streamly-tests.cabal

@@ -293,7 +293,10 @@ test-suite Data.Serialize
   import: test-options
   type: exitcode-stdio-1.0
   main-is: Streamly/Test/Data/Serialize.hs
-  other-modules: Streamly.Test.Data.Serialize.TH
+  other-modules:
+      Streamly.Test.Data.Serialize.TH
+      Streamly.Test.Data.Serialize.CompatV0
+      Streamly.Test.Data.Serialize.CompatV1
   ghc-options: -main-is Streamly.Test.Data.Serialize.main
   if flag(limit-build-mem)
     ghc-options: +RTS -M1500M -RTS
@@ -302,7 +305,10 @@ test-suite Data.Serialize.ENABLE_constructorTagAsString
   import: test-options
   type: exitcode-stdio-1.0
   main-is: Streamly/Test/Data/Serialize.hs
-  other-modules: Streamly.Test.Data.Serialize.TH
+  other-modules:
+      Streamly.Test.Data.Serialize.TH
+      Streamly.Test.Data.Serialize.CompatV0
+      Streamly.Test.Data.Serialize.CompatV1
   cpp-options: -DENABLE_constructorTagAsString
   ghc-options: -main-is Streamly.Test.Data.Serialize.main
   if flag(limit-build-mem)