[commit: ghc] master: Make the Read instance for Proxy (and friends) ignore precedence (8fd9599)
git at git.haskell.org
git at git.haskell.org
Tue Aug 22 14:56:38 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8fd959998e900dffdb7f752fcd42df7aaedeae6e/ghc
>---------------------------------------------------------------
commit 8fd959998e900dffdb7f752fcd42df7aaedeae6e
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date: Tue Aug 22 09:29:07 2017 -0400
Make the Read instance for Proxy (and friends) ignore precedence
Summary:
The `Read` instance for `Proxy`, as well as a handful of other data
types in `base` which only have a single constructor, are doing something
skeevy: they're requiring that they be surrounded by parentheses if the parsing
precedence is sufficiently high. This means that `"Thing (Proxy)"` would parse,
but not `"Thing Proxy"`. But the latter really ought to parse, since there's no
need to surround a single constructor with parentheses. Indeed, that's the
output of `show (Thing Proxy)`, so the current `Read` instance for `Proxy`
violates `read . show = id`.
The simple solution is to change `readParen (d > 10)` to `readParen False` in
the `Read` instance for `Proxy`. But given that a derived `Read` instance would
essentially accomplish the same thing, but with even fewer characters, I've
opted to just replace the hand-rolled `Read` instance with a derived one.
Test Plan: make test TEST=T12874
Reviewers: ekmett, austin, hvr, goldfire, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie
GHC Trac Issues: #12874
Differential Revision: https://phabricator.haskell.org/D3871
>---------------------------------------------------------------
8fd959998e900dffdb7f752fcd42df7aaedeae6e
libraries/base/Data/Proxy.hs | 8 +++-----
libraries/base/Data/Type/Coercion.hs | 3 +--
libraries/base/Data/Type/Equality.hs | 6 ++----
libraries/base/GHC/Generics.hs | 5 ++---
libraries/base/changelog.md | 5 +++++
libraries/base/tests/T12874.hs | 9 +++++++++
libraries/base/tests/T12874.stdout | 1 +
libraries/base/tests/all.T | 1 +
8 files changed, 24 insertions(+), 14 deletions(-)
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
index 1ebf56c..2ebb4ab 100644
--- a/libraries/base/Data/Proxy.hs
+++ b/libraries/base/Data/Proxy.hs
@@ -53,7 +53,9 @@ import GHC.Arr
--
-- >>> Proxy :: Proxy complicatedStructure
-- Proxy
-data Proxy t = Proxy deriving Bounded
+data Proxy t = Proxy deriving ( Bounded
+ , Read -- ^ @since 4.7.0.0
+ )
-- | A concrete, promotable proxy type, for use at the kind level
-- There are no instances for this because it is intended at the kind level only
@@ -76,10 +78,6 @@ instance Show (Proxy s) where
showsPrec _ _ = showString "Proxy"
-- | @since 4.7.0.0
-instance Read (Proxy s) where
- readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])
-
--- | @since 4.7.0.0
instance Enum (Proxy s) where
succ _ = errorWithoutStackTrace "Proxy.succ"
pred _ = errorWithoutStackTrace "Proxy.pred"
diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs
index 2358115..2bfd9ae 100644
--- a/libraries/base/Data/Type/Coercion.hs
+++ b/libraries/base/Data/Type/Coercion.hs
@@ -81,8 +81,7 @@ deriving instance Show (Coercion a b)
deriving instance Ord (Coercion a b)
-- | @since 4.7.0.0
-instance Coercible a b => Read (Coercion a b) where
- readsPrec d = readParen (d > 10) (\r -> [(Coercion, s) | ("Coercion",s) <- lex r ])
+deriving instance Coercible a b => Read (Coercion a b)
-- | @since 4.7.0.0
instance Coercible a b => Enum (Coercion a b) where
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
index 8cc34f6..09999b0 100644
--- a/libraries/base/Data/Type/Equality.hs
+++ b/libraries/base/Data/Type/Equality.hs
@@ -125,8 +125,7 @@ deriving instance Show (a :~: b)
deriving instance Ord (a :~: b)
-- | @since 4.7.0.0
-instance a ~ b => Read (a :~: b) where
- readsPrec d = readParen (d > 10) (\r -> [(Refl, s) | ("Refl",s) <- lex r ])
+deriving instance a ~ b => Read (a :~: b)
-- | @since 4.7.0.0
instance a ~ b => Enum (a :~: b) where
@@ -153,8 +152,7 @@ deriving instance Show (a :~~: b)
deriving instance Ord (a :~~: b)
-- | @since 4.10.0.0
-instance a ~~ b => Read (a :~~: b) where
- readsPrec d = readParen (d > 10) (\r -> [(HRefl, s) | ("HRefl",s) <- lex r ])
+deriving instance a ~~ b => Read (a :~~: b)
-- | @since 4.10.0.0
instance a ~~ b => Enum (a :~~: b) where
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 14184c2..d4e9583 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -742,7 +742,7 @@ import GHC.Base ( Alternative(..), Applicative(..), Functor(..)
, Monad(..), MonadPlus(..), String, coerce )
import GHC.Classes ( Eq(..), Ord(..) )
import GHC.Enum ( Bounded, Enum )
-import GHC.Read ( Read(..), lex, readParen )
+import GHC.Read ( Read(..) )
import GHC.Show ( Show(..), showString )
-- Needed for metadata
@@ -775,8 +775,7 @@ instance Ord (U1 p) where
compare _ _ = EQ
-- | @since 4.9.0.0
-instance Read (U1 p) where
- readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ])
+deriving instance Read (U1 p)
-- | @since 4.9.0.0
instance Show (U1 p) where
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index ab304a3..cce9fba 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -16,6 +16,11 @@
* Add instances `Semigroup` and `Monoid` for `Control.Monad.ST` (#14107).
+ * The `Read` instances for `Proxy`, `Coercion`, `(:~:)`, `(:~~:)`, and `U1`
+ now ignore the parsing precedence. The effect of this is that `read` will
+ be able to successfully parse more strings containing `"Proxy"` _et al._
+ without surrounding parentheses (e.g., `"Thing Proxy"`) (#12874).
+
## 4.10.0.0 *April 2017*
* Bundled with GHC *TBA*
diff --git a/libraries/base/tests/T12874.hs b/libraries/base/tests/T12874.hs
new file mode 100644
index 0000000..cba7173
--- /dev/null
+++ b/libraries/base/tests/T12874.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import Data.Proxy
+
+main :: IO ()
+main = print (read "Thing Proxy" :: Thing (Proxy Int))
+
+data Thing a = Thing a
+ deriving (Read,Show)
diff --git a/libraries/base/tests/T12874.stdout b/libraries/base/tests/T12874.stdout
new file mode 100644
index 0000000..8a89660
--- /dev/null
+++ b/libraries/base/tests/T12874.stdout
@@ -0,0 +1 @@
+Thing Proxy
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index d97d79a..970fb7e 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -205,6 +205,7 @@ test('T12494', normal, compile_and_run, [''])
test('T12852', when(opsys('mingw32'), skip), compile_and_run, [''])
test('lazySTexamples', normal, compile_and_run, [''])
test('T11760', normal, compile_and_run, ['-threaded -with-rtsopts=-N2'])
+test('T12874', normal, compile_and_run, [''])
test('T13191',
[ stats_num_field('bytes allocated',
[ (wordsize(64), 185943272, 5) ])
More information about the ghc-commits
mailing list