449d597 · typerep-map · git.iko.soy

git.iko.soy/typerep-map

on main help sign in

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

449d597Dmitrii Kovanikov8 years ago

.travis.yml+3−3

compare with main

unifiedsplit

@@ -4,7 +4,7 @@ language: haskell

4git:

5 depth: 5

7−cabal: "2.0"

7+cabal: "2.4"

9cache:

10 directories:

@@ -18,7 +18,7 @@ matrix:

18 - ghc: 8.4.4

19 - ghc: 8.6.3

21− - ghc: 8.6.3

21+ - ghc: 8.6.4

22 env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml"

24install:

@@ -35,7 +35,7 @@ install:

35script:

36 - |

37 if [ -z "$STACK_YAML" ]; then

38− cabal new-test $ALLOWNEWER

38+ cabal new-test --enable-tests

39 else

40 stack build --system-ghc --test --bench --no-run-benchmarks --no-terminal --ghc-options=-Werror

41 fi

CHANGELOG.md+13−7

@@ -1,16 +1,22 @@

1−Change log

1+# Changelog

2−==========

4`typerep-map` uses [PVP Versioning][1].

3`typerep-map` uses [PVP Versioning][1].

5−The change log is available [on GitHub][2].

4+The changelog is available [on GitHub][2].

6+## 0.3.2 — Mar 27, 2019

8+* [#47](https://github.com/kowainik/typerep-map/issues/47):

9+ Add `Eq` instance for `TypeRepMap` using `-XQuantifiedConstraints`.

10+* [#70](https://github.com/kowainik/typerep-map/issues/70):

11+ Bump up to `dependent-sum-0.5`.

12+

7−# 0.3.1

13+## 0.3.1

9* [#64](https://github.com/kowainik/typerep-map/issues/64):

15* [#64](https://github.com/kowainik/typerep-map/issues/64):

10 Fix segfault in `toList`.

16 Fix segfault in `toList`.

11* Support GHC 8.4.4 and 8.6.3.

17* Support GHC 8.4.4 and 8.6.3.

13−# 0.3.0

19+## 0.3.0

15* [#46](https://github.com/kowainik/typerep-map/issues/46):

21* [#46](https://github.com/kowainik/typerep-map/issues/46):

16 Make `Show` instance for `TypeRepMap` show keys.

22 Make `Show` instance for `TypeRepMap` show keys.

@@ -22,7 +28,7 @@ The change log is available [on GitHub][2].

22 instead of `IntMap`.

28 instead of `IntMap`.

25−# 0.2.0

31+## 0.2.0

27* [#43](https://github.com/kowainik/typerep-map/issues/43):

33* [#43](https://github.com/kowainik/typerep-map/issues/43):

28 Implement `IsList` instance for `TypeRepMap`.

34 Implement `IsList` instance for `TypeRepMap`.

@@ -32,7 +38,7 @@ The change log is available [on GitHub][2].

32 Add `map` function for `TMap`.

38 Add `map` function for `TMap`.

33* Drop support for `ghc-8.0.2`.

39* Drop support for `ghc-8.0.2`.

35−# 0.1.0

41+## 0.1.0

37* Initially created.

43* Initially created.

src/Data/TypeRepMap/Internal.hs+51−19

@@ -1,33 +1,40 @@

1−{-# LANGUAGE AllowAmbiguousTypes #-}

1+{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE CPP #-}

3−{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE DataKinds #-}

4−{-# LANGUAGE GADTs #-}

5+{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE InstanceSigs #-}

6+{-# LANGUAGE InstanceSigs #-}

6−{-# LANGUAGE KindSignatures #-}

7+{-# LANGUAGE KindSignatures #-}

7−{-# LANGUAGE MagicHash #-}

8+{-# LANGUAGE MagicHash #-}

8−{-# LANGUAGE PolyKinds #-}

9+{-# LANGUAGE PolyKinds #-}

9−{-# LANGUAGE Rank2Types #-}

10+{-# LANGUAGE Rank2Types #-}

10−{-# LANGUAGE TypeFamilies #-}

11+{-# LANGUAGE TypeFamilies #-}

11−{-# LANGUAGE TypeInType #-}

12+{-# LANGUAGE TypeInType #-}

12−{-# LANGUAGE ViewPatterns #-}

13+{-# LANGUAGE ViewPatterns #-}

14+

15+#if __GLASGOW_HASKELL__ >= 806

16+{-# LANGUAGE QuantifiedConstraints #-}

17+#endif

14-- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-}

19-- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-}

16−-- | Internal API for 'TypeRepMap' and operations on it. The functions here do

21+{- | Internal API for 'TypeRepMap' and operations on it. The functions here do

17−-- not have any stability guarantees and can change between minor versions.

22+not have any stability guarantees and can change between minor versions.

18−--

23+

19−-- If you need to use this module for purposes other than tests,

24+If you need to use this module for purposes other than tests,

20−-- create an issue.

25+create an issue.

21−--

26+-}

27+

22module Data.TypeRepMap.Internal where

28module Data.TypeRepMap.Internal where

24import Prelude hiding (lookup)

30import Prelude hiding (lookup)

32+import Control.DeepSeq

26import Control.Monad.ST (ST, runST)

33import Control.Monad.ST (ST, runST)

27import Control.Monad.Zip (mzip)

34import Control.Monad.Zip (mzip)

28−import Control.DeepSeq

29import Data.Function (on)

35import Data.Function (on)

30import Data.Kind (Type)

36import Data.Kind (Type)

37+import Data.Type.Equality ((:~:) (..), TestEquality (..))

31import Data.List (intercalate, nubBy)

38import Data.List (intercalate, nubBy)

32import Data.Primitive.Array (Array, MutableArray, indexArray, mapArray', readArray, sizeofArray,

39import Data.Primitive.Array (Array, MutableArray, indexArray, mapArray', readArray, sizeofArray,

33 thawArray, unsafeFreezeArray, writeArray)

40 thawArray, unsafeFreezeArray, writeArray)

@@ -97,6 +104,31 @@ instance Monoid (TypeRepMap f) where

97 {-# INLINE mempty #-}

104 {-# INLINE mempty #-}

98 {-# INLINE mappend #-}

105 {-# INLINE mappend #-}

106

107+#if __GLASGOW_HASKELL__ >= 806

108+instance (forall a. Typeable a => Eq (f a)) => Eq (TypeRepMap f) where

109+ tm1 == tm2 = size tm1 == size tm2 && go 0

110+ where

111+ go :: Int -> Bool

112+ go i

113+ | i == size tm1 = True

114+ | otherwise = case testEquality tr1i tr2i of

115+ Nothing -> False

116+ Just Refl -> repEq tr1i (fromAny tv1i) (fromAny tv2i) && go (i + 1)

117+ where

118+ tr1i :: TypeRep x

119+ tr1i = anyToTypeRep $ indexArray (trKeys tm1) i

120+

121+ tr2i :: TypeRep y

122+ tr2i = anyToTypeRep $ indexArray (trKeys tm2) i

123+

124+ tv1i, tv2i :: Any

125+ tv1i = indexArray (trAnys tm1) i

126+ tv2i = indexArray (trAnys tm2) i

127+

128+ repEq :: TypeRep x -> f x -> f x -> Bool

129+ repEq tr = withTypeable tr (==)

130+#endif

131+

100-- | Returns the list of 'Fingerprint's from 'TypeRepMap'.

132-- | Returns the list of 'Fingerprint's from 'TypeRepMap'.

101toFingerprints :: TypeRepMap f -> [Fingerprint]

133toFingerprints :: TypeRepMap f -> [Fingerprint]

102toFingerprints TypeRepMap{..} =

134toFingerprints TypeRepMap{..} =

test/Test/TypeRep/MapProperty.hs+13

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE KindSignatures #-}

4{-# LANGUAGE KindSignatures #-}

@@ -65,6 +66,7 @@ test_DeleteMember = prop "member k . delete k == False" $ do

65-- Semigroup and Monoid laws

66-- Semigroup and Monoid laws

66----------------------------------------------------------------------------

67----------------------------------------------------------------------------

69+#if __GLASGOW_HASKELL__ < 806

68-- This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's. It's

70-- This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's. It's

69-- not a good idea to write such `Eq` instance for `TypeRepMap` itself because

71-- not a good idea to write such `Eq` instance for `TypeRepMap` itself because

70-- it doesn't compare values so it's not true equality. But this should be

72-- 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)

75instance Eq (FpMap f) where

77instance Eq (FpMap f) where

76 FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) =

78 FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) =

77 as1 == as2 && bs1 == bs2

79 as1 == as2 && bs1 == bs2

80+#endif

79test_SemigroupAssoc :: PropertyTest

82test_SemigroupAssoc :: PropertyTest

80test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do

83test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do

84+#if __GLASGOW_HASKELL__ >= 806

85+ x <- forAll genMap

86+ y <- forAll genMap

87+ z <- forAll genMap

88+#else

81 x <- FpMap <$> forAll genMap

89 x <- FpMap <$> forAll genMap

82 y <- FpMap <$> forAll genMap

90 y <- FpMap <$> forAll genMap

83 z <- FpMap <$> forAll genMap

91 z <- FpMap <$> forAll genMap

92+#endif

85 (x <> (y <> z)) === ((x <> y) <> z)

94 (x <> (y <> z)) === ((x <> y) <> z)

87test_MonoidIdentity :: PropertyTest

96test_MonoidIdentity :: PropertyTest

88test_MonoidIdentity = prop "x <> mempty == mempty <> x == x" $ do

97test_MonoidIdentity = prop "x <> mempty == mempty <> x == x" $ do

98+#if __GLASGOW_HASKELL__ >= 806

99+ x <- forAll genMap

100+#else

89 x <- FpMap <$> forAll genMap

101 x <- FpMap <$> forAll genMap

102+#endif

103

91 x <> mempty === x

104 x <> mempty === x

92 mempty <> x === x

105 mempty <> x === x

typerep-map.cabal+1−1

@@ -1,5 +1,5 @@

1name: typerep-map

2−version: 0.3.1

2+version: 0.3.2

3synopsis: Efficient implementation of a dependent map with types as keys

4description:

5 A dependent map from type representations to values of these types.