[commit: ghc] master: Add Applicative, Semigroup, and Monoid instances in GHC.Generics (7782b47)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7782b47c4193975123edd3af630e6fe59ac7ef73/ghc

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

commit 7782b47c4193975123edd3af630e6fe59ac7ef73
Author: Lysxia <lysxia at gmail.com>
Date:   Fri Mar 2 16:14:36 2018 -0500

    Add Applicative, Semigroup, and Monoid instances in GHC.Generics
    
    Reviewers: hvr, bgamari, alpmestan, RyanGlScott
    
    Reviewed By: RyanGlScott
    
    Subscribers: RyanGlScott, rwbarton, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4447


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

7782b47c4193975123edd3af630e6fe59ac7ef73
 libraries/base/GHC/Generics.hs | 59 +++++++++++++++++++++++++++++++++++++++++-
 libraries/base/changelog.md    |  3 +++
 2 files changed, 61 insertions(+), 1 deletion(-)

diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index ff44cf8..9ac0528 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -740,7 +740,8 @@ import GHC.Types
 -- Needed for instances
 import GHC.Arr     ( Ix )
 import GHC.Base    ( Alternative(..), Applicative(..), Functor(..)
-                   , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce )
+                   , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce
+                   , Semigroup(..), Monoid(..) )
 import GHC.Classes ( Eq(..), Ord(..) )
 import GHC.Enum    ( Bounded, Enum )
 import GHC.Read    ( Read(..) )
@@ -765,6 +766,10 @@ data V1 (p :: k)
            , Generic1 -- ^ @since 4.9.0.0
            )
 
+-- | @since 4.12.0.0
+instance Semigroup (V1 p) where
+  v <> _ = v
+
 -- | Unit: used for constructors without arguments
 data U1 (p :: k) = U1
   deriving ( Generic  -- ^ @since 4.7.0.0
@@ -808,6 +813,14 @@ instance Monad U1 where
 -- | @since 4.9.0.0
 instance MonadPlus U1
 
+-- | @since 4.12.0.0
+instance Semigroup (U1 p) where
+  _ <> _ = U1
+
+-- | @since 4.12.0.0
+instance Monoid (U1 p) where
+  mempty = U1
+
 -- | Used for marking occurrences of the parameter
 newtype Par1 p = Par1 { unPar1 :: p }
   deriving ( Eq       -- ^ @since 4.7.0.0
@@ -829,6 +842,12 @@ instance Applicative Par1 where
 instance Monad Par1 where
   Par1 x >>= f = f x
 
+-- | @since 4.12.0.0
+deriving instance Semigroup p => Semigroup (Par1 p)
+
+-- | @since 4.12.0.0
+deriving instance Monoid p => Monoid (Par1 p)
+
 -- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
 -- is enabled)
 newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p }
@@ -854,6 +873,12 @@ instance Monad f => Monad (Rec1 f) where
 -- | @since 4.9.0.0
 deriving instance MonadPlus f => MonadPlus (Rec1 f)
 
+-- | @since 4.12.0.0
+deriving instance Semigroup (f p) => Semigroup (Rec1 f p)
+
+-- | @since 4.12.0.0
+deriving instance Monoid (f p) => Monoid (Rec1 f p)
+
 -- | Constants, additional parameters and recursion of kind @*@
 newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
   deriving ( Eq       -- ^ @since 4.7.0.0
@@ -865,6 +890,18 @@ newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
            , Generic1 -- ^ @since 4.9.0.0
            )
 
+-- | @since 4.12.0.0
+instance Monoid c => Applicative (K1 i c) where
+  pure _ = K1 mempty
+  liftA2 = \_ -> coerce (mappend :: c -> c -> c)
+  (<*>) = coerce (mappend :: c -> c -> c)
+
+-- | @since 4.12.0.0
+deriving instance Semigroup c => Semigroup (K1 i c p)
+
+-- | @since 4.12.0.0
+deriving instance Monoid c => Monoid (K1 i c p)
+
 -- | @since 4.9.0.0
 deriving instance Applicative f => Applicative (M1 i c f)
 
@@ -877,6 +914,12 @@ deriving instance Monad f => Monad (M1 i c f)
 -- | @since 4.9.0.0
 deriving instance MonadPlus f => MonadPlus (M1 i c f)
 
+-- | @since 4.12.0.0
+deriving instance Semigroup (f p) => Semigroup (M1 i c f p)
+
+-- | @since 4.12.0.0
+deriving instance Monoid (f p) => Monoid (M1 i c f p)
+
 -- | Meta-information (constructor names, etc.)
 newtype M1 (i :: *) (c :: Meta) (f :: k -> *) (p :: k) = M1 { unM1 :: f p }
   deriving ( Eq       -- ^ @since 4.7.0.0
@@ -933,6 +976,14 @@ instance (Monad f, Monad g) => Monad (f :*: g) where
 -- | @since 4.9.0.0
 instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g)
 
+-- | @since 4.12.0.0
+instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where
+  (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2)
+
+-- | @since 4.12.0.0
+instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where
+  mempty = mempty :*: mempty
+
 -- | Composition of functors
 infixr 7 :.:
 newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
@@ -958,6 +1009,12 @@ instance (Alternative f, Applicative g) => Alternative (f :.: g) where
   (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) ::
     forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a
 
+-- | @since 4.12.0.0
+deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p)
+
+-- | @since 4.12.0.0
+deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p)
+
 -- | Constants of unlifted kinds
 --
 -- @since 4.9.0.0
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index fdac6f2..47fe011 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -6,6 +6,9 @@
 
   * `($!)` is now representation-polymorphic like `($)`.
 
+  * Add `Applicative` (for `K1`), `Semigroup` and `Monoid` instances in
+    `GHC.Generics`. (#14849)
+
 ## 4.11.0.0 *TBA*
   * Bundled with GHC 8.4.1