Skip to content

Commit 09760e7

Browse files
author
Frederick Pringle
committed
Tests for `generic-diff-containers
1 parent 20484f0 commit 09760e7

File tree

5 files changed

+332
-0
lines changed

5 files changed

+332
-0
lines changed

‎examples/containers-instances/generic-diff-containers.cabal

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,3 +57,25 @@ library
5757

5858
hs-source-dirs: src
5959
default-language: Haskell2010
60+
61+
test-suite generic-diff-containers-test
62+
import:
63+
warnings
64+
, deps
65+
, extensions
66+
default-language: Haskell2010
67+
type: exitcode-stdio-1.0
68+
hs-source-dirs: test
69+
main-is: Spec.hs
70+
other-modules:
71+
Generics.Diff.UnitTestsSpec
72+
Generics.Diff.PropertyTestsSpec
73+
Util
74+
build-tool-depends:
75+
hspec-discover:hspec-discover
76+
ghc-options: -Wno-orphans
77+
build-depends:
78+
, generic-diff
79+
, generic-diff-containers
80+
, QuickCheck
81+
, hspec

‎examples/containers-instances/test/Generics/Diff/PropertyTestsSpec.hs

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
{-# OPTIONS_GHC -Wno-partial-fields #-}
2+
3+
module Generics.Diff.PropertyTestsSpec where
4+
5+
import Data.Fixed
6+
import Data.Map (Map)
7+
import Data.Proxy
8+
import Data.Sequence (Seq)
9+
import Data.Set (Set)
10+
import Data.Tree (Tree)
11+
import Data.Version
12+
import Foreign.C.Types
13+
import Generics.Diff
14+
import Generics.Diff.Instances ()
15+
import Generics.Diff.Special.Map ()
16+
import Generics.Diff.Special.Seq ()
17+
import Generics.Diff.Special.Set ()
18+
import Generics.Diff.Special.Tree ()
19+
import qualified Test.Hspec as H
20+
import qualified Test.Hspec.QuickCheck as H
21+
import qualified Test.QuickCheck as Q
22+
import Util
23+
24+
spec :: H.Spec
25+
spec = do
26+
H.describe "x == y => x `diff` y == Equal" $
27+
manyTypes propEqualGivesEqual
28+
H.describe "x `diff` y == Equal => x == y" $
29+
manyTypes propEqualMeansEqual
30+
31+
-- | If the two inputs are equal, 'diff' should return 'Equal'.
32+
propEqualGivesEqual :: forall a. (Q.Arbitrary a, Diff a, Show a) => Proxy a -> Q.Property
33+
propEqualGivesEqual _ = Q.property $ \a -> propDiffResult @a a a Equal
34+
35+
-- | If the two inputs are not equal, 'diff' should never return 'Equal'.
36+
propEqualMeansEqual :: forall a. (Q.Arbitrary a, Eq a, Diff a, Show a) => Proxy a -> Q.Property
37+
propEqualMeansEqual _ = Q.property $ \leftValue rightValue ->
38+
leftValue /= rightValue Q.==>
39+
diff @a leftValue rightValue /= Equal
40+
41+
manyTypes :: (forall x. (Q.Arbitrary x, Eq x, Diff x, Show x) => Proxy x -> Q.Property) -> H.Spec
42+
manyTypes prop = do
43+
H.prop "Set Char" $ prop $ Proxy @(Set Char)
44+
H.prop "Set Int" $ prop $ Proxy @(Set Int)
45+
46+
H.prop "Seq Rational" $ prop $ Proxy @(Seq Rational)
47+
H.prop "Seq Version" $ prop $ Proxy @(Seq Version)
48+
H.prop "Seq CLong" $ prop $ Proxy @(Seq CLong)
49+
50+
H.prop "Tree CChar" $ prop $ Proxy @(Tree CChar)
51+
H.prop "Tree Uni" $ prop $ Proxy @(Tree Uni)
52+
H.prop "Tree Deci" $ prop $ Proxy @(Tree Deci)
53+
54+
H.prop "Map Int Char" $ prop $ Proxy @(Map Int Char)
55+
H.prop "Map Char Int" $ prop $ Proxy @(Map Char Int)

‎examples/containers-instances/test/Generics/Diff/UnitTestsSpec.hs

Lines changed: 231 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,231 @@
1+
{-# OPTIONS_GHC -Wno-partial-fields #-}
2+
3+
module Generics.Diff.UnitTestsSpec where
4+
5+
import Data.Foldable
6+
import Data.Map (Map)
7+
import qualified Data.Map as Map
8+
import Data.Sequence (Seq)
9+
import qualified Data.Sequence as Seq
10+
import Data.Set (Set)
11+
import qualified Data.Set as Set
12+
import qualified Data.Text as T
13+
import Data.Tree (Tree)
14+
import qualified Data.Tree as Tree
15+
import Generics.Diff
16+
import Generics.Diff.Instances ()
17+
import Generics.Diff.Special.Map as Map
18+
import Generics.Diff.Special.Seq ()
19+
import Generics.Diff.Special.Set as Set
20+
import Generics.Diff.Special.Tree
21+
import Generics.SOP
22+
import Generics.SOP.GGP
23+
import qualified Test.Hspec as H
24+
import qualified Test.Hspec.QuickCheck as H
25+
import Util
26+
27+
spec :: H.Spec
28+
spec =
29+
H.describe "Unit tests" $ do
30+
H.describe "Map" $ traverse_ specTestSet mapTestSets
31+
H.describe "Set" $ traverse_ specTestSet setTestSets
32+
H.describe "Seq" $ traverse_ specTestSet seqTestSets
33+
H.describe "Tree" $ traverse_ specTestSet treeTestSets
34+
H.describe "CustomTree" $ traverse_ specTestSet customTreeTestSets
35+
36+
specTestSet :: (Diff a, Show a) => TestSet a -> H.Spec
37+
specTestSet TestSet {..} =
38+
H.prop (T.unpack setName) $
39+
propDiffResult leftValue rightValue expectedDiffResult
40+
41+
data TestSet a = TestSet
42+
{ setName :: T.Text
43+
, leftValue :: a
44+
, rightValue :: a
45+
, expectedDiffResult :: DiffResult a
46+
}
47+
deriving (Show)
48+
49+
setTestSets :: [TestSet (Set Int)]
50+
setTestSets =
51+
[ TestSet
52+
{ setName = "Equal"
53+
, leftValue = value1
54+
, rightValue = value1
55+
, expectedDiffResult = Equal
56+
}
57+
, TestSet
58+
{ setName = "Diff, LeftMissingKey"
59+
, leftValue = value1
60+
, rightValue = value2
61+
, expectedDiffResult = Error error2
62+
}
63+
, TestSet
64+
{ setName = "Diff, RightMissingKey"
65+
, leftValue = value1
66+
, rightValue = value3
67+
, expectedDiffResult = Error error3
68+
}
69+
]
70+
where
71+
value1 = Set.fromList [1, 3]
72+
73+
value2 = Set.fromList [1, 2, 3]
74+
error2 = DiffSpecial $ Set.LeftMissingKey 2
75+
76+
value3 = Set.fromList [1]
77+
error3 = DiffSpecial $ Set.RightMissingKey 3
78+
79+
mapTestSets :: [TestSet (Map Int String)]
80+
mapTestSets =
81+
[ TestSet
82+
{ setName = "Equal"
83+
, leftValue = value1
84+
, rightValue = value1
85+
, expectedDiffResult = Equal
86+
}
87+
, TestSet
88+
{ setName = "Diff, DiffAtKey"
89+
, leftValue = value1
90+
, rightValue = value2
91+
, expectedDiffResult = Error error2
92+
}
93+
, TestSet
94+
{ setName = "Diff, LeftMissingKey"
95+
, leftValue = value1
96+
, rightValue = value3
97+
, expectedDiffResult = Error error3
98+
}
99+
, TestSet
100+
{ setName = "Diff, RightMissingKey"
101+
, leftValue = value1
102+
, rightValue = value4
103+
, expectedDiffResult = Error error4
104+
}
105+
]
106+
where
107+
value1 = Map.fromList [(1, "one"), (3, "three")]
108+
109+
value2 = Map.fromList [(1, "one"), (3, "THREE")]
110+
error2 = DiffSpecial $ Map.DiffAtKey 3 TopLevelNotEqual
111+
112+
value3 = Map.fromList [(1, "one"), (2, "two"), (3, "three")]
113+
error3 = DiffSpecial $ Map.LeftMissingKey 2
114+
115+
value4 = Map.fromList [(1, "one")]
116+
error4 = DiffSpecial $ Map.RightMissingKey 3
117+
118+
seqTestSets :: [TestSet (Seq Int)]
119+
seqTestSets =
120+
[ TestSet
121+
{ setName = "Equal"
122+
, leftValue = value1
123+
, rightValue = value1
124+
, expectedDiffResult = Equal
125+
}
126+
, TestSet
127+
{ setName = "Diff, WrongLengths"
128+
, leftValue = value1
129+
, rightValue = value2
130+
, expectedDiffResult = Error error2
131+
}
132+
, TestSet
133+
{ setName = "Diff, DiffAtIndex"
134+
, leftValue = value1
135+
, rightValue = value3
136+
, expectedDiffResult = Error error3
137+
}
138+
]
139+
where
140+
value1 = Seq.fromList [1, 3]
141+
142+
value2 = Seq.fromList [1, 3, 4]
143+
error2 = DiffSpecial $ WrongLengths 2 3
144+
145+
value3 = Seq.fromList [1, 2]
146+
error3 = DiffSpecial $ DiffAtIndex 1 TopLevelNotEqual
147+
148+
treeTestSets :: [TestSet (Tree Int)]
149+
treeTestSets =
150+
[ TestSet
151+
{ setName = "Equal"
152+
, leftValue = value1
153+
, rightValue = value1
154+
, expectedDiffResult = Equal
155+
}
156+
, TestSet
157+
{ setName = "Diff, FieldMismatch, level 1"
158+
, leftValue = value1
159+
, rightValue = value2
160+
, expectedDiffResult = Error error2
161+
}
162+
, TestSet
163+
{ setName = "Diff, FieldMismatch, level 2, WrongLengths"
164+
, leftValue = value1
165+
, rightValue = value3
166+
, expectedDiffResult = Error error3
167+
}
168+
, TestSet
169+
{ setName = "Diff, FieldMismatch, level 2, DiffAtIndex"
170+
, leftValue = value1
171+
, rightValue = value4
172+
, expectedDiffResult = Error error4
173+
}
174+
]
175+
where
176+
value1 = Tree.Node 1 [Tree.Node 2 [], Tree.Node 3 [Tree.Node 4 [], Tree.Node 5 []]]
177+
178+
value2 = Tree.Node 2 []
179+
error2 = DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: Z TopLevelNotEqual
180+
181+
value3 = Tree.Node 1 [Tree.Node 2 []]
182+
error3 =
183+
let e = DiffSpecial $ WrongLengths 2 1
184+
in DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: S (Z e)
185+
186+
value4 = Tree.Node 1 [Tree.Node 2 [], Tree.Node 4 []]
187+
error4 =
188+
let e = DiffSpecial $ DiffAtIndex 1 $ DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: Z TopLevelNotEqual
189+
in DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: S (Z e)
190+
191+
nodeInfo :: ConstructorInfo '[Int, [Tree Int]]
192+
nodeInfo :* _ = constructorInfo $ gdatatypeInfo $ Proxy @(Tree Int)
193+
194+
customTreeTestSets :: [TestSet (CustomTree Int)]
195+
customTreeTestSets =
196+
[ TestSet
197+
{ setName = "Equal"
198+
, leftValue = value1
199+
, rightValue = value1
200+
, expectedDiffResult = Equal
201+
}
202+
, TestSet
203+
{ setName = "Diff, DiffAtNode, level 1"
204+
, leftValue = value1
205+
, rightValue = value2
206+
, expectedDiffResult = Error error2
207+
}
208+
, TestSet
209+
{ setName = "Diff, WrongLengthsOfChildren, level 2"
210+
, leftValue = value1
211+
, rightValue = value3
212+
, expectedDiffResult = Error error3
213+
}
214+
, TestSet
215+
{ setName = "Diff, DiffAtNode, level 2"
216+
, leftValue = value1
217+
, rightValue = value4
218+
, expectedDiffResult = Error error4
219+
}
220+
]
221+
where
222+
value1 = CustomTree $ Tree.Node 1 [Tree.Node 2 [], Tree.Node 3 [Tree.Node 4 [], Tree.Node 5 []]]
223+
224+
value2 = CustomTree $ Tree.Node 2 []
225+
error2 = DiffSpecial $ DiffAtNode (TreePath []) TopLevelNotEqual
226+
227+
value3 = CustomTree $ Tree.Node 1 [Tree.Node 2 []]
228+
error3 = DiffSpecial $ WrongLengthsOfChildren (TreePath []) 2 1
229+
230+
value4 = CustomTree $ Tree.Node 1 [Tree.Node 2 [], Tree.Node 4 []]
231+
error4 = DiffSpecial $ DiffAtNode (TreePath [1]) TopLevelNotEqual

‎examples/containers-instances/test/Spec.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

‎examples/containers-instances/test/Util.hs

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
module Util where
2+
3+
import qualified Data.Text.Lazy as TL
4+
import qualified Data.Text.Lazy.Builder as TB
5+
import Generics.Diff
6+
import Generics.Diff.Instances ()
7+
import Generics.Diff.Render
8+
import qualified Test.QuickCheck as Q
9+
10+
propDiffResult :: (Diff a, Show a) => a -> a -> DiffResult a -> Q.Property
11+
propDiffResult leftValue rightValue expectedDiffResult =
12+
let actualDiffResult = diff leftValue rightValue
13+
eq = expectedDiffResult == actualDiffResult
14+
showDiffResult = TL.unpack . TB.toLazyText . renderDiffResult
15+
addLabel =
16+
if eq
17+
then Q.property
18+
else
19+
Q.counterexample ("Expected DiffResult:\n" <> showDiffResult expectedDiffResult)
20+
. Q.counterexample ("Actual DiffResult:\n" <> showDiffResult actualDiffResult)
21+
. Q.counterexample ("Left value:\n" <> show leftValue)
22+
. Q.counterexample ("Right value:\n" <> show rightValue)
23+
in addLabel eq

0 commit comments

Comments
 (0)