Add tests for TH derivation with recordSyntaxWithHeader is enabled

- Add roundtrip tests for nested records
- Add compatibility tests
This commit is contained in:
Adithya Kumar 2023-09-13 15:36:55 +05:30
parent a309bf77e0
commit bd8c8cb1b8
4 changed files with 152 additions and 8 deletions

View File

@ -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

View File

@ -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|])

View File

@ -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|])

View File

@ -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)