Make Functor a quantified superclass of Bifunctor.

See https://github.com/haskell/core-libraries-committee/issues/91 for
discussion.

This change relates Bifunctor with Functor by requiring second = fmap.
Moreover this change is a step towards unblocking the major version bump
of bifunctors and profunctors to major version 6. This paves the way to
move the Profunctor class into base. For that Functor first similarly
becomes a superclass of Profunctor in the new major version 6.

8 files changed, 37 insertions, 7 deletions

diff --git a/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs b/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs
index 626a1dd76b..2a58138044 100644
--- a/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs
+++ b/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs
@@ -116,6 +116,9 @@ instance DynGraph Gr where
           in Gr g3
 
 
+instance Functor (Gr a) where
+  fmap = fastEMap
+
 instance Bifunctor Gr where
   bimap = fastNEMap
 
diff --git a/libraries/base/Data/Bifunctor.hs b/libraries/base/Data/Bifunctor.hs
index e8cfe05979..f014e5d3d4 100644
--- a/libraries/base/Data/Bifunctor.hs
+++ b/libraries/base/Data/Bifunctor.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE Safe #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE Safe #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -39,7 +40,11 @@ import GHC.Generics ( K1(..) )
 -- arguments are covariant.
 --
 -- You can define a 'Bifunctor' by either defining 'bimap' or by
--- defining both 'first' and 'second'.
+-- defining both 'first' and 'second'. A partially applied 'Bifunctor'
+-- must be a 'Functor' and the 'second' method must agree with 'fmap'.
+-- From this it follows that:
+--
+-- @'second' 'id' = 'id'@
 --
 -- If you supply 'bimap', you should ensure that:
 --
@@ -64,8 +69,10 @@ import GHC.Generics ( K1(..) )
 -- 'second' (f '.' g) ≡ 'second' f '.' 'second' g
 -- @
 --
+-- Since 4.18.0.0 'Functor' is a superclass of 'Bifunctor.
+--
 -- @since 4.8.0.0
-class Bifunctor p where
+class (forall a. Functor (p a)) => Bifunctor p where
     {-# MINIMAL bimap | first, second #-}
 
     -- | Map over both arguments at the same time.
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index ca815f246d..a078676d0f 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -559,6 +559,18 @@ instance (Monoid a, Monoid b, Monoid c) => Applicative ((,,,) a b c) where
 instance (Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) where
     (u, v, w, a) >>= k = case k a of (u', v', w', b) -> (u <> u', v <> v', w <> w', b)
 
+-- | @since 4.18.0.0
+instance Functor ((,,,,) a b c d) where
+    fmap f (a, b, c, d, e) = (a, b, c, d, f e)
+
+-- | @since 4.18.0.0
+instance Functor ((,,,,,) a b c d e) where
+    fmap fun (a, b, c, d, e, f) = (a, b, c, d, e, fun f)
+
+-- | @since 4.18.0.0
+instance Functor ((,,,,,,) a b c d e f) where
+    fmap fun (a, b, c, d, e, f, g) = (a, b, c, d, e, f, fun g)
+
 -- | @since 4.10.0.0
 instance Semigroup a => Semigroup (IO a) where
     (<>) = liftA2 (<>)
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index cc5f44ef96..9c259d8c3a 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -1,7 +1,9 @@
 # Changelog for [`base` package](http://hackage.haskell.org/package/base)
 
 ## 4.18.0.0 *TBA*
-
+  * Add `forall a. Functor (p a)` superclass for `Bifunctor p`.
+  * Add Functor instances for `(,,,,) a b c d`, `(,,,,,) a b c d e` and
+    `(,,,,,) a b c d e f`.
   * Exceptions thrown by weak pointer finalizers are now reported via a global
     exception handler.
   * Add `GHC.Weak.Finalize.{get,set}FinalizerExceptionHandler` which the user to
diff --git a/testsuite/tests/deriving/should_compile/T9968a.hs b/testsuite/tests/deriving/should_compile/T9968a.hs
index ca5b1b082e..7681581d33 100644
--- a/testsuite/tests/deriving/should_compile/T9968a.hs
+++ b/testsuite/tests/deriving/should_compile/T9968a.hs
@@ -5,4 +5,4 @@ module T9968 where
 import Data.Bifunctor
 
 data Blah a b = A a | B b
-  deriving (Bifunctor)
+  deriving (Functor, Bifunctor)
diff --git a/testsuite/tests/deriving/should_compile/T9968a.stderr b/testsuite/tests/deriving/should_compile/T9968a.stderr
index 6c77d65670..942879d1c0 100644
--- a/testsuite/tests/deriving/should_compile/T9968a.stderr
+++ b/testsuite/tests/deriving/should_compile/T9968a.stderr
@@ -1,5 +1,5 @@
 
-T9968a.hs:8:13: warning: [GHC-06201] [-Wmissing-methods (in -Wdefault)]
+T9968a.hs:8:22: warning: [GHC-06201] [-Wmissing-methods (in -Wdefault)]
     • No explicit implementation for
         either ‘bimap’ or (‘first’ and ‘second’)
     • In the instance declaration for ‘Bifunctor Blah’
diff --git a/testsuite/tests/deriving/should_compile/deriving-via-compile.hs b/testsuite/tests/deriving/should_compile/deriving-via-compile.hs
index 261110c255..7754b561d5 100644
--- a/testsuite/tests/deriving/should_compile/deriving-via-compile.hs
+++ b/testsuite/tests/deriving/should_compile/deriving-via-compile.hs
@@ -308,7 +308,7 @@ instance Biapplicative (,) where
     (f a b, f' a' b')
 
 newtype WrapBiapp p a b = WrapBiap (p a b)
-  deriving newtype (Bifunctor, Biapplicative, Eq)
+  deriving newtype (Functor, Bifunctor, Biapplicative, Eq)
 
 instance (Biapplicative p, Num a, Num b) => Num (WrapBiapp p a b) where
   (+) = biliftA2 (+) (+)
diff --git a/testsuite/tests/ghci/scripts/T12550.stdout b/testsuite/tests/ghci/scripts/T12550.stdout
index 0a30edf362..5c2dccb767 100644
--- a/testsuite/tests/ghci/scripts/T12550.stdout
+++ b/testsuite/tests/ghci/scripts/T12550.stdout
@@ -26,6 +26,12 @@ class Functor f where
 instance ∀ a. Functor ((,) a) -- Defined in ‘GHC.Base’
 instance ∀ a b. Functor ((,,) a b) -- Defined in ‘GHC.Base’
 instance ∀ a b c. Functor ((,,,) a b c) -- Defined in ‘GHC.Base’
+instance ∀ a b c d. Functor ((,,,,) a b c d)
+  -- Defined in ‘GHC.Base’
+instance ∀ a b c d e. Functor ((,,,,,) a b c d e)
+  -- Defined in ‘GHC.Base’
+instance ∀ a b c d e f. Functor ((,,,,,,) a b c d e f)
+  -- Defined in ‘GHC.Base’
 instance ∀ r. Functor ((->) r) -- Defined in ‘GHC.Base’
 instance Functor IO -- Defined in ‘GHC.Base’
 instance Functor [] -- Defined in ‘GHC.Base’