diff --git a/test/Streamly/Test/Data/Serialize.hs b/test/Streamly/Test/Data/Serialize.hs index f0f22519a..7f0ce79e9 100644 --- a/test/Streamly/Test/Data/Serialize.hs +++ b/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 diff --git a/test/Streamly/Test/Data/Serialize/CompatV0.hs b/test/Streamly/Test/Data/Serialize/CompatV0.hs new file mode 100644 index 000000000..e035c8f63 --- /dev/null +++ b/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|]) diff --git a/test/Streamly/Test/Data/Serialize/CompatV1.hs b/test/Streamly/Test/Data/Serialize/CompatV1.hs new file mode 100644 index 000000000..524c86acd --- /dev/null +++ b/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|]) diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index f2bb18597..0f2c0883d 100644 --- a/test/streamly-tests.cabal +++ b/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)