mirror of
https://github.com/composewell/streamly.git
synced 2024-08-16 23:10:36 +03:00
Add tests for TH derivation with recordSyntaxWithHeader is enabled
- Add roundtrip tests for nested records - Add compatibility tests
This commit is contained in:
parent
a309bf77e0
commit
bd8c8cb1b8
@ -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
|
||||
|
46
test/Streamly/Test/Data/Serialize/CompatV0.hs
Normal file
46
test/Streamly/Test/Data/Serialize/CompatV0.hs
Normal 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|])
|
48
test/Streamly/Test/Data/Serialize/CompatV1.hs
Normal file
48
test/Streamly/Test/Data/Serialize/CompatV1.hs
Normal 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|])
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user