1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests.Deriving (testTree) where
import GHC.Generics
import qualified Codec.Serialise as Serialise
import Codec.CBOR.FlatTerm
import Test.Tasty
import Test.Tasty.HUnit
-- | A unit type
data AUnit = AUnit
deriving (Generic, Eq, Show)
instance Serialise.Serialise AUnit
testAUnit :: TestTree
testAUnit = testAgainstFile "a unit" x rep
where
x = AUnit
rep = [TkListLen 1, TkInt 0]
-- | A simple case exercising many of the cases implemented by the generic
-- deriving mechinery
data ARecord = ARecord String Int ARecord
| ANull
deriving (Generic, Eq, Show)
instance Serialise.Serialise ARecord
testARecord :: TestTree
testARecord = testAgainstFile "a record" x rep
where
x = ARecord "hello" 42 (ARecord "world" 52 ANull)
rep = [TkListLen 4, TkInt 0, TkString "hello", TkInt 42,
TkListLen 4, TkInt 0, TkString "world", TkInt 52,
TkListLen 1, TkInt 1
]
newtype ANewtype = ANewtype Int
deriving (Generic, Eq, Show)
instance Serialise.Serialise ANewtype
testANewtype :: TestTree
testANewtype = testAgainstFile "a newtype" x rep
where
x = ANewtype 42
rep = [TkListLen 2, TkInt 0, TkInt 42]
testAgainstFile :: (Eq a, Show a, Serialise.Serialise a)
=> String -> a -> FlatTerm -> TestTree
testAgainstFile name x expected =
testGroup name
[ testCase "serialise" $ do
let actual = toFlatTerm $ Serialise.encode x
expected @=? actual
, testCase "deserialise" $ do
case fromFlatTerm Serialise.decode expected of
Left err -> fail err
Right actual -> x @=? actual
]
testTree :: TestTree
testTree =
testGroup "Stability of derived instances"
[ testAUnit
, testARecord
, testANewtype
]
|
