git.iko.soy/typerep-map
on main help sign in
[#87] Move tests to hspec (#88)
5d78b48Veronika Romashkina
stack.yaml+1
compare with main
unifiedsplit
@@ -3,3 +3,4 @@ resolver: lts-15.8
3extra-deps:
3extra-deps:
4 - dependent-map-0.2.4.0
4 - dependent-map-0.2.4.0
5 - dependent-sum-0.5
5 - dependent-sum-0.5
6+ - hspec-hedgehog-0.0.1.2
test/Test.hs+21−1
@@ -1 +1,21 @@
1−{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}
1+module Main
2+ ( main
3+ ) where
4+
5+import Test.Hspec (hspec)
6+
7+import Test.TypeRep.CMap (cMapSpec)
8+import Test.TypeRep.TypeRepMap (typeRepMapSpec)
9+import Test.TypeRep.TypeRepMapProperty (typeRepMapPropertySpec)
10+import Test.TypeRep.Vector (vectorSpec)
11+import Test.TypeRep.VectorOpt (optimalVectorSpec)
12+
13+
14+main :: IO ()
15+main = hspec $ do
16+ typeRepMapSpec
17+ cMapSpec
18+ vectorSpec
19+ optimalVectorSpec
20+ -- property
21+ typeRepMapPropertySpec
test/Test/TypeRep/CMap.hs+8−6
@@ -1,16 +1,18 @@
1−module Test.TypeRep.CMap where
1+module Test.TypeRep.CMap
2+ ( cMapSpec
3+ ) where
2
4
3import Prelude hiding (lookup)
5import Prelude hiding (lookup)
4
6
5import Data.Functor.Identity (Identity (..))
7import Data.Functor.Identity (Identity (..))
8+import Test.Hspec (Spec, describe, it, shouldBe)
6
9
7−import Test.Tasty.Hspec
10+import Data.TypeRep.CMap (TypeRepMap, empty, insert, lookup, size)
8
11
9−import Data.TypeRep.CMap
10
12
11−-- Simple test for 'lookup', 'insert' and 'size' functions.
13+-- | Simple test for 'lookup', 'insert' and 'size' functions.
12−spec_insertLookup :: Spec
14+cMapSpec :: Spec
13−spec_insertLookup = do
15+cMapSpec = describe "Containers Map TypeRep" $ do
14 describe "Lookup Test" $ do
16 describe "Lookup Test" $ do
15 it "returns the inserted element" $
17 it "returns the inserted element" $
16 lookup (insert (Identity 'a') empty) `shouldBe` Just (Identity 'a')
18 lookup (insert (Identity 'a') empty) `shouldBe` Just (Identity 'a')
test/Test/TypeRep/CacheMap.hs → test/Test/TypeRep/TypeRepMap.hsrenamed+7−4
@@ -1,17 +1,20 @@
1−module Test.TypeRep.CacheMap where
1+module Test.TypeRep.TypeRepMap
2+ ( typeRepMapSpec
3+ ) where
2
4
3import Prelude hiding (lookup)
5import Prelude hiding (lookup)
4
6
5import Data.Functor.Identity (Identity (..))
7import Data.Functor.Identity (Identity (..))
6import GHC.Exts (fromList)
8import GHC.Exts (fromList)
7−import Test.Tasty.Hspec (Spec, describe, it, shouldBe)
9+import Test.Hspec (Spec, describe, it, shouldBe)
8
10
9import Data.TMap (TMap, empty, insert, lookup, one, size, union)
11import Data.TMap (TMap, empty, insert, lookup, one, size, union)
10import Data.TypeRepMap.Internal (WrapTypeable (..))
12import Data.TypeRepMap.Internal (WrapTypeable (..))
11
13
14+
12-- Simple test for 'lookup', 'insert' and 'size' functions.
15-- Simple test for 'lookup', 'insert' and 'size' functions.
13−spec_insertLookup :: Spec
16+typeRepMapSpec :: Spec
14−spec_insertLookup = do
17+typeRepMapSpec = describe "TypeRepMap" $ do
15 describe "Lookup Test" $ do
18 describe "Lookup Test" $ do
16 it "returns the inserted element" $
19 it "returns the inserted element" $
17 lookup (fromList [WrapTypeable $ Identity 'a']) `shouldBe` Just 'a'
20 lookup (fromList [WrapTypeable $ Identity 'a']) `shouldBe` Just 'a'
test/Test/TypeRep/MapProperty.hs → test/Test/TypeRep/TypeRepMapProperty.hsrenamed+41−32
@@ -6,7 +6,9 @@
6
6
7{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
7{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
8
8
9−module Test.TypeRep.MapProperty where
9+module Test.TypeRep.TypeRepMapProperty
10+ ( typeRepMapPropertySpec
11+ ) where
10
12
11import Prelude hiding (lookup)
13import Prelude hiding (lookup)
12
14
@@ -15,43 +17,50 @@ import Data.Semigroup (Semigroup (..))
15import GHC.Exts (fromList)
17import GHC.Exts (fromList)
16import GHC.Stack (HasCallStack)
18import GHC.Stack (HasCallStack)
17import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
19import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
18−import Hedgehog (MonadGen, PropertyT, forAll, property, (===), assert)
20+import Hedgehog (MonadGen, PropertyT, assert, forAll, property, (===))
19−import Test.Tasty (TestName, TestTree)
21+import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)
20−import Test.Tasty.Hedgehog (testProperty)
22+import Test.Hspec.Hedgehog (hedgehog)
21
23
22−import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), delete, insert, lookup, member, invariantCheck)
24+import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), delete, insert, invariantCheck,
25+ lookup, member)
23
26
24import qualified Hedgehog.Gen as Gen
27import qualified Hedgehog.Gen as Gen
25import qualified Hedgehog.Range as Range
28import qualified Hedgehog.Range as Range
26
29
27−----------------------------------------------------------------------------
28−-- Common utils
29−----------------------------------------------------------------------------
30−
31−type PropertyTest = [TestTree]
32
30
33−prop :: HasCallStack => TestName -> PropertyT IO () -> PropertyTest
31+typeRepMapPropertySpec :: Spec
34−prop testName = pure . testProperty testName . property
32+typeRepMapPropertySpec = describe "TypeRepMap Property tests" $ do
33+ describe "Map modification properties" $ do
34+ insertLookupSpec
35+ insertInsertSpec
36+ deleteMemberSpec
37+ insertInvariantSpec
38+ deleteInvariantSpec
39+ describe "Instance Laws" $ do
40+ semigroupAssocSpec
41+ monoidIdentitySpec
35
42
36----------------------------------------------------------------------------
43----------------------------------------------------------------------------
37-- Map modification properties
44-- Map modification properties
38----------------------------------------------------------------------------
45----------------------------------------------------------------------------
39
46
40−test_InsertLookup :: PropertyTest
47+type Property = SpecWith (Arg Expectation)
48+
49+insertLookupSpec :: Property
41−test_InsertLookup = prop "lookup k (insert k v m) == Just v" $ do
50+insertLookupSpec = it "lookup k (insert k v m) == Just v" $ hedgehog $ do
42 m <- forAll genMap
51 m <- forAll genMap
43 WrapTypeable (proxy :: IntProxy n) <- forAll genTF
52 WrapTypeable (proxy :: IntProxy n) <- forAll genTF
44 lookup @n @IntProxy (insert proxy m) === Just proxy
53 lookup @n @IntProxy (insert proxy m) === Just proxy
45
54
46−test_InsertInsert :: PropertyTest
55+insertInsertSpec :: Property
47−test_InsertInsert = prop "insert k b . insert k a == insert k b" $ do
56+insertInsertSpec = it "insert k b . insert k a == insert k b" $ hedgehog $ do
48 m <- forAll genMap
57 m <- forAll genMap
49 WrapTypeable a@(IntProxy (proxy :: Proxy n) i) <- forAll genTF
58 WrapTypeable a@(IntProxy (proxy :: Proxy n) i) <- forAll genTF
50 let b = IntProxy proxy (i + 1)
59 let b = IntProxy proxy (i + 1)
51 lookup @n @IntProxy (insert b $ insert a m) === Just b
60 lookup @n @IntProxy (insert b $ insert a m) === Just b
52
61
53−test_DeleteMember :: PropertyTest
62+deleteMemberSpec :: Property
54−test_DeleteMember = prop "member k . delete k == False" $ do
63+deleteMemberSpec = it "member k . delete k == False" $ hedgehog $ do
55 m <- forAll genMap
64 m <- forAll genMap
56 WrapTypeable (proxy :: IntProxy n) <- forAll genTF
65 WrapTypeable (proxy :: IntProxy n) <- forAll genTF
57 shouldInsert <- forAll Gen.bool
66 shouldInsert <- forAll Gen.bool
@@ -61,14 +70,14 @@ test_DeleteMember = prop "member k . delete k == False" $ do
61 else
70 else
62 member @n (delete @n m) === False
71 member @n (delete @n m) === False
63
72
64−test_InsertInvariant :: PropertyTest
73+insertInvariantSpec :: Property
65−test_InsertInvariant = prop "invariantCheck (insert k b) == True" $ do
74+insertInvariantSpec = it "invariantCheck (insert k b) == True" $ hedgehog $ do
66 m <- forAll genMap
75 m <- forAll genMap
67 WrapTypeable a <- forAll genTF
76 WrapTypeable a <- forAll genTF
68 assert $ invariantCheck (insert a m)
77 assert $ invariantCheck (insert a m)
69
78
70−test_DeleteInvariant :: PropertyTest
79+deleteInvariantSpec :: Property
71−test_DeleteInvariant = prop "invariantCheck (delete k b) == True" $ do
80+deleteInvariantSpec = it "invariantCheck (delete k b) == True" $ hedgehog $ do
72 m <- forAll genMap
81 m <- forAll genMap
73 WrapTypeable (_ :: IntProxy n) <- forAll genTF
82 WrapTypeable (_ :: IntProxy n) <- forAll genTF
74 assert $ invariantCheck (delete @n m)
83 assert $ invariantCheck (delete @n m)
@@ -78,20 +87,21 @@ test_DeleteInvariant = prop "invariantCheck (delete k b) == True" $ do
78----------------------------------------------------------------------------
87----------------------------------------------------------------------------
79
88
80#if __GLASGOW_HASKELL__ < 806
89#if __GLASGOW_HASKELL__ < 806
81−-- This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's. It's
90+{- | This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's.
82−-- not a good idea to write such `Eq` instance for `TypeRepMap` itself because
91+It's not a good idea to write such 'Eq' instance for 'TypeRepMap' itself because
83−-- it doesn't compare values so it's not true equality. But this should be
92+it doesn't compare values so it's not true equality. But this should be enough
84−-- enough for tests.
93+for tests.
94+-}
85newtype FpMap f = FpMap (TypeRepMap f)
95newtype FpMap f = FpMap (TypeRepMap f)
86− deriving newtype (Show, Semigroup, Monoid)
96+ deriving newtype (Show, Semigroup, Monoid)
87
97
88instance Eq (FpMap f) where
98instance Eq (FpMap f) where
89 FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) =
99 FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) =
90 as1 == as2 && bs1 == bs2
100 as1 == as2 && bs1 == bs2
91#endif
101#endif
92
102
93−test_SemigroupAssoc :: PropertyTest
103+semigroupAssocSpec :: Property
94−test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do
104+semigroupAssocSpec = it "x <> (y <> z) == (x <> y) <> z" $ hedgehog $ do
95#if __GLASGOW_HASKELL__ >= 806
105#if __GLASGOW_HASKELL__ >= 806
96 x <- forAll genMap
106 x <- forAll genMap
97 y <- forAll genMap
107 y <- forAll genMap
@@ -101,11 +111,10 @@ test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do
101 y <- FpMap <$> forAll genMap
111 y <- FpMap <$> forAll genMap
102 z <- FpMap <$> forAll genMap
112 z <- FpMap <$> forAll genMap
103#endif
113#endif
104−
105 (x <> (y <> z)) === ((x <> y) <> z)
114 (x <> (y <> z)) === ((x <> y) <> z)
106
115
107−test_MonoidIdentity :: PropertyTest
116+monoidIdentitySpec :: Property
108−test_MonoidIdentity = prop "x <> mempty == mempty <> x == x" $ do
117+monoidIdentitySpec = it "x <> mempty == mempty <> x == x" $ hedgehog $ do
109#if __GLASGOW_HASKELL__ >= 806
118#if __GLASGOW_HASKELL__ >= 806
110 x <- forAll genMap
119 x <- forAll genMap
111#else
120#else
test/Test/TypeRep/Vector.hs+8−6
@@ -1,16 +1,18 @@
1−module Test.TypeRep.Vector where
1+module Test.TypeRep.Vector
2+ ( vectorSpec
3+ ) where
2
4
3import Prelude hiding (lookup)
5import Prelude hiding (lookup)
4
6
5import Data.Functor.Identity (Identity (..))
7import Data.Functor.Identity (Identity (..))
8+import Test.Hspec (Spec, describe, it, shouldBe)
6
9
7−import Test.Tasty.Hspec
10+import Data.TypeRep.Vector (TF (..), fromList, lookup)
8
11
9−import Data.TypeRep.Vector
10
12
11−-- Simple test for 'lookup', 'insert' and 'size' functions.
13+-- | Simple test for 'lookup', 'insert' and 'size' functions.
12−spec_insertLookup :: Spec
14+vectorSpec :: Spec
13−spec_insertLookup =
15+vectorSpec = describe "Vector TypeRep" $
14 describe "Lookup Test" $ do
16 describe "Lookup Test" $ do
15 it "returns the inserted element" $
17 it "returns the inserted element" $
16 lookup (fromList [TF (Identity 'a')]) `shouldBe` Just (Identity 'a')
18 lookup (fromList [TF (Identity 'a')]) `shouldBe` Just (Identity 'a')
test/Test/TypeRep/VectorOpt.hs+8−6
@@ -1,16 +1,18 @@
1−module Test.TypeRep.VectorOpt where
1+module Test.TypeRep.VectorOpt
2+ ( optimalVectorSpec
3+ ) where
2
4
3import Prelude hiding (lookup)
5import Prelude hiding (lookup)
4
6
5import Data.Functor.Identity (Identity (..))
7import Data.Functor.Identity (Identity (..))
6−
7−import Test.Tasty.Hspec
8+import Test.Hspec (Spec, describe, it, shouldBe)
8
9
9import Data.TypeRep.OptimalVector (TF (..), fromList, lookup)
10import Data.TypeRep.OptimalVector (TF (..), fromList, lookup)
10
11
12+
11−-- Simple test for 'lookup', 'insert' and 'size' functions.
13+-- | Simple test for 'lookup', 'insert' and 'size' functions.
12−spec_insertLookup :: Spec
14+optimalVectorSpec :: Spec
13−spec_insertLookup =
15+optimalVectorSpec = describe "Optimal Vector TypeRep" $
14 describe "Lookup Test" $ do
16 describe "Lookup Test" $ do
15 it "returns the inserted element" $
17 it "returns the inserted element" $
16 lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a')
18 lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a')
typerep-map.cabal+4−7
@@ -81,20 +81,17 @@ test-suite typerep-map-test
81
81
82 main-is: Test.hs
82 main-is: Test.hs
83 other-modules: Test.TypeRep.CMap
83 other-modules: Test.TypeRep.CMap
84− , Test.TypeRep.CacheMap
84+ , Test.TypeRep.TypeRepMap
85− , Test.TypeRep.MapProperty
85+ , Test.TypeRep.TypeRepMapProperty
86 , Test.TypeRep.Vector
86 , Test.TypeRep.Vector
87 , Test.TypeRep.VectorOpt
87 , Test.TypeRep.VectorOpt
88
88
89− build-tool-depends: tasty-discover:tasty-discover
90 build-depends: ghc-typelits-knownnat >= 0.4.2 && < 0.8
89 build-depends: ghc-typelits-knownnat >= 0.4.2 && < 0.8
91 , hedgehog ^>= 1.0
90 , hedgehog ^>= 1.0
91+ , hspec ^>= 2.7.1
92+ , hspec-hedgehog ^>= 0.0.1
92 , typerep-map
93 , typerep-map
93 , typerep-extra-impls
94 , typerep-extra-impls
94− , tasty >= 1.0.1.1 && < 1.3
95− , tasty-discover >= 4.1.1 && < 4.3
96− , tasty-hedgehog ^>= 1.0.0.0
97− , tasty-hspec ^>= 1.1.5
98
95
99 ghc-options: -threaded -rtsopts -with-rtsopts=-N
96 ghc-options: -threaded -rtsopts -with-rtsopts=-N
100
97