diff options
-rw-r--r-- | compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs | 3 | ||||
-rw-r--r-- | libraries/base/Data/Bifunctor.hs | 13 | ||||
-rw-r--r-- | libraries/base/GHC/Base.hs | 12 | ||||
-rw-r--r-- | libraries/base/changelog.md | 4 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/T9968a.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/T9968a.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/deriving-via-compile.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T12550.stdout | 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’ |