[commit: ghc] wip/T15449, wip/T16188, wip/llvm-configure-opts: TestEquality instance for Compose (ee52298)

[git at git.haskell.org]

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

On branches: wip/T15449,wip/T16188,wip/llvm-configure-opts
Link       : http://ghc.haskell.org/trac/ghc/changeset/ee5229834dc5e15cd1eea8427b0e00c50d0fa08b/ghc

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

commit ee5229834dc5e15cd1eea8427b0e00c50d0fa08b
Author: Langston Barrett <langston.barrett at gmail.com>
Date:   Fri Feb 1 12:33:38 2019 -0800

    TestEquality instance for Compose


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

ee5229834dc5e15cd1eea8427b0e00c50d0fa08b
 libraries/base/Data/Functor/Compose.hs | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/libraries/base/Data/Functor/Compose.hs b/libraries/base/Data/Functor/Compose.hs
index 4ddd12c..97d4a35 100644
--- a/libraries/base/Data/Functor/Compose.hs
+++ b/libraries/base/Data/Functor/Compose.hs
@@ -1,8 +1,10 @@
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeOperators #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Functor.Compose
@@ -27,6 +29,7 @@ import Data.Functor.Classes
 import Control.Applicative
 import Data.Coerce (coerce)
 import Data.Data (Data)
+import Data.Type.Equality (TestEquality(..), (:~:)(..))
 import GHC.Generics (Generic, Generic1)
 import Text.Read (Read(..), readListDefault, readListPrecDefault)
 
@@ -118,3 +121,12 @@ instance (Alternative f, Applicative g) => Alternative (Compose f g) where
     empty = Compose empty
     (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a))
       :: forall a . Compose f g a -> Compose f g a -> Compose f g a
+
+-- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y at .
+--
+-- @since 4.13.0.0
+instance (TestEquality f) => TestEquality (Compose f g) where
+  testEquality (Compose x) (Compose y) =
+    case testEquality x y of -- :: Maybe (g x :~: g y)
+      Just Refl -> Just Refl -- :: Maybe (x :~: y)
+      Nothing   -> Nothing