git.iko.soy/streamly
on master help sign in
Add tests for TH derivation with recordSyntaxWithHeader is enabled

- Add roundtrip tests for nested records - Add compatibility tests

commitbd8c8cb1b88da7912e206bfc4f199eead121763b authorAdithya Kumar <adithya@composewell.com> dateWed 13 Sep 2023, 15:36 (3 years ago) parenta309bf7
4 files changed+152−8
compare with master
unifiedsplit
test/Streamly/Test/Data/Serialize.hs+50−6 test/Streamly/Test/Data/Serialize/CompatV0.hs+46 test/Streamly/Test/Data/Serialize/CompatV1.hs+48 test/streamly-tests.cabal+8−2
test/Streamly/Test/Data/Serialize.hs+50−6
@@ -28,18 +28,15 @@ import Streamly.Data.Serialize (Serialize)
2828import Streamly.Test.Data.Serialize.TH (genDatatype)
2929
3030import qualified Streamly.Internal.Data.Serialize.TH as Serialize
31− ( deriveSerializeWith
32−#ifdef ENABLE_constructorTagAsString
33− , Config(..)
34−#endif
35− , defaultConfig
36− )
3731
3832import Data.Functor.Identity (Identity (..))
3933
4034import qualified Streamly.Internal.Data.Array as Array
4135import qualified Streamly.Internal.Data.Serialize as Serialize
4236
37+import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0
38+import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1
39+
4340import Test.Hspec.QuickCheck
4441import Test.QuickCheck
4542import Test.Hspec as H
@@ -115,6 +112,47 @@ $(Serialize.deriveSerializeWith
115112instance Arbitrary a => Arbitrary (BinTree a) where
116113 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
117114
115+--------------------------------------------------------------------------------
116+-- Record syntax type
117+--------------------------------------------------------------------------------
118+
119+upgradeRec :: (a -> b) -> CompatV0.Rec a -> CompatV1.Rec b
120+upgradeRec f val =
121+ CompatV1.Rec
122+ { CompatV1.initialField = CompatV0.initialField val
123+ , CompatV1.otherField = f (CompatV0.otherField val)
124+ , CompatV1.theLastField = CompatV0.theLastField val
125+ , CompatV1.aNewField = Nothing
126+ }
127+
128+upgradeRiver :: CompatV0.River -> CompatV1.River
129+upgradeRiver = read . show
130+
131+downgradeRec :: (a -> b) -> CompatV1.Rec a -> CompatV0.Rec b
132+downgradeRec f val =
133+ CompatV0.Rec
134+ { CompatV0.initialField = CompatV1.initialField val
135+ , CompatV0.otherField = f (CompatV1.otherField val)
136+ , CompatV0.theLastField = CompatV1.theLastField val
137+ }
138+
139+downgradeRiver :: CompatV1.River -> CompatV0.River
140+downgradeRiver = read . show
141+
142+testCompatibility ::
143+ CompatV0.Rec (CompatV0.Rec CompatV0.River)
144+ -> CompatV1.Rec (CompatV1.Rec CompatV1.River)
145+ -> IO ()
146+testCompatibility v0 v1 = do
147+ let upgradedV0 = upgradeRec (upgradeRec upgradeRiver) v0
148+ downgradedV1 = downgradeRec (downgradeRec downgradeRiver) v1
149+
150+ res <- poke v0
151+ peekAndVerify res upgradedV0
152+
153+ res1 <- poke v1
154+ peekAndVerify res1 downgradedV1
155+
118156--------------------------------------------------------------------------------
119157-- Test helpers
120158--------------------------------------------------------------------------------
@@ -204,6 +242,12 @@ testCases = do
204242 prop "Array Int"
205243 $ \(x :: [Int]) -> roundtrip (Array.fromList x)
206244
245+ prop "Compatible Record"
246+ $ \(a :: CompatV1.Rec (CompatV0.Rec CompatV1.River)) -> roundtrip a
247+
248+ prop "Compatibility"
249+ $ \a b -> testCompatibility a b
250+
207251 limitQC
208252 $ prop "CustomDatatype"
209253 $ \(x :: CustomDatatype) -> roundtrip x
test/Streamly/Test/Data/Serialize/CompatV0.hsnew file+46
@@ -0,0 +1,46 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+module Streamly.Test.Data.Serialize.CompatV0
4+ ( Rec(..)
5+ , River(..)
6+ ) where
7+
8+--------------------------------------------------------------------------------
9+-- Imports
10+--------------------------------------------------------------------------------
11+
12+import Test.QuickCheck (Arbitrary, arbitrary, elements)
13+import Streamly.Internal.Data.Serialize (Serialize)
14+import qualified Streamly.Internal.Data.Serialize.TH as Serialize
15+
16+--------------------------------------------------------------------------------
17+-- Types
18+--------------------------------------------------------------------------------
19+
20+data Rec a =
21+ Rec
22+ { initialField :: Int
23+ , otherField :: a
24+ , theLastField :: Maybe String
25+ }
26+ deriving (Eq, Show)
27+
28+instance Arbitrary a => Arbitrary (Rec a) where
29+ arbitrary = Rec <$> arbitrary <*> arbitrary <*> arbitrary
30+
31+$(Serialize.deriveSerializeWith
32+ (Serialize.defaultConfig {Serialize.recordSyntaxWithHeader = True})
33+ [d|instance Serialize a => Serialize (Rec a)|])
34+
35+data River
36+ = Ganga
37+ | Yamuna
38+ | Godavari
39+ deriving (Eq, Show, Read)
40+
41+instance Arbitrary River where
42+ arbitrary = elements [Ganga, Yamuna, Godavari]
43+
44+$(Serialize.deriveSerializeWith
45+ (Serialize.defaultConfig {Serialize.constructorTagAsString = True})
46+ [d|instance Serialize River|])
test/Streamly/Test/Data/Serialize/CompatV1.hsnew file+48
@@ -0,0 +1,48 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+module Streamly.Test.Data.Serialize.CompatV1
4+ ( Rec(..)
5+ , River(..)
6+ ) where
7+
8+--------------------------------------------------------------------------------
9+-- Imports
10+--------------------------------------------------------------------------------
11+
12+import Test.QuickCheck (Arbitrary, arbitrary, elements)
13+import Streamly.Internal.Data.Serialize (Serialize)
14+import qualified Streamly.Internal.Data.Serialize.TH as Serialize
15+
16+--------------------------------------------------------------------------------
17+-- Types
18+--------------------------------------------------------------------------------
19+
20+data Rec a =
21+ Rec
22+ { initialField :: Int
23+ , otherField :: a
24+ , theLastField :: Maybe String
25+ , aNewField :: Maybe Char
26+ }
27+ deriving (Eq, Show)
28+
29+instance Arbitrary a => Arbitrary (Rec a) where
30+ arbitrary = Rec <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
31+
32+$(Serialize.deriveSerializeWith
33+ (Serialize.defaultConfig {Serialize.recordSyntaxWithHeader = True})
34+ [d|instance Serialize a => Serialize (Rec a)|])
35+
36+data River
37+ = Yamuna
38+ | Krishna
39+ | Godavari
40+ | Ganga
41+ deriving (Eq, Show, Read)
42+
43+instance Arbitrary River where
44+ arbitrary = elements [Ganga, Yamuna, Godavari]
45+
46+$(Serialize.deriveSerializeWith
47+ (Serialize.defaultConfig {Serialize.constructorTagAsString = True})
48+ [d|instance Serialize River|])
test/streamly-tests.cabal+8−2
@@ -293,7 +293,10 @@ test-suite Data.Serialize
293293 import: test-options
294294 type: exitcode-stdio-1.0
295295 main-is: Streamly/Test/Data/Serialize.hs
296− other-modules: Streamly.Test.Data.Serialize.TH
296+ other-modules:
297+ Streamly.Test.Data.Serialize.TH
298+ Streamly.Test.Data.Serialize.CompatV0
299+ Streamly.Test.Data.Serialize.CompatV1
297300 ghc-options: -main-is Streamly.Test.Data.Serialize.main
298301 if flag(limit-build-mem)
299302 ghc-options: +RTS -M1500M -RTS
@@ -302,7 +305,10 @@ test-suite Data.Serialize.ENABLE_constructorTagAsString
302305 import: test-options
303306 type: exitcode-stdio-1.0
304307 main-is: Streamly/Test/Data/Serialize.hs
305− other-modules: Streamly.Test.Data.Serialize.TH
308+ other-modules:
309+ Streamly.Test.Data.Serialize.TH
310+ Streamly.Test.Data.Serialize.CompatV0
311+ Streamly.Test.Data.Serialize.CompatV1
306312 cpp-options: -DENABLE_constructorTagAsString
307313 ghc-options: -main-is Streamly.Test.Data.Serialize.main
308314 if flag(limit-build-mem)