[#87] Move tests to hspec (#88)

Resolves #87

stack.yaml

@@ -3,3 +3,4 @@ resolver: lts-15.8
 extra-deps:
   - dependent-map-0.2.4.0
   - dependent-sum-0.5
+  - hspec-hedgehog-0.0.1.2

test/Test.hs

@@ -1 +1,21 @@
-{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}
+module Main
+    ( main
+    ) where
+
+import Test.Hspec (hspec)
+
+import Test.TypeRep.CMap (cMapSpec)
+import Test.TypeRep.TypeRepMap (typeRepMapSpec)
+import Test.TypeRep.TypeRepMapProperty (typeRepMapPropertySpec)
+import Test.TypeRep.Vector (vectorSpec)
+import Test.TypeRep.VectorOpt (optimalVectorSpec)
+
+
+main :: IO ()
+main = hspec $ do
+    typeRepMapSpec
+    cMapSpec
+    vectorSpec
+    optimalVectorSpec
+    -- property
+    typeRepMapPropertySpec

test/Test/TypeRep/CMap.hs

@@ -1,16 +1,18 @@
-module Test.TypeRep.CMap where
+module Test.TypeRep.CMap
+    ( cMapSpec
+    ) where
 
 import Prelude hiding (lookup)
 
 import Data.Functor.Identity (Identity (..))
+import Test.Hspec (Spec, describe, it, shouldBe)
 
-import Test.Tasty.Hspec
+import Data.TypeRep.CMap (TypeRepMap, empty, insert, lookup, size)
 
-import Data.TypeRep.CMap
 
--- Simple test for 'lookup', 'insert' and 'size' functions.
-spec_insertLookup :: Spec
-spec_insertLookup = do
+-- | Simple test for 'lookup', 'insert' and 'size' functions.
+cMapSpec :: Spec
+cMapSpec = describe "Containers Map TypeRep" $ do
     describe "Lookup Test" $ do
         it "returns the inserted element" $
             lookup (insert (Identity 'a') empty) `shouldBe` Just (Identity 'a')

test/Test/TypeRep/TypeRepMap.hs

@@ -1,17 +1,20 @@
-module Test.TypeRep.CacheMap where
+module Test.TypeRep.TypeRepMap
+    ( typeRepMapSpec
+    ) where
 
 import Prelude hiding (lookup)
 
 import Data.Functor.Identity (Identity (..))
 import GHC.Exts (fromList)
-import Test.Tasty.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Spec, describe, it, shouldBe)
 
 import Data.TMap (TMap, empty, insert, lookup, one, size, union)
 import Data.TypeRepMap.Internal (WrapTypeable (..))
 
+
 -- Simple test for 'lookup', 'insert' and 'size' functions.
-spec_insertLookup :: Spec
-spec_insertLookup = do
+typeRepMapSpec :: Spec
+typeRepMapSpec = describe "TypeRepMap" $ do
     describe "Lookup Test" $ do
         it "returns the inserted element" $
             lookup (fromList [WrapTypeable $ Identity 'a']) `shouldBe` Just 'a'

test/Test/TypeRep/TypeRepMapProperty.hs

@@ -6,7 +6,9 @@
 
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
 
-module Test.TypeRep.MapProperty where
+module Test.TypeRep.TypeRepMapProperty
+    ( typeRepMapPropertySpec
+    ) where
 
 import Prelude hiding (lookup)
 
@@ -15,43 +17,50 @@ import Data.Semigroup (Semigroup (..))
 import GHC.Exts (fromList)
 import GHC.Stack (HasCallStack)
 import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
-import Hedgehog (MonadGen, PropertyT, forAll, property, (===), assert)
-import Test.Tasty (TestName, TestTree)
-import Test.Tasty.Hedgehog (testProperty)
+import Hedgehog (MonadGen, PropertyT, assert, forAll, property, (===))
+import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)
+import Test.Hspec.Hedgehog (hedgehog)
 
-import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), delete, insert, lookup, member, invariantCheck)
+import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), delete, insert, invariantCheck,
+                                 lookup, member)
 
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
-----------------------------------------------------------------------------
--- Common utils
-----------------------------------------------------------------------------
 
-type PropertyTest = [TestTree]
-
-prop :: HasCallStack => TestName -> PropertyT IO () -> PropertyTest
-prop testName = pure . testProperty testName . property
+typeRepMapPropertySpec :: Spec
+typeRepMapPropertySpec = describe "TypeRepMap Property tests" $ do
+    describe "Map modification properties" $ do
+        insertLookupSpec
+        insertInsertSpec
+        deleteMemberSpec
+        insertInvariantSpec
+        deleteInvariantSpec
+    describe "Instance Laws" $ do
+        semigroupAssocSpec
+        monoidIdentitySpec
 
 ----------------------------------------------------------------------------
 -- Map modification properties
 ----------------------------------------------------------------------------
 
-test_InsertLookup :: PropertyTest
-test_InsertLookup =  prop "lookup k (insert k v m) == Just v" $ do
+type Property = SpecWith (Arg Expectation)
+
+insertLookupSpec :: Property
+insertLookupSpec = it "lookup k (insert k v m) == Just v" $ hedgehog $ do
     m <- forAll genMap
     WrapTypeable (proxy :: IntProxy n) <- forAll genTF
     lookup @n @IntProxy (insert proxy m) === Just proxy
 
-test_InsertInsert :: PropertyTest
-test_InsertInsert = prop "insert k b . insert k a == insert k b" $ do
+insertInsertSpec :: Property
+insertInsertSpec = it "insert k b . insert k a == insert k b" $ hedgehog $ do
     m <- forAll genMap
     WrapTypeable a@(IntProxy (proxy :: Proxy n) i) <- forAll genTF
     let b = IntProxy proxy (i + 1)
     lookup @n @IntProxy (insert b $ insert a m) === Just b
 
-test_DeleteMember :: PropertyTest
-test_DeleteMember = prop "member k . delete k == False" $ do
+deleteMemberSpec :: Property
+deleteMemberSpec = it "member k . delete k == False" $ hedgehog $ do
     m <- forAll genMap
     WrapTypeable (proxy :: IntProxy n) <- forAll genTF
     shouldInsert <- forAll Gen.bool
@@ -61,14 +70,14 @@ test_DeleteMember = prop "member k . delete k == False" $ do
     else
         member @n (delete @n m) === False
 
-test_InsertInvariant :: PropertyTest
-test_InsertInvariant = prop "invariantCheck (insert k b) == True" $ do
+insertInvariantSpec :: Property
+insertInvariantSpec = it "invariantCheck (insert k b) == True" $ hedgehog $ do
     m <- forAll genMap
     WrapTypeable a <- forAll genTF
     assert $ invariantCheck (insert a m)
 
-test_DeleteInvariant :: PropertyTest
-test_DeleteInvariant = prop "invariantCheck (delete k b) == True" $ do
+deleteInvariantSpec :: Property
+deleteInvariantSpec = it "invariantCheck (delete k b) == True" $ hedgehog $ do
     m <- forAll genMap
     WrapTypeable (_ :: IntProxy n) <- forAll genTF
     assert $ invariantCheck (delete @n m)
@@ -78,20 +87,21 @@ test_DeleteInvariant = prop "invariantCheck (delete k b) == True" $ do
 ----------------------------------------------------------------------------
 
 #if __GLASGOW_HASKELL__ < 806
--- This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's. It's
--- not a good idea to write such `Eq` instance for `TypeRepMap` itself because
--- it doesn't compare values so it's not true equality. But this should be
--- enough for tests.
+{- | This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's.
+It's not a good idea to write such 'Eq' instance for 'TypeRepMap' itself because
+it doesn't compare values so it's not true equality. But this should be enough
+for tests.
+-}
 newtype FpMap f = FpMap (TypeRepMap f)
-  deriving newtype (Show, Semigroup, Monoid)
+    deriving newtype (Show, Semigroup, Monoid)
 
 instance Eq (FpMap f) where
     FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) =
         as1 == as2 && bs1 == bs2
 #endif
 
-test_SemigroupAssoc :: PropertyTest
-test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do
+semigroupAssocSpec :: Property
+semigroupAssocSpec = it "x <> (y <> z) == (x <> y) <> z" $ hedgehog $ do
 #if __GLASGOW_HASKELL__ >= 806
     x <- forAll genMap
     y <- forAll genMap
@@ -101,11 +111,10 @@ test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do
     y <- FpMap <$> forAll genMap
     z <- FpMap <$> forAll genMap
 #endif
-
     (x <> (y <> z)) === ((x <> y) <> z)
 
-test_MonoidIdentity :: PropertyTest
-test_MonoidIdentity = prop "x <> mempty == mempty <> x == x" $ do
+monoidIdentitySpec :: Property
+monoidIdentitySpec = it "x <> mempty == mempty <> x == x" $ hedgehog $ do
 #if __GLASGOW_HASKELL__ >= 806
     x <- forAll genMap
 #else

test/Test/TypeRep/Vector.hs

@@ -1,16 +1,18 @@
-module Test.TypeRep.Vector where
+module Test.TypeRep.Vector
+    ( vectorSpec
+    ) where
 
 import Prelude hiding (lookup)
 
 import Data.Functor.Identity (Identity (..))
+import Test.Hspec (Spec, describe, it, shouldBe)
 
-import Test.Tasty.Hspec
+import Data.TypeRep.Vector (TF (..), fromList, lookup)
 
-import Data.TypeRep.Vector
 
--- Simple test for 'lookup', 'insert' and 'size' functions.
-spec_insertLookup :: Spec
-spec_insertLookup =
+-- | Simple test for 'lookup', 'insert' and 'size' functions.
+vectorSpec :: Spec
+vectorSpec = describe "Vector TypeRep" $
     describe "Lookup Test" $ do
         it "returns the inserted element" $
             lookup (fromList [TF (Identity 'a')]) `shouldBe` Just (Identity 'a')

test/Test/TypeRep/VectorOpt.hs

@@ -1,16 +1,18 @@
-module Test.TypeRep.VectorOpt where
+module Test.TypeRep.VectorOpt
+    ( optimalVectorSpec
+    ) where
 
 import Prelude hiding (lookup)
 
 import Data.Functor.Identity (Identity (..))
-
-import Test.Tasty.Hspec
+import Test.Hspec (Spec, describe, it, shouldBe)
 
 import Data.TypeRep.OptimalVector (TF (..), fromList, lookup)
 
--- Simple test for 'lookup', 'insert' and 'size' functions.
-spec_insertLookup :: Spec
-spec_insertLookup =
+
+-- | Simple test for 'lookup', 'insert' and 'size' functions.
+optimalVectorSpec :: Spec
+optimalVectorSpec = describe "Optimal Vector TypeRep" $
     describe "Lookup Test" $ do
         it "returns the inserted element" $
             lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a')

typerep-map.cabal

@@ -81,20 +81,17 @@ test-suite typerep-map-test
 
   main-is:             Test.hs
   other-modules:       Test.TypeRep.CMap
-                     , Test.TypeRep.CacheMap
-                     , Test.TypeRep.MapProperty
+                     , Test.TypeRep.TypeRepMap
+                     , Test.TypeRep.TypeRepMapProperty
                      , Test.TypeRep.Vector
                      , Test.TypeRep.VectorOpt
 
-  build-tool-depends:  tasty-discover:tasty-discover
   build-depends:       ghc-typelits-knownnat >= 0.4.2 && < 0.8
                      , hedgehog ^>= 1.0
+                     , hspec ^>= 2.7.1
+                     , hspec-hedgehog ^>= 0.0.1
                      , typerep-map
                      , typerep-extra-impls
-                     , tasty >= 1.0.1.1 && < 1.3
-                     , tasty-discover >= 4.1.1 && < 4.3
-                     , tasty-hedgehog ^>= 1.0.0.0
-                     , tasty-hspec ^>= 1.1.5
 
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N