mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +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 Streamly.Test.Data.Serialize.TH (genDatatype)
|
||||||
|
|
||||||
import qualified Streamly.Internal.Data.Serialize.TH as Serialize
|
import qualified Streamly.Internal.Data.Serialize.TH as Serialize
|
||||||
( deriveSerializeWith
|
|
||||||
#ifdef ENABLE_constructorTagAsString
|
|
||||||
, Config(..)
|
|
||||||
#endif
|
|
||||||
, defaultConfig
|
|
||||||
)
|
|
||||||
|
|
||||||
import Data.Functor.Identity (Identity (..))
|
import Data.Functor.Identity (Identity (..))
|
||||||
|
|
||||||
import qualified Streamly.Internal.Data.Array as Array
|
import qualified Streamly.Internal.Data.Array as Array
|
||||||
import qualified Streamly.Internal.Data.Serialize as Serialize
|
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.Hspec.QuickCheck
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import Test.Hspec as H
|
import Test.Hspec as H
|
||||||
@ -115,6 +112,47 @@ $(Serialize.deriveSerializeWith
|
|||||||
instance Arbitrary a => Arbitrary (BinTree a) where
|
instance Arbitrary a => Arbitrary (BinTree a) where
|
||||||
arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
|
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
|
-- Test helpers
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
@ -204,6 +242,12 @@ testCases = do
|
|||||||
prop "Array Int"
|
prop "Array Int"
|
||||||
$ \(x :: [Int]) -> roundtrip (Array.fromList x)
|
$ \(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
|
limitQC
|
||||||
$ prop "CustomDatatype"
|
$ prop "CustomDatatype"
|
||||||
$ \(x :: CustomDatatype) -> roundtrip x
|
$ \(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
|
import: test-options
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Streamly/Test/Data/Serialize.hs
|
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
|
ghc-options: -main-is Streamly.Test.Data.Serialize.main
|
||||||
if flag(limit-build-mem)
|
if flag(limit-build-mem)
|
||||||
ghc-options: +RTS -M1500M -RTS
|
ghc-options: +RTS -M1500M -RTS
|
||||||
@ -302,7 +305,10 @@ test-suite Data.Serialize.ENABLE_constructorTagAsString
|
|||||||
import: test-options
|
import: test-options
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Streamly/Test/Data/Serialize.hs
|
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
|
cpp-options: -DENABLE_constructorTagAsString
|
||||||
ghc-options: -main-is Streamly.Test.Data.Serialize.main
|
ghc-options: -main-is Streamly.Test.Data.Serialize.main
|
||||||
if flag(limit-build-mem)
|
if flag(limit-build-mem)
|
||||||
|
Loading…
Reference in New Issue
Block a user