Add GEq and GCompare instances for :+: and :*:

Author: Jimmy Hartzell

src/Data/GADT/Internal.hs

@@ -27,6 +27,8 @@ import Data.Maybe           (isJust, isNothing)
 import Data.Monoid          (Monoid (..))
 import Data.Semigroup       (Semigroup (..))
 import Data.Type.Equality   ((:~:) (..))
+import GHC.Generics         ((:+:) (..))
+import GHC.Generics         ((:*:) (..))
 
 #if __GLASGOW_HASKELL__ >=708
 import Data.Typeable (Typeable)
@@ -199,6 +201,17 @@ instance (GEq a, GEq b) => GEq (Product a b) where
         Refl <- geq y y'
         return Refl
 
+instance (GEq f, GEq g) => GEq (f :+: g) where
+  geq (L1 x) (L1 y) = geq x y
+  geq (R1 x) (R1 y) = geq x y
+  geq _ _ = Nothing
+
+instance (GEq a, GEq b) => GEq (a :*: b) where
+    geq (x :*: y) (x' :*: y') = do
+        Refl <- geq x x'
+        Refl <- geq y y'
+        return Refl
+
 #if MIN_VERSION_base(4,10,0)
 instance GEq TR.TypeRep where
     geq = testEquality
@@ -321,6 +334,21 @@ instance (GCompare a, GCompare b) => GCompare (Product a b) where
             GEQ -> GEQ
             GGT -> GGT
 
+instance (GCompare f, GCompare g) => GCompare (f :+: g) where
+    gcompare (L1 x) (L1 y) = gcompare x y
+    gcompare (L1 _) (R1 _) = GLT
+    gcompare (R1 _) (L1 _) = GGT
+    gcompare (R1 x) (R1 y) = gcompare x y
+
+instance (GCompare a, GCompare b) => GCompare (a :*: b) where
+    gcompare (x :*: y) (x' :*: y') = case gcompare x x' of
+        GLT -> GLT
+        GGT -> GGT
+        GEQ -> case gcompare y y' of
+            GLT -> GLT
+            GEQ -> GEQ
+            GGT -> GGT
+
 -------------------------------------------------------------------------------
 -- Some
 -------------------------------------------------------------------------------