[commit: ghc] master: Add instances for (:~~:) mirroring those for (:~:) (c88b7c9)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c88b7c9a06e387c3b9bdb359b9e1e4f3a9fba696/ghc

>---------------------------------------------------------------

commit c88b7c9a06e387c3b9bdb359b9e1e4f3a9fba696
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Feb 23 18:09:58 2017 -0500

    Add instances for (:~~:) mirroring those for (:~:)
    
    `(:~~:)`, the hetergeneous version of `(:~:)`, should have class
    instances similar to those of `(:~:)`, especially since their
    implementations aren't particularly tricky or surprising. This adds
    them.
    
    Reviewers: bgamari, austin, hvr, goldfire
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D3181


>---------------------------------------------------------------

c88b7c9a06e387c3b9bdb359b9e1e4f3a9fba696
 libraries/base/Control/Category.hs                 |  5 +++++
 libraries/base/Data/Data.hs                        |  5 +++++
 libraries/base/Data/Type/Coercion.hs               |  4 ++++
 libraries/base/Data/Type/Equality.hs               | 25 ++++++++++++++++++++++
 .../tests/annotations/should_fail/annfail10.stderr |  2 +-
 .../tests/typecheck/should_fail/T12921.stderr      |  2 +-
 6 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs
index cc76480..ba92178 100644
--- a/libraries/base/Control/Category.hs
+++ b/libraries/base/Control/Category.hs
@@ -56,6 +56,11 @@ instance Category (:~:) where
   id          = Refl
   Refl . Refl = Refl
 
+-- | @since 4.10.0.0
+instance Category (:~~:) where
+  id            = HRefl
+  HRefl . HRefl = HRefl
+
 -- | @since 4.7.0.0
 instance Category Coercion where
   id = Coercion
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs
index 12f9378..8233f98 100644
--- a/libraries/base/Data/Data.hs
+++ b/libraries/base/Data/Data.hs
@@ -1210,6 +1210,11 @@ deriving instance (Data t) => Data (Proxy t)
 -- | @since 4.7.0.0
 deriving instance (a ~ b, Data a) => Data (a :~: b)
 
+-- | @since 4.10.0.0
+deriving instance (Typeable i, Typeable j, Typeable a, Typeable b,
+                    (a :: i) ~~ (b :: j))
+    => Data (a :~~: b)
+
 -- | @since 4.7.0.0
 deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b)
 
diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs
index 318d098..2358115 100644
--- a/libraries/base/Data/Type/Coercion.hs
+++ b/libraries/base/Data/Type/Coercion.hs
@@ -105,6 +105,10 @@ class TestCoercion f where
 instance TestCoercion ((Eq.:~:) a) where
   testCoercion Eq.Refl Eq.Refl = Just Coercion
 
+-- | @since 4.10.0.0
+instance TestCoercion ((Eq.:~~:) a) where
+  testCoercion Eq.HRefl Eq.HRefl = Just Coercion
+
 -- | @since 4.7.0.0
 instance TestCoercion (Coercion a) where
   testCoercion Coercion Coercion = Just Coercion
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
index 73f8407..69da70b 100644
--- a/libraries/base/Data/Type/Equality.hs
+++ b/libraries/base/Data/Type/Equality.hs
@@ -145,6 +145,27 @@ deriving instance a ~ b => Bounded (a :~: b)
 data (a :: k1) :~~: (b :: k2) where
    HRefl :: a :~~: a
 
+-- | @since 4.10.0.0
+deriving instance Eq   (a :~~: b)
+-- | @since 4.10.0.0
+deriving instance Show (a :~~: b)
+-- | @since 4.10.0.0
+deriving instance Ord  (a :~~: b)
+
+-- | @since 4.10.0.0
+instance a ~~ b => Read (a :~~: b) where
+  readsPrec d = readParen (d > 10) (\r -> [(HRefl, s) | ("HRefl",s) <- lex r ])
+
+-- | @since 4.10.0.0
+instance a ~~ b => Enum (a :~~: b) where
+  toEnum 0 = HRefl
+  toEnum _ = errorWithoutStackTrace "Data.Type.Equality.toEnum: bad argument"
+
+  fromEnum HRefl = 0
+
+-- | @since 4.10.0.0
+deriving instance a ~~ b => Bounded (a :~~: b)
+
 -- | This class contains types where you can learn the equality of two types
 -- from information contained in /terms/. Typically, only singleton types should
 -- inhabit this class.
@@ -156,6 +177,10 @@ class TestEquality f where
 instance TestEquality ((:~:) a) where
   testEquality Refl Refl = Just Refl
 
+-- | @since 4.10.0.0
+instance TestEquality ((:~~:) a) where
+  testEquality HRefl HRefl = Just Refl
+
 -- | A type family to compute Boolean equality. Instances are provided
 -- only for /open/ kinds, such as @*@ and function kinds. Instances are
 -- also provided for datatypes exported from base. A poly-kinded instance
diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr
index 0dea31a..6329c38 100644
--- a/testsuite/tests/annotations/should_fail/annfail10.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail10.stderr
@@ -10,7 +10,7 @@ annfail10.hs:9:1: error:
         instance Data.Data.Data Ordering -- Defined in ‘Data.Data’
         instance Data.Data.Data Integer -- Defined in ‘Data.Data’
         ...plus 15 others
-        ...plus 41 instances involving out-of-scope types
+        ...plus 42 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the annotation: {-# ANN f 1 #-}
 
diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr
index a3ac8a2..422ec7d 100644
--- a/testsuite/tests/typecheck/should_fail/T12921.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12921.stderr
@@ -10,7 +10,7 @@ T12921.hs:4:1: error:
         instance Data.Data.Data Ordering -- Defined in ‘Data.Data’
         instance Data.Data.Data Integer -- Defined in ‘Data.Data’
         ...plus 15 others
-        ...plus 41 instances involving out-of-scope types
+        ...plus 42 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the annotation:
         {-# ANN module "HLint: ignore Reduce duplication" #-}