Add liftA2 to Applicative class

* Make `liftA2` a method of `Applicative`.

* Add explicit `liftA2` definitions to instances in `base`.

* Add explicit invocations in `base`.

Reviewers: ekmett, bgamari, RyanGlScott, austin, hvr

Reviewed By: RyanGlScott

Subscribers: ekmett, RyanGlScott, rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3031

1 files changed, 18 insertions, 21 deletions

diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 8e128d444f..4282b7c83b 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP                    #-}
 {-# LANGUAGE DataKinds              #-}
 {-# LANGUAGE DeriveFunctor          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveGeneric          #-}
 {-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE FlexibleInstances      #-}
@@ -730,7 +731,7 @@ import GHC.Types
 -- Needed for instances
 import GHC.Arr     ( Ix )
 import GHC.Base    ( Alternative(..), Applicative(..), Functor(..)
-                   , Monad(..), MonadPlus(..), String )
+                   , Monad(..), MonadPlus(..), String, coerce )
 import GHC.Classes ( Eq(..), Ord(..) )
 import GHC.Enum    ( Bounded, Enum )
 import GHC.Read    ( Read(..), lex, readParen )
@@ -781,6 +782,7 @@ instance Functor U1 where
 instance Applicative U1 where
   pure _ = U1
   _ <*> _ = U1
+  liftA2 _ _ _ = U1
 
 -- | @since 4.9.0.0
 instance Alternative U1 where
@@ -800,8 +802,9 @@ newtype Par1 p = Par1 { unPar1 :: p }
 
 -- | @since 4.9.0.0
 instance Applicative Par1 where
-  pure a = Par1 a
-  Par1 f <*> Par1 x = Par1 (f x)
+  pure = Par1
+  (<*>) = coerce
+  liftA2 = coerce
 
 -- | @since 4.9.0.0
 instance Monad Par1 where
@@ -813,42 +816,33 @@ newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 -- | @since 4.9.0.0
-instance Applicative f => Applicative (Rec1 f) where
-  pure a = Rec1 (pure a)
-  Rec1 f <*> Rec1 x = Rec1 (f <*> x)
+deriving instance Applicative f => Applicative (Rec1 f)
 
 -- | @since 4.9.0.0
-instance Alternative f => Alternative (Rec1 f) where
-  empty = Rec1 empty
-  Rec1 l <|> Rec1 r = Rec1 (l <|> r)
+deriving instance Alternative f => Alternative (Rec1 f)
 
 -- | @since 4.9.0.0
 instance Monad f => Monad (Rec1 f) where
   Rec1 x >>= f = Rec1 (x >>= \a -> unRec1 (f a))
 
 -- | @since 4.9.0.0
-instance MonadPlus f => MonadPlus (Rec1 f)
+deriving instance MonadPlus f => MonadPlus (Rec1 f)
 
 -- | Constants, additional parameters and recursion of kind @*@
 newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 -- | @since 4.9.0.0
-instance Applicative f => Applicative (M1 i c f) where
-  pure a = M1 (pure a)
-  M1 f <*> M1 x = M1 (f <*> x)
+deriving instance Applicative f => Applicative (M1 i c f)
 
 -- | @since 4.9.0.0
-instance Alternative f => Alternative (M1 i c f) where
-  empty = M1 empty
-  M1 l <|> M1 r = M1 (l <|> r)
+deriving instance Alternative f => Alternative (M1 i c f)
 
 -- | @since 4.9.0.0
-instance Monad f => Monad (M1 i c f) where
-  M1 x >>= f = M1 (x >>= \a -> unM1 (f a))
+deriving instance Monad f => Monad (M1 i c f)
 
 -- | @since 4.9.0.0
-instance MonadPlus f => MonadPlus (M1 i c f)
+deriving instance MonadPlus f => MonadPlus (M1 i c f)
 
 -- | Meta-information (constructor names, etc.)
 newtype M1 (i :: *) (c :: Meta) (f :: k -> *) (p :: k) = M1 { unM1 :: f p }
@@ -868,6 +862,7 @@ data (:*:) (f :: k -> *) (g :: k -> *) (p :: k) = f p :*: g p
 instance (Applicative f, Applicative g) => Applicative (f :*: g) where
   pure a = pure a :*: pure a
   (f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y)
+  liftA2 f (a :*: b) (x :*: y) = liftA2 f a x :*: liftA2 f b y
 
 -- | @since 4.9.0.0
 instance (Alternative f, Alternative g) => Alternative (f :*: g) where
@@ -893,12 +888,14 @@ newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
 -- | @since 4.9.0.0
 instance (Applicative f, Applicative g) => Applicative (f :.: g) where
   pure x = Comp1 (pure (pure x))
-  Comp1 f <*> Comp1 x = Comp1 (fmap (<*>) f <*> x)
+  Comp1 f <*> Comp1 x = Comp1 (liftA2 (<*>) f x)
+  liftA2 f (Comp1 x) (Comp1 y) = Comp1 (liftA2 (liftA2 f) x y)
 
 -- | @since 4.9.0.0
 instance (Alternative f, Applicative g) => Alternative (f :.: g) where
   empty = Comp1 empty
-  Comp1 x <|> Comp1 y = Comp1 (x <|> y)
+  (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) ::
+    forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a
 
 -- | Constants of unlifted kinds
 --