Missing Proxy instances, make U1 instance more Proxy-like

This accomplishes three things:

* Adds missing `Alternative`, `MonadPlus`, and `MonadZip` instances for
  `Proxy`
* Adds a missing `MonadPlus` instance for `U1`
* Changes several existing `U1` instances to use lazy pattern-matching,
  exactly how `Proxy` does it (in case we ever replace `U1` with
  `Proxy`). This is technically a breaking change (albeit an extremely
  minor one).

Test Plan: ./validate

Reviewers: austin, ekmett, hvr, bgamari

Reviewed By: bgamari

Subscribers: thomie

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

GHC Trac Issues: #11650

6 files changed, 69 insertions, 12 deletions

diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs
index 771b8aa9c6..fa44438176 100644
--- a/libraries/base/Control/Monad/Zip.hs
+++ b/libraries/base/Control/Monad/Zip.hs
@@ -20,6 +20,7 @@ module Control.Monad.Zip where
 
 import Control.Monad (liftM, liftM2)
 import Data.Monoid
+import Data.Proxy
 import GHC.Generics
 
 -- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
@@ -78,7 +79,13 @@ instance MonadZip Last where
 instance MonadZip f => MonadZip (Alt f) where
     mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)
 
+instance MonadZip Proxy where
+    mzipWith _ _ _ = Proxy
+
 -- Instances for GHC.Generics
+instance MonadZip U1 where
+    mzipWith _ _ _ = U1
+
 instance MonadZip Par1 where
     mzipWith = liftM2
 
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
index 5d758ae691..0defe6c07c 100644
--- a/libraries/base/Data/Foldable.hs
+++ b/libraries/base/Data/Foldable.hs
@@ -425,8 +425,24 @@ instance Ord a => Monoid (Min a) where
     | otherwise = Min n
 
 -- Instances for GHC.Generics
+instance Foldable U1 where
+    foldMap _ _ = mempty
+    {-# INLINE foldMap #-}
+    fold _ = mempty
+    {-# INLINE fold #-}
+    foldr _ z _ = z
+    {-# INLINE foldr #-}
+    foldl _ z _ = z
+    {-# INLINE foldl #-}
+    foldl1 _ _ = errorWithoutStackTrace "foldl1: U1"
+    foldr1 _ _ = errorWithoutStackTrace "foldr1: U1"
+    length _   = 0
+    null _     = True
+    elem _ _   = False
+    sum _      = 0
+    product _  = 1
+
 deriving instance Foldable V1
-deriving instance Foldable U1
 deriving instance Foldable Par1
 deriving instance Foldable f => Foldable (Rec1 f)
 deriving instance Foldable (K1 i c)
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
index 9f602ea0c8..f0760e855d 100644
--- a/libraries/base/Data/Proxy.hs
+++ b/libraries/base/Data/Proxy.hs
@@ -89,10 +89,18 @@ instance Applicative Proxy where
     _ <*> _ = Proxy
     {-# INLINE (<*>) #-}
 
+instance Alternative Proxy where
+    empty = Proxy
+    {-# INLINE empty #-}
+    _ <|> _ = Proxy
+    {-# INLINE (<|>) #-}
+
 instance Monad Proxy where
     _ >>= _ = Proxy
     {-# INLINE (>>=) #-}
 
+instance MonadPlus Proxy
+
 -- | 'asProxyTypeOf' is a type-restricted version of 'const'.
 -- It is usually used as an infix operator, and its typing forces its first
 -- argument (which is usually overloaded) to have the same type as the tag
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
index c6a30d7213..b903b1d8bd 100644
--- a/libraries/base/Data/Traversable.hs
+++ b/libraries/base/Data/Traversable.hs
@@ -228,8 +228,17 @@ instance Traversable ZipList where
     traverse f (ZipList x) = ZipList <$> traverse f x
 
 -- Instances for GHC.Generics
+instance Traversable U1 where
+    traverse _ _ = pure U1
+    {-# INLINE traverse #-}
+    sequenceA _ = pure U1
+    {-# INLINE sequenceA #-}
+    mapM _ _ = pure U1
+    {-# INLINE mapM #-}
+    sequence _ = pure U1
+    {-# INLINE sequence #-}
+
 deriving instance Traversable V1
-deriving instance Traversable U1
 deriving instance Traversable Par1
 deriving instance Traversable f => Traversable (Rec1 f)
 deriving instance Traversable (K1 i c)
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index f723127bdc..62c35760de 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -712,10 +712,10 @@ import GHC.Types
 import GHC.Arr     ( Ix )
 import GHC.Base    ( Alternative(..), Applicative(..), Functor(..)
                    , Monad(..), MonadPlus(..), String )
-import GHC.Classes ( Eq, Ord )
+import GHC.Classes ( Eq(..), Ord(..) )
 import GHC.Enum    ( Bounded, Enum )
-import GHC.Read    ( Read )
-import GHC.Show    ( Show )
+import GHC.Read    ( Read(..), lex, readParen )
+import GHC.Show    ( Show(..), showString )
 
 -- Needed for metadata
 import Data.Proxy   ( Proxy(..), KProxy(..) )
@@ -736,21 +736,35 @@ deriving instance Show (V1 p)
 
 -- | Unit: used for constructors without arguments
 data U1 (p :: *) = U1
-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
+  deriving (Generic, Generic1)
+
+instance Eq (U1 p) where
+  _ == _ = True
+
+instance Ord (U1 p) where
+  compare _ _ = EQ
+
+instance Read (U1 p) where
+  readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ])
+
+instance Show (U1 p) where
+  showsPrec _ _ = showString "U1"
+
+instance Functor U1 where
+  fmap _ _ = U1
 
 instance Applicative U1 where
   pure _ = U1
-  U1 <*> U1 = U1
+  _ <*> _ = U1
 
 instance Alternative U1 where
   empty = U1
-  U1 <|> U1 = U1
-  -- The defaults will otherwise bottom; see #11650.
-  some U1 = U1
-  many U1 = U1
+  _ <|> _ = U1
 
 instance Monad U1 where
-  U1 >>= _ = U1
+  _ >>= _ = U1
+
+instance MonadPlus U1
 
 -- | Used for marking occurrences of the parameter
 newtype Par1 p = Par1 { unPar1 :: p }
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index b0ccda6e11..92451b9b42 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -49,6 +49,9 @@
     `GHC.Generics` as part of making GHC generics capable of handling
     unlifted types (#10868)
 
+  * The `Eq`, `Ord`, `Read`, and `Show` instances for `U1` now use lazier
+    pattern-matching
+
   * Keep `shift{L,R}` on `Integer` with negative shift-arguments from
     segfaulting (#10571)