git.iko.soy/streamly
on master help sign in
Add tests for TH derivation with recordSyntaxWithHeader is enabled
bd8c8cbAdithya Kumar
test/Streamly/Test/Data/Serialize.hs+50−6
compare with master
unifiedsplit
@@ -28,18 +28,15 @@ import Streamly.Data.Serialize (Serialize)
28import Streamly.Test.Data.Serialize.TH (genDatatype)
28import Streamly.Test.Data.Serialize.TH (genDatatype)
29
29
30import qualified Streamly.Internal.Data.Serialize.TH as Serialize
30import qualified Streamly.Internal.Data.Serialize.TH as Serialize
31− ( deriveSerializeWith
32−#ifdef ENABLE_constructorTagAsString
33− , Config(..)
34−#endif
35− , defaultConfig
36− )
37
31
38import Data.Functor.Identity (Identity (..))
32import Data.Functor.Identity (Identity (..))
39
33
40import qualified Streamly.Internal.Data.Array as Array
34import qualified Streamly.Internal.Data.Array as Array
41import qualified Streamly.Internal.Data.Serialize as Serialize
35import qualified Streamly.Internal.Data.Serialize as Serialize
42
36
37+import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0
38+import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1
39+
43import Test.Hspec.QuickCheck
40import Test.Hspec.QuickCheck
44import Test.QuickCheck
41import Test.QuickCheck
45import Test.Hspec as H
42import Test.Hspec as H
@@ -115,6 +112,47 @@ $(Serialize.deriveSerializeWith
115instance Arbitrary a => Arbitrary (BinTree a) where
112instance Arbitrary a => Arbitrary (BinTree a) where
116 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
113 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
117
114
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+
118--------------------------------------------------------------------------------
156--------------------------------------------------------------------------------
119-- Test helpers
157-- Test helpers
120--------------------------------------------------------------------------------
158--------------------------------------------------------------------------------
@@ -204,6 +242,12 @@ testCases = do
204 prop "Array Int"
242 prop "Array Int"
205 $ \(x :: [Int]) -> roundtrip (Array.fromList x)
243 $ \(x :: [Int]) -> roundtrip (Array.fromList x)
206
244
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+
207 limitQC
251 limitQC
208 $ prop "CustomDatatype"
252 $ prop "CustomDatatype"
209 $ \(x :: CustomDatatype) -> roundtrip x
253 $ \(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
293 import: test-options
293 import: test-options
294 type: exitcode-stdio-1.0
294 type: exitcode-stdio-1.0
295 main-is: Streamly/Test/Data/Serialize.hs
295 main-is: Streamly/Test/Data/Serialize.hs
296+ other-modules:
296− other-modules: Streamly.Test.Data.Serialize.TH
297+ Streamly.Test.Data.Serialize.TH
298+ Streamly.Test.Data.Serialize.CompatV0
299+ Streamly.Test.Data.Serialize.CompatV1
297 ghc-options: -main-is Streamly.Test.Data.Serialize.main
300 ghc-options: -main-is Streamly.Test.Data.Serialize.main
298 if flag(limit-build-mem)
301 if flag(limit-build-mem)
299 ghc-options: +RTS -M1500M -RTS
302 ghc-options: +RTS -M1500M -RTS
@@ -302,7 +305,10 @@ test-suite Data.Serialize.ENABLE_constructorTagAsString
302 import: test-options
305 import: test-options
303 type: exitcode-stdio-1.0
306 type: exitcode-stdio-1.0
304 main-is: Streamly/Test/Data/Serialize.hs
307 main-is: Streamly/Test/Data/Serialize.hs
308+ other-modules:
305− other-modules: Streamly.Test.Data.Serialize.TH
309+ Streamly.Test.Data.Serialize.TH
310+ Streamly.Test.Data.Serialize.CompatV0
311+ Streamly.Test.Data.Serialize.CompatV1
306 cpp-options: -DENABLE_constructorTagAsString
312 cpp-options: -DENABLE_constructorTagAsString
307 ghc-options: -main-is Streamly.Test.Data.Serialize.main
313 ghc-options: -main-is Streamly.Test.Data.Serialize.main
308 if flag(limit-build-mem)
314 if flag(limit-build-mem)