Add lifted instances for 3 and 4 tuples

2 files changed, 114 insertions, 1 deletions

diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs
index 80b662372c..26d34ff3ff 100644
--- a/libraries/base/Data/Functor/Classes.hs
+++ b/libraries/base/Data/Functor/Classes.hs
@@ -475,6 +475,7 @@ instance Show1 NonEmpty where
   liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $
     shwP 6 a . showString " :| " . shwL as
 
+
 -- | @since 4.9.0.0
 instance Eq2 (,) where
     liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2
@@ -519,6 +520,118 @@ instance (Read a) => Read1 ((,) a) where
 instance (Show a) => Show1 ((,) a) where
     liftShowsPrec = liftShowsPrec2 showsPrec showList
 
+
+-- | @since 4.16.0.0
+instance Eq a => Eq2 ((,,) a) where
+    liftEq2 e1 e2 (u1, x1, y1) (v1, x2, y2) =
+        u1 == v1 &&
+        e1 x1 x2 && e2 y1 y2
+
+-- | @since 4.16.0.0
+instance Ord a => Ord2 ((,,) a) where
+    liftCompare2 comp1 comp2 (u1, x1, y1) (v1, x2, y2) =
+        compare u1 v1 `mappend`
+        comp1 x1 x2 `mappend` comp2 y1 y2
+
+-- | @since 4.16.0.0
+instance Read a => Read2 ((,,) a) where
+    liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
+        x1 <- readPrec
+        expectP (Punc ",")
+        y1 <- rp1
+        expectP (Punc ",")
+        y2 <- rp2
+        return (x1,y1,y2)
+
+    liftReadListPrec2 = liftReadListPrec2Default
+    liftReadList2     = liftReadList2Default
+
+-- | @since 4.16.0.0
+instance Show a => Show2 ((,,) a) where
+    liftShowsPrec2 sp1 _ sp2 _ _ (x1,y1,y2)
+        = showChar '(' . showsPrec 0 x1
+        . showChar ',' . sp1 0 y1
+        . showChar ',' . sp2 0 y2
+        . showChar ')'
+
+-- | @since 4.16.0.0
+instance (Eq a, Eq b) => Eq1 ((,,) a b) where
+    liftEq = liftEq2 (==)
+
+-- | @since 4.16.0.0
+instance (Ord a, Ord b) => Ord1 ((,,) a b) where
+    liftCompare = liftCompare2 compare
+
+-- | @since 4.16.0.0
+instance (Read a, Read b) => Read1 ((,,) a b) where
+    liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+    liftReadListPrec = liftReadListPrecDefault
+    liftReadList     = liftReadListDefault
+
+-- | @since 4.16.0.0
+instance (Show a, Show b) => Show1 ((,,) a b) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+
+-- | @since 4.16.0.0
+instance (Eq a, Eq b) => Eq2 ((,,,) a b) where
+    liftEq2 e1 e2 (u1, u2, x1, y1) (v1, v2, x2, y2) =
+        u1 == v1 &&
+        u2 == v2 &&
+        e1 x1 x2 && e2 y1 y2
+
+-- | @since 4.16.0.0
+instance (Ord a, Ord b) => Ord2 ((,,,) a b) where
+    liftCompare2 comp1 comp2 (u1, u2, x1, y1) (v1, v2, x2, y2) =
+        compare u1 v1 `mappend`
+        compare u2 v2 `mappend`
+        comp1 x1 x2 `mappend` comp2 y1 y2
+
+-- | @since 4.16.0.0
+instance (Read a, Read b) => Read2 ((,,,) a b) where
+    liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
+        x1 <- readPrec
+        expectP (Punc ",")
+        x2 <- readPrec
+        expectP (Punc ",")
+        y1 <- rp1
+        expectP (Punc ",")
+        y2 <- rp2
+        return (x1,x2,y1,y2)
+
+    liftReadListPrec2 = liftReadListPrec2Default
+    liftReadList2     = liftReadList2Default
+
+-- | @since 4.16.0.0
+instance (Show a, Show b) => Show2 ((,,,) a b) where
+    liftShowsPrec2 sp1 _ sp2 _ _ (x1,x2,y1,y2)
+        = showChar '(' . showsPrec 0 x1
+        . showChar ',' . showsPrec 0 x2
+        . showChar ',' . sp1 0 y1
+        . showChar ',' . sp2 0 y2
+        . showChar ')'
+
+-- | @since 4.16.0.0
+instance (Eq a, Eq b, Eq c) => Eq1 ((,,,) a b c) where
+    liftEq = liftEq2 (==)
+
+-- | @since 4.16.0.0
+instance (Ord a, Ord b, Ord c) => Ord1 ((,,,) a b c) where
+    liftCompare = liftCompare2 compare
+
+-- | @since 4.16.0.0
+instance (Read a, Read b, Read c) => Read1 ((,,,) a b c) where
+    liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+    liftReadListPrec = liftReadListPrecDefault
+    liftReadList     = liftReadListDefault
+
+-- | @since 4.16.0.0
+instance (Show a, Show b, Show c) => Show1 ((,,,) a b c) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+
 -- | @since 4.9.0.0
 instance Eq2 Either where
     liftEq2 e1 _ (Left x) (Left y) = e1 x y
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 71649ad175..0525eefc2e 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -12,7 +12,7 @@
     `Data.Functor.Compose`.
 
   * Add `Eq1`, `Read1` and `Show1` instance for `Complex`;
-    add `Eq1`, `Ord1`, `Show1` and `Read1` instances for 3 and 4-tuples.
+    add `Eq1/2`, `Ord1/2`, `Show1/2` and `Read1/2` instances for 3 and 4-tuples.
 
 ## 4.15.0.0 *TBA*