From 59dfb00584e6d24d82d3f5338c6299bae48e0468 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Wed, 27 Oct 2021 14:19:59 +0100
Subject: Remove record field from Solo

Ticket #20562 revealed that Solo, which is a wired-in TyCon, had
a record field that wasn't being added to the type env. Why not?
Because wired-in TyCons don't have record fields.

It's not hard to change that, but it's tiresome for this one use-case,
and it seems easier simply to make `getSolo` into a standalone
function.

On the way I refactored the handling of Solo slightly, to put it
into wiredInTyCons (where it belongs) rather than only in
knownKeyNames
---
 libraries/base/GHC/Read.hs             | 20 +-------------------
 libraries/base/GHC/Show.hs             |  4 +---
 libraries/base/tests/all.T             |  1 -
 libraries/base/tests/read-show-solo.hs |  9 ---------
 libraries/ghc-prim/GHC/Tuple.hs        | 10 +++++++++-
 5 files changed, 11 insertions(+), 33 deletions(-)
 delete mode 100644 libraries/base/tests/read-show-solo.hs

(limited to 'libraries')

diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs
index 43e5ee5b32..7f698ec498 100644
--- a/libraries/base/GHC/Read.hs
+++ b/libraries/base/GHC/Read.hs
@@ -669,25 +669,7 @@ instance Read () where
   readList     = readListDefault
 
 -- | @since 4.15
-instance Read a => Read (Solo a) where
-  -- Since our `show` doesn't show record syntax, we want to accept non-record
-  -- syntax. Since Solo is actually a record, it only seems fair to accept
-  -- record syntax as well.
-  readPrec = parens $
-     (prec appPrec $
-        do expectP (L.Ident "Solo")
-           x <- step readPrec
-           return (Solo x))
-     +++
-      (prec appPrec1
-             (do expectP (L.Ident "Solo")
-                 expectP (L.Punc "{")
-                 x <- readField
-                              "getSolo" (reset readPrec)
-                 expectP (L.Punc "}")
-                 return (Solo x)))
-
-  readListPrec = readListPrecDefault
+deriving instance Read a => Read (Solo a)
 
 -- | @since 2.01
 instance (Read a, Read b) => Read (a,b) where
diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs
index ecfb7dbe0f..04fbcb6112 100644
--- a/libraries/base/GHC/Show.hs
+++ b/libraries/base/GHC/Show.hs
@@ -169,9 +169,7 @@ appPrec1 = I# 11#       -- appPrec + 1
 deriving instance Show ()
 
 -- | @since 4.15
-instance Show a => Show (Solo a) where
-  showsPrec d (Solo x) = showParen (d > 10) $
-      showString "Solo " . showsPrec 11 x
+deriving instance Show a => Show (Solo a)
 
 -- | @since 2.01
 instance Show a => Show [a]  where
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 371ed56327..ebbf81ec52 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -45,7 +45,6 @@ test('inits', normal, compile_and_run, [''])
 test('genericNegative001', extra_run_opts('-1'), compile_and_run, [''])
 test('ix001', normal, compile_and_run, [''])
 test('isValidNatural', normal, compile_and_run, [''])
-test('read-show-solo', normal, compile_and_run, [''])
 
 # need to add -K64m to the compiler opts, so that GHCi gets it too
 test('ioref001',
diff --git a/libraries/base/tests/read-show-solo.hs b/libraries/base/tests/read-show-solo.hs
deleted file mode 100644
index 553e837836..0000000000
--- a/libraries/base/tests/read-show-solo.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Main (main) where
-import Data.Tuple (Solo (..))
-
-main = do
-  print $ Solo (3 :: Int)
-  print $ Solo (Just "")
-  print $ Just (Solo "")
-  print (read (show (Solo (3 :: Int))) :: Solo Int)
-  print (read "Just Solo { getSolo = 5 }" :: Maybe (Solo Int))
diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs
index 9254ab72ae..9f4b70e6c1 100644
--- a/libraries/ghc-prim/GHC/Tuple.hs
+++ b/libraries/ghc-prim/GHC/Tuple.hs
@@ -77,7 +77,15 @@ data () = ()
 -- unary tuples, they can also be useful for fine-grained control of
 -- strict-spined data structure traversals, and for unifying the
 -- implementations of lazy and strict mapping functions.
-data Solo a = Solo { getSolo :: a }
+data Solo a = Solo a
+
+getSolo :: Solo a -> a
+-- getSolo is a standalone function, rather than a record field of Solo,
+-- because Solo is a wired-in TyCon, and a wired-in TyCon that  has
+-- record fields is a bit more inconvenient than if it doesn't.
+-- (No other wired-in TyCon has record fields.)  So it seems easier
+-- to have getSolo as its own separate function (#20562)
+getSolo (Solo a) = a
 
 data (a,b) = (a,b)
 data (a,b,c) = (a,b,c)
-- 
cgit v1.2.1