[#47] Add Eq instance to TypeRepMap using QuantifiedConstraints (#72)

* [#47] Add Eq instance to TypeRepMap using QuantifiedConstraints

Resolves #47

* Fix tests on old GHCs

.travis.yml

@@ -4,7 +4,7 @@ language: haskell
 git:
   depth: 5
 
-cabal: "2.0"
+cabal: "2.4"
 
 cache:
   directories:
@@ -18,7 +18,7 @@ matrix:
   - ghc: 8.4.4
   - ghc: 8.6.3
 
-  - ghc: 8.6.3
+  - ghc: 8.6.4
     env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml"
 
 install:
@@ -35,7 +35,7 @@ install:
 script:
   - |
     if [ -z "$STACK_YAML" ]; then
-      cabal new-test $ALLOWNEWER
+      cabal new-test --enable-tests
     else
       stack build --system-ghc --test --bench --no-run-benchmarks --no-terminal --ghc-options=-Werror
     fi

CHANGELOG.md

@@ -1,16 +1,22 @@
-Change log
-==========
+# Changelog
 
 `typerep-map` uses [PVP Versioning][1].
-The change log is available [on GitHub][2].
+The changelog is available [on GitHub][2].
 
-# 0.3.1
+## 0.3.2 — Mar 27, 2019
+
+* [#47](https://github.com/kowainik/typerep-map/issues/47):
+  Add `Eq` instance for `TypeRepMap` using `-XQuantifiedConstraints`.
+* [#70](https://github.com/kowainik/typerep-map/issues/70):
+  Bump up to `dependent-sum-0.5`.
+
+## 0.3.1
 
 * [#64](https://github.com/kowainik/typerep-map/issues/64):
   Fix segfault in `toList`.
 * Support GHC 8.4.4 and 8.6.3.
 
-# 0.3.0
+## 0.3.0
 
 * [#46](https://github.com/kowainik/typerep-map/issues/46):
   Make `Show` instance for `TypeRepMap` show keys.
@@ -22,7 +28,7 @@ The change log is available [on GitHub][2].
   instead of `IntMap`.
 
 
-# 0.2.0
+## 0.2.0
 
 * [#43](https://github.com/kowainik/typerep-map/issues/43):
   Implement `IsList` instance for `TypeRepMap`.
@@ -32,7 +38,7 @@ The change log is available [on GitHub][2].
   Add `map` function for `TMap`.
 * Drop support for `ghc-8.0.2`.
 
-# 0.1.0
+## 0.1.0
 
 * Initially created.
 

src/Data/TypeRepMap/Internal.hs

@@ -1,33 +1,40 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns        #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE InstanceSigs        #-}
-{-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE MagicHash           #-}
-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE Rank2Types          #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeInType          #-}
-{-# LANGUAGE ViewPatterns        #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE InstanceSigs          #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MagicHash             #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE Rank2Types            #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeInType            #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+#if __GLASGOW_HASKELL__ >= 806
+{-# LANGUAGE QuantifiedConstraints #-}
+#endif
 
 -- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-}
 
--- | Internal API for 'TypeRepMap' and operations on it. The functions here do
--- not have any stability guarantees and can change between minor versions.
---
--- If you need to use this module for purposes other than tests,
--- create an issue.
---
+{- | Internal API for 'TypeRepMap' and operations on it. The functions here do
+not have any stability guarantees and can change between minor versions.
+
+If you need to use this module for purposes other than tests,
+create an issue.
+-}
+
 module Data.TypeRepMap.Internal where
 
 import Prelude hiding (lookup)
 
+import Control.DeepSeq
 import Control.Monad.ST (ST, runST)
 import Control.Monad.Zip (mzip)
-import Control.DeepSeq
 import Data.Function (on)
 import Data.Kind (Type)
+import Data.Type.Equality ((:~:) (..), TestEquality (..))
 import Data.List (intercalate, nubBy)
 import Data.Primitive.Array (Array, MutableArray, indexArray, mapArray', readArray, sizeofArray,
                              thawArray, unsafeFreezeArray, writeArray)
@@ -97,6 +104,31 @@ instance Monoid (TypeRepMap f) where
     {-# INLINE mempty #-}
     {-# INLINE mappend #-}
 
+#if __GLASGOW_HASKELL__ >= 806
+instance (forall a. Typeable a => Eq (f a)) => Eq (TypeRepMap f) where
+    tm1 == tm2 = size tm1 == size tm2 && go 0
+      where
+        go :: Int -> Bool
+        go i
+            | i == size tm1 = True
+            | otherwise = case testEquality tr1i tr2i of
+                  Nothing -> False
+                  Just Refl -> repEq tr1i (fromAny tv1i) (fromAny tv2i) && go (i + 1)
+          where
+            tr1i :: TypeRep x
+            tr1i = anyToTypeRep $ indexArray (trKeys tm1) i
+
+            tr2i :: TypeRep y
+            tr2i = anyToTypeRep $ indexArray (trKeys tm2) i
+
+            tv1i, tv2i :: Any
+            tv1i = indexArray (trAnys tm1) i
+            tv2i = indexArray (trAnys tm2) i
+
+            repEq :: TypeRep x -> f x -> f x -> Bool
+            repEq tr = withTypeable tr (==)
+#endif
+
 -- | Returns the list of 'Fingerprint's from 'TypeRepMap'.
 toFingerprints :: TypeRepMap f -> [Fingerprint]
 toFingerprints TypeRepMap{..} =

test/Test/TypeRep/MapProperty.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
@@ -65,6 +66,7 @@ test_DeleteMember = prop "member k . delete k == False" $ do
 -- Semigroup and Monoid laws
 ----------------------------------------------------------------------------
 
+#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
@@ -75,18 +77,29 @@ newtype FpMap f = FpMap (TypeRepMap f)
 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
+#if __GLASGOW_HASKELL__ >= 806
+    x <- forAll genMap
+    y <- forAll genMap
+    z <- forAll genMap
+#else
     x <- FpMap <$> forAll genMap
     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
+#if __GLASGOW_HASKELL__ >= 806
+    x <- forAll genMap
+#else
     x <- FpMap <$> forAll genMap
+#endif
 
     x <> mempty === x
     mempty <> x === x

typerep-map.cabal

@@ -1,5 +1,5 @@
 name:                typerep-map
-version:             0.3.1
+version:             0.3.2
 synopsis:            Efficient implementation of a dependent map with types as keys
 description:
     A dependent map from type representations to values of these types.