summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2016-08-31 14:30:57 -0400
committerBen Gamari <ben@smart-cactus.org>2016-08-31 14:31:15 -0400
commit9cfef167dc0b2bfa881c5d9eca38227fbdfd507c (patch)
treef1987b7d88b22c991bb86599c3da20c0581cee4c
parent9306db051ff5835b453d55f32783d081ac79ec28 (diff)
downloadhaskell-9cfef167dc0b2bfa881c5d9eca38227fbdfd507c.tar.gz
Add Read1/Read2 methods defined in terms of ReadPrec
This adds new methods `liftReadList(2)` and `liftReadListPrec(2)` to the `Read1`/`Read2` classes which are defined in terms of `ReadPrec` instead of `ReadS`. This also adds related combinators and changes existing `Read1` and `Read2` instances to be defined in terms of the new methods. Reviewers: hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2379 GHC Trac Issues: #12358
-rw-r--r--docs/users_guide/8.2.1-notes.rst6
-rw-r--r--docs/users_guide/bugs.rst12
-rw-r--r--libraries/base/Data/Functor/Classes.hs364
-rw-r--r--libraries/base/Data/Functor/Compose.hs17
-rw-r--r--libraries/base/Data/Functor/Product.hs13
-rw-r--r--libraries/base/Data/Functor/Sum.hs17
-rw-r--r--libraries/base/GHC/Read.hs25
-rw-r--r--libraries/base/changelog.md5
8 files changed, 397 insertions, 62 deletions
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index bb31d95cbf..fdd8f5c35a 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -111,6 +111,12 @@ See ``changelog.md`` in the ``base`` package for full release notes.
- ``Data.Type.Coercion`` now provides ``gcoerceWith``, which is analogous to
``gcastWith`` from ``Data.Type.Equality``.
+- The ``Read1`` and ``Read2`` classes in ``Data.Functor.Classes`` have new
+ methods, ``liftReadList(2)`` and ``liftReadListPrec(2)``, that are defined in
+ terms of ``ReadPrec`` instead of ``ReadS``. This matches the interface
+ provided in GHC's version of the ``Read`` class, and allows users to write
+ more efficient ``Read1`` and ``Read2`` instances.
+
binary
~~~~~~
diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst
index 5b710aa35d..5d303636f4 100644
--- a/docs/users_guide/bugs.rst
+++ b/docs/users_guide/bugs.rst
@@ -152,7 +152,7 @@ Numbers, basic types, and built-in classes
``Num`` superclasses
The ``Num`` class does not have ``Show`` or ``Eq`` superclasses.
-
+
You can make code that works with both Haskell98/Haskell2010 and GHC
by:
@@ -178,6 +178,16 @@ Numbers, basic types, and built-in classes
- Always define the ``bit``, ``testBit`` and ``popCount`` methods
in ``Bits`` instances.
+``Read`` class methods
+ The ``Read`` class has two extra methods, ``readPrec`` and
+ ``readListPrec``, that are not found in the Haskell 2010 since they rely
+ on the ``ReadPrec`` data type, which requires the :ghc-flag:`-XRankNTypes`
+ extension. GHC also derives ``Read`` instances by implementing ``readPrec``
+ instead of ``readsPrec``, and relies on a default implementation of
+ ``readsPrec`` that is defined in terms of ``readPrec``. GHC adds these two
+ extra methods simply because ``ReadPrec`` is more efficient than ``ReadS``
+ (the type on which ``readsPrec`` is based).
+
Extra instances
The following extra instances are defined: ::
diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs
index 460ecc128a..2510da911f 100644
--- a/libraries/base/Data/Functor/Classes.hs
+++ b/libraries/base/Data/Functor/Classes.hs
@@ -26,7 +26,9 @@
--
-- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1
-- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1
--- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1
+-- > instance (Read1 f, Read a) => Read (T f a) where
+-- > readPrec = readPrec1
+-- > readListPrec = readListPrecDefault
-- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1
--
-- @since 4.9.0.0
@@ -37,18 +39,20 @@ module Data.Functor.Classes (
-- ** For unary constructors
Eq1(..), eq1,
Ord1(..), compare1,
- Read1(..), readsPrec1,
+ Read1(..), readsPrec1, readPrec1,
+ liftReadListDefault, liftReadListPrecDefault,
Show1(..), showsPrec1,
-- ** For binary constructors
Eq2(..), eq2,
Ord2(..), compare2,
- Read2(..), readsPrec2,
+ Read2(..), readsPrec2, readPrec2,
+ liftReadList2Default, liftReadListPrec2Default,
Show2(..), showsPrec2,
-- * Helper functions
-- $example
- readsData,
- readsUnaryWith,
- readsBinaryWith,
+ readsData, readData,
+ readsUnaryWith, readUnaryWith,
+ readsBinaryWith, readBinaryWith,
showsUnaryWith,
showsBinaryWith,
-- ** Obsolete helpers
@@ -60,13 +64,22 @@ module Data.Functor.Classes (
showsBinary1,
) where
-import Control.Applicative (Const(Const))
+import Control.Applicative (Alternative((<|>)), Const(Const))
+
import Data.Functor.Identity (Identity(Identity))
import Data.Proxy (Proxy(Proxy))
import Data.Monoid (mappend)
+
+import GHC.Read (expectP, list, paren)
+
+import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)
+import Text.Read (Read(..), parens, prec, step)
+import Text.Read.Lex (Lexeme(..))
import Text.Show (showListWith)
-- | Lifting of the 'Eq' class to unary type constructors.
+--
+-- @since 4.9.0.0
class Eq1 f where
-- | Lift an equality test through the type constructor.
--
@@ -74,13 +87,19 @@ class Eq1 f where
-- but the more general type ensures that the implementation uses
-- it to compare elements of the first container with elements of
-- the second.
+ --
+ -- @since 4.9.0.0
liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
-- | Lift the standard @('==')@ function through the type constructor.
+--
+-- @since 4.9.0.0
eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 = liftEq (==)
-- | Lifting of the 'Ord' class to unary type constructors.
+--
+-- @since 4.9.0.0
class (Eq1 f) => Ord1 f where
-- | Lift a 'compare' function through the type constructor.
--
@@ -88,45 +107,112 @@ class (Eq1 f) => Ord1 f where
-- but the more general type ensures that the implementation uses
-- it to compare elements of the first container with elements of
-- the second.
+ --
+ -- @since 4.9.0.0
liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
-- | Lift the standard 'compare' function through the type constructor.
+--
+-- @since 4.9.0.0
compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 = liftCompare compare
-- | Lifting of the 'Read' class to unary type constructors.
+--
+-- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface
+-- provided in the 'Read' type class, but it is recommended to implement
+-- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since
+-- the former is more efficient than the latter. For example:
+--
+-- @
+-- instance 'Read1' T where
+-- 'liftReadPrec' = ...
+-- 'liftReadListPrec' = 'liftReadListPrecDefault'
+-- @
+--
+-- For more information, refer to the documentation for the 'Read' class.
+--
+-- @since 4.9.0.0
class Read1 f where
+ {-# MINIMAL liftReadsPrec | liftReadPrec #-}
+
-- | 'readsPrec' function for an application of the type constructor
-- based on 'readsPrec' and 'readList' functions for the argument type.
+ --
+ -- @since 4.9.0.0
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
+ liftReadsPrec rp rl = readPrec_to_S $
+ liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))
-- | 'readList' function for an application of the type constructor
-- based on 'readsPrec' and 'readList' functions for the argument type.
-- The default implementation using standard list syntax is correct
-- for most types.
+ --
+ -- @since 4.9.0.0
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
- liftReadList rp rl = readListWith (liftReadsPrec rp rl 0)
-
--- | Read a list (using square brackets and commas), given a function
--- for reading elements.
-readListWith :: ReadS a -> ReadS [a]
-readListWith rp =
- readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s])
- where
- readl s = [([],t) | ("]",t) <- lex s] ++
- [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t]
- readl' s = [([],t) | ("]",t) <- lex s] ++
- [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u]
+ liftReadList rp rl = readPrec_to_S
+ (list $ liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0
+
+ -- | 'readPrec' function for an application of the type constructor
+ -- based on 'readPrec' and 'readListPrec' functions for the argument type.
+ --
+ -- @since 4.10.0.0
+ liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
+ liftReadPrec rp rl = readS_to_Prec $
+ liftReadsPrec (readPrec_to_S rp) (readPrec_to_S rl 0)
+
+ -- | 'readListPrec' function for an application of the type constructor
+ -- based on 'readPrec' and 'readListPrec' functions for the argument type.
+ --
+ -- The default definition uses 'liftReadList'. Instances that define
+ -- 'liftReadPrec' should also define 'liftReadListPrec' as
+ -- 'liftReadListPrecDefault'.
+ --
+ -- @since 4.10.0.0
+ liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
+ liftReadListPrec rp rl = readS_to_Prec $ \_ ->
+ liftReadList (readPrec_to_S rp) (readPrec_to_S rl 0)
-- | Lift the standard 'readsPrec' and 'readList' functions through the
-- type constructor.
+--
+-- @since 4.9.0.0
readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 = liftReadsPrec readsPrec readList
+-- | Lift the standard 'readPrec' and 'readListPrec' functions through the
+-- type constructor.
+--
+-- @since 4.10.0.0
+readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)
+readPrec1 = liftReadPrec readPrec readListPrec
+
+-- | A possible replacement definition for the 'liftReadList' method.
+-- This is only needed for 'Read1' instances where 'liftReadListPrec' isn't
+-- defined as 'liftReadListPrecDefault'.
+--
+-- @since 4.10.0.0
+liftReadListDefault :: Read1 f => (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
+liftReadListDefault rp rl = readPrec_to_S
+ (liftReadListPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0
+
+-- | A possible replacement definition for the 'liftReadListPrec' method,
+-- defined using 'liftReadPrec'.
+--
+-- @since 4.10.0.0
+liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]
+ -> ReadPrec [f a]
+liftReadListPrecDefault rp rl = list (liftReadPrec rp rl)
+
-- | Lifting of the 'Show' class to unary type constructors.
+--
+-- @since 4.9.0.0
class Show1 f where
-- | 'showsPrec' function for an application of the type constructor
-- based on 'showsPrec' and 'showList' functions for the argument type.
+ --
+ -- @since 4.9.0.0
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
Int -> f a -> ShowS
@@ -134,16 +220,22 @@ class Show1 f where
-- based on 'showsPrec' and 'showList' functions for the argument type.
-- The default implementation using standard list syntax is correct
-- for most types.
+ --
+ -- @since 4.9.0.0
liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
[f a] -> ShowS
liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)
-- | Lift the standard 'showsPrec' and 'showList' functions through the
-- type constructor.
+--
+-- @since 4.9.0.0
showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 = liftShowsPrec showsPrec showList
-- | Lifting of the 'Eq' class to binary type constructors.
+--
+-- @since 4.9.0.0
class Eq2 f where
-- | Lift equality tests through the type constructor.
--
@@ -151,13 +243,19 @@ class Eq2 f where
-- but the more general type ensures that the implementation uses
-- them to compare elements of the first container with elements of
-- the second.
+ --
+ -- @since 4.9.0.0
liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
-- | Lift the standard @('==')@ function through the type constructor.
+--
+-- @since 4.9.0.0
eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
eq2 = liftEq2 (==) (==)
-- | Lifting of the 'Ord' class to binary type constructors.
+--
+-- @since 4.9.0.0
class (Eq2 f) => Ord2 f where
-- | Lift 'compare' functions through the type constructor.
--
@@ -165,37 +263,120 @@ class (Eq2 f) => Ord2 f where
-- but the more general type ensures that the implementation uses
-- them to compare elements of the first container with elements of
-- the second.
+ --
+ -- @since 4.9.0.0
liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
f a c -> f b d -> Ordering
-- | Lift the standard 'compare' function through the type constructor.
+--
+-- @since 4.9.0.0
compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
compare2 = liftCompare2 compare compare
-- | Lifting of the 'Read' class to binary type constructors.
+--
+-- Both 'liftReadsPrec2' and 'liftReadPrec2' exist to match the interface
+-- provided in the 'Read' type class, but it is recommended to implement
+-- 'Read2' instances using 'liftReadPrec2' as opposed to 'liftReadsPrec2',
+-- since the former is more efficient than the latter. For example:
+--
+-- @
+-- instance 'Read2' T where
+-- 'liftReadPrec2' = ...
+-- 'liftReadListPrec2' = 'liftReadListPrec2Default'
+-- @
+--
+-- For more information, refer to the documentation for the 'Read' class.
+-- @since 4.9.0.0
class Read2 f where
+ {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-}
+
-- | 'readsPrec' function for an application of the type constructor
-- based on 'readsPrec' and 'readList' functions for the argument types.
+ --
+ -- @since 4.9.0.0
liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
(Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
+ liftReadsPrec2 rp1 rl1 rp2 rl2 = readPrec_to_S $
+ liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
+ (readS_to_Prec rp2) (readS_to_Prec (const rl2))
-- | 'readList' function for an application of the type constructor
-- based on 'readsPrec' and 'readList' functions for the argument types.
-- The default implementation using standard list syntax is correct
-- for most types.
+ --
+ -- @since 4.9.0.0
liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->
(Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
- liftReadList2 rp1 rl1 rp2 rl2 =
- readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0)
+ liftReadList2 rp1 rl1 rp2 rl2 = readPrec_to_S
+ (list $ liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
+ (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0
+
+ -- | 'readPrec' function for an application of the type constructor
+ -- based on 'readPrec' and 'readListPrec' functions for the argument types.
+ --
+ -- @since 4.10.0.0
+ liftReadPrec2 :: ReadPrec a -> ReadPrec [a] ->
+ ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
+ liftReadPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $
+ liftReadsPrec2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)
+ (readPrec_to_S rp2) (readPrec_to_S rl2 0)
+
+ -- | 'readListPrec' function for an application of the type constructor
+ -- based on 'readPrec' and 'readListPrec' functions for the argument types.
+ --
+ -- The default definition uses 'liftReadList2'. Instances that define
+ -- 'liftReadPrec2' should also define 'liftReadListPrec2' as
+ -- 'liftReadListPrec2Default'.
+ --
+ -- @since 4.10.0.0
+ liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] ->
+ ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
+ liftReadListPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $ \_ ->
+ liftReadList2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)
+ (readPrec_to_S rp2) (readPrec_to_S rl2 0)
-- | Lift the standard 'readsPrec' function through the type constructor.
+--
+-- @since 4.9.0.0
readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList
+-- | Lift the standard 'readPrec' function through the type constructor.
+--
+-- @since 4.10.0.0
+readPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)
+readPrec2 = liftReadPrec2 readPrec readListPrec readPrec readListPrec
+
+-- | A possible replacement definition for the 'liftReadList2' method.
+-- This is only needed for 'Read2' instances where 'liftReadListPrec2' isn't
+-- defined as 'liftReadListPrec2Default'.
+--
+-- @since 4.10.0.0
+liftReadList2Default :: Read2 f => (Int -> ReadS a) -> ReadS [a] ->
+ (Int -> ReadS b) -> ReadS [b] ->ReadS [f a b]
+liftReadList2Default rp1 rl1 rp2 rl2 = readPrec_to_S
+ (liftReadListPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
+ (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0
+
+-- | A possible replacement definition for the 'liftReadListPrec2' method,
+-- defined using 'liftReadPrec2'.
+--
+-- @since 4.10.0.0
+liftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->
+ ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
+liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2)
+
-- | Lifting of the 'Show' class to binary type constructors.
+--
+-- @since 4.9.0.0
class Show2 f where
-- | 'showsPrec' function for an application of the type constructor
-- based on 'showsPrec' and 'showList' functions for the argument types.
+ --
+ -- @since 4.9.0.0
liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
(Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS
@@ -203,12 +384,16 @@ class Show2 f where
-- based on 'showsPrec' and 'showList' functions for the argument types.
-- The default implementation using standard list syntax is correct
-- for most types.
+ --
+ -- @since 4.9.0.0
liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
(Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS
liftShowList2 sp1 sl1 sp2 sl2 =
showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)
-- | Lift the standard 'showsPrec' function through the type constructor.
+--
+-- @since 4.9.0.0
showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList
@@ -230,10 +415,13 @@ instance Ord1 Maybe where
-- | @since 4.9.0.0
instance Read1 Maybe where
- liftReadsPrec rp _ d =
- readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r])
- `mappend`
- readsData (readsUnaryWith rp "Just" Just) d
+ liftReadPrec rp _ =
+ parens (expectP (Ident "Nothing") *> pure Nothing)
+ <|>
+ readData (readUnaryWith rp "Just" Just)
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance Show1 Maybe where
@@ -256,7 +444,9 @@ instance Ord1 [] where
-- | @since 4.9.0.0
instance Read1 [] where
- liftReadsPrec _ rl _ = rl
+ liftReadPrec _ rl = rl
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance Show1 [] where
@@ -273,12 +463,14 @@ instance Ord2 (,) where
-- | @since 4.9.0.0
instance Read2 (,) where
- liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r ->
- [((x,y), w) | ("(",s) <- lex r,
- (x,t) <- rp1 0 s,
- (",",u) <- lex t,
- (y,v) <- rp2 0 u,
- (")",w) <- lex v]
+ liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
+ x <- rp1
+ expectP (Punc ",")
+ y <- rp2
+ return (x,y)
+
+ liftReadListPrec2 = liftReadListPrec2Default
+ liftReadList2 = liftReadList2Default
-- | @since 4.9.0.0
instance Show2 (,) where
@@ -295,7 +487,10 @@ instance (Ord a) => Ord1 ((,) a) where
-- | @since 4.9.0.0
instance (Read a) => Read1 ((,) a) where
- liftReadsPrec = liftReadsPrec2 readsPrec readList
+ liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance (Show a) => Show1 ((,) a) where
@@ -317,9 +512,12 @@ instance Ord2 Either where
-- | @since 4.9.0.0
instance Read2 Either where
- liftReadsPrec2 rp1 _ rp2 _ = readsData $
- readsUnaryWith rp1 "Left" Left `mappend`
- readsUnaryWith rp2 "Right" Right
+ liftReadPrec2 rp1 _ rp2 _ = readData $
+ readUnaryWith rp1 "Left" Left <|>
+ readUnaryWith rp2 "Right" Right
+
+ liftReadListPrec2 = liftReadListPrec2Default
+ liftReadList2 = liftReadList2Default
-- | @since 4.9.0.0
instance Show2 Either where
@@ -336,7 +534,10 @@ instance (Ord a) => Ord1 (Either a) where
-- | @since 4.9.0.0
instance (Read a) => Read1 (Either a) where
- liftReadsPrec = liftReadsPrec2 readsPrec readList
+ liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance (Show a) => Show1 (Either a) where
@@ -354,8 +555,11 @@ instance Ord1 Identity where
-- | @since 4.9.0.0
instance Read1 Identity where
- liftReadsPrec rp _ = readsData $
- readsUnaryWith rp "Identity" Identity
+ liftReadPrec rp _ = readData $
+ readUnaryWith rp "Identity" Identity
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance Show1 Identity where
@@ -371,8 +575,11 @@ instance Ord2 Const where
-- | @since 4.9.0.0
instance Read2 Const where
- liftReadsPrec2 rp _ _ _ = readsData $
- readsUnaryWith rp "Const" Const
+ liftReadPrec2 rp _ _ _ = readData $
+ readUnaryWith rp "Const" Const
+
+ liftReadListPrec2 = liftReadListPrec2Default
+ liftReadList2 = liftReadList2Default
-- | @since 4.9.0.0
instance Show2 Const where
@@ -386,7 +593,10 @@ instance (Ord a) => Ord1 (Const a) where
liftCompare = liftCompare2 compare
-- | @since 4.9.0.0
instance (Read a) => Read1 (Const a) where
- liftReadsPrec = liftReadsPrec2 readsPrec readList
+ liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance (Show a) => Show1 (Const a) where
liftShowsPrec = liftShowsPrec2 showsPrec showList
@@ -407,8 +617,10 @@ instance Show1 Proxy where
-- | @since 4.9.0.0
instance Read1 Proxy where
- liftReadsPrec _ _ d =
- readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])
+ liftReadPrec _ _ = parens (expectP (Ident "Proxy") *> pure Proxy)
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- Building blocks
@@ -417,27 +629,68 @@ instance Read1 Proxy where
-- passes it to @p@. Parsers for various constructors can be constructed
-- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with
-- @mappend@ from the @Monoid@ class.
+--
+-- @since 4.9.0.0
readsData :: (String -> ReadS a) -> Int -> ReadS a
readsData reader d =
readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]
+-- | @'readData' p@ is a parser for datatypes where each alternative
+-- begins with a data constructor. It parses the constructor and
+-- passes it to @p@. Parsers for various constructors can be constructed
+-- with 'readUnaryWith' and 'readBinaryWith', and combined with
+-- '(<|>)' from the 'Alternative' class.
+--
+-- @since 4.10.0.0
+readData :: ReadPrec a -> ReadPrec a
+readData reader = parens $ prec 10 reader
+
-- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor
-- and then parses its argument using @rp@.
+--
+-- @since 4.9.0.0
readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith rp name cons kw s =
[(cons x,t) | kw == name, (x,t) <- rp 11 s]
+-- | @'readUnaryWith' rp n c'@ matches the name of a unary data constructor
+-- and then parses its argument using @rp@.
+--
+-- @since 4.10.0.0
+readUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t
+readUnaryWith rp name cons = do
+ expectP $ Ident name
+ x <- step rp
+ return $ cons x
+
-- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary
-- data constructor and then parses its arguments using @rp1@ and @rp2@
-- respectively.
+--
+-- @since 4.9.0.0
readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
String -> (a -> b -> t) -> String -> ReadS t
readsBinaryWith rp1 rp2 name cons kw s =
[(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]
+-- | @'readBinaryWith' rp1 rp2 n c'@ matches the name of a binary
+-- data constructor and then parses its arguments using @rp1@ and @rp2@
+-- respectively.
+--
+-- @since 4.10.0.0
+readBinaryWith :: ReadPrec a -> ReadPrec b ->
+ String -> (a -> b -> t) -> ReadPrec t
+readBinaryWith rp1 rp2 name cons = do
+ expectP $ Ident name
+ x <- step rp1
+ y <- step rp2
+ return $ cons x y
+
-- | @'showsUnaryWith' sp n d x@ produces the string representation of a
-- unary data constructor with name @n@ and argument @x@, in precedence
-- context @d@.
+--
+-- @since 4.9.0.0
showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith sp name d x = showParen (d > 10) $
showString name . showChar ' ' . sp 11 x
@@ -445,6 +698,8 @@ showsUnaryWith sp name d x = showParen (d > 10) $
-- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string
-- representation of a binary data constructor with name @n@ and arguments
-- @x@ and @y@, in precedence context @d@.
+--
+-- @since 4.9.0.0
showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
String -> Int -> a -> b -> ShowS
showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
@@ -454,6 +709,8 @@ showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
-- | @'readsUnary' n c n'@ matches the name of a unary data constructor
-- and then parses its argument using 'readsPrec'.
+--
+-- @since 4.9.0.0
{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-}
readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
readsUnary name cons kw s =
@@ -461,6 +718,8 @@ readsUnary name cons kw s =
-- | @'readsUnary1' n c n'@ matches the name of a unary data constructor
-- and then parses its argument using 'readsPrec1'.
+--
+-- @since 4.9.0.0
{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-}
readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
readsUnary1 name cons kw s =
@@ -468,6 +727,8 @@ readsUnary1 name cons kw s =
-- | @'readsBinary1' n c n'@ matches the name of a binary data constructor
-- and then parses its arguments using 'readsPrec1'.
+--
+-- @since 4.9.0.0
{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-}
readsBinary1 :: (Read1 f, Read1 g, Read a) =>
String -> (f a -> g a -> t) -> String -> ReadS t
@@ -477,6 +738,8 @@ readsBinary1 name cons kw s =
-- | @'showsUnary' n d x@ produces the string representation of a unary data
-- constructor with name @n@ and argument @x@, in precedence context @d@.
+--
+-- @since 4.9.0.0
{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-}
showsUnary :: (Show a) => String -> Int -> a -> ShowS
showsUnary name d x = showParen (d > 10) $
@@ -484,6 +747,8 @@ showsUnary name d x = showParen (d > 10) $
-- | @'showsUnary1' n d x@ produces the string representation of a unary data
-- constructor with name @n@ and argument @x@, in precedence context @d@.
+--
+-- @since 4.9.0.0
{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-}
showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
showsUnary1 name d x = showParen (d > 10) $
@@ -492,6 +757,8 @@ showsUnary1 name d x = showParen (d > 10) $
-- | @'showsBinary1' n d x y@ produces the string representation of a binary
-- data constructor with name @n@ and arguments @x@ and @y@, in precedence
-- context @d@.
+--
+-- @since 4.9.0.0
{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-}
showsBinary1 :: (Show1 f, Show1 g, Show a) =>
String -> Int -> f a -> g a -> ShowS
@@ -508,10 +775,11 @@ new algebraic types. For example, given the definition
a standard 'Read1' instance may be defined as
> instance (Read1 f) => Read1 (T f) where
-> liftReadsPrec rp rl = readsData $
-> readsUnaryWith rp "Zero" Zero `mappend`
-> readsUnaryWith (liftReadsPrec rp rl) "One" One `mappend`
-> readsBinaryWith rp (liftReadsPrec rp rl) "Two" Two
+> liftReadPrec rp rl = readData $
+> readUnaryWith rp "Zero" Zero <|>
+> readUnaryWith (liftReadPrec rp rl) "One" One <|>
+> readBinaryWith rp (liftReadPrec rp rl) "Two" Two
+> liftReadListPrec = liftReadListPrecDefault
and the corresponding 'Show1' instance as
diff --git a/libraries/base/Data/Functor/Compose.hs b/libraries/base/Data/Functor/Compose.hs
index a09b2acafe..901489cc18 100644
--- a/libraries/base/Data/Functor/Compose.hs
+++ b/libraries/base/Data/Functor/Compose.hs
@@ -28,6 +28,7 @@ import Data.Data (Data)
import Data.Foldable (Foldable(foldMap))
import Data.Traversable (Traversable(traverse))
import GHC.Generics (Generic, Generic1)
+import Text.Read (Read(..), readListDefault, readListPrecDefault)
infixr 9 `Compose`
@@ -50,11 +51,14 @@ instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where
-- | @since 4.9.0.0
instance (Read1 f, Read1 g) => Read1 (Compose f g) where
- liftReadsPrec rp rl = readsData $
- readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose
+ liftReadPrec rp rl = readData $
+ readUnaryWith (liftReadPrec rp' rl') "Compose" Compose
where
- rp' = liftReadsPrec rp rl
- rl' = liftReadList rp rl
+ rp' = liftReadPrec rp rl
+ rl' = liftReadListPrec rp rl
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g) => Show1 (Compose f g) where
@@ -76,7 +80,10 @@ instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where
-- | @since 4.9.0.0
instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where
- readsPrec = readsPrec1
+ readPrec = readPrec1
+
+ readListPrec = readListPrecDefault
+ readList = readListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where
diff --git a/libraries/base/Data/Functor/Product.hs b/libraries/base/Data/Functor/Product.hs
index a70f04b661..b176d4e114 100644
--- a/libraries/base/Data/Functor/Product.hs
+++ b/libraries/base/Data/Functor/Product.hs
@@ -31,6 +31,7 @@ import Data.Functor.Classes
import Data.Monoid (mappend)
import Data.Traversable (Traversable(traverse))
import GHC.Generics (Generic, Generic1)
+import Text.Read (Read(..), readListDefault, readListPrecDefault)
-- | Lifted product of functors.
data Product f g a = Pair (f a) (g a)
@@ -47,8 +48,11 @@ instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where
-- | @since 4.9.0.0
instance (Read1 f, Read1 g) => Read1 (Product f g) where
- liftReadsPrec rp rl = readsData $
- readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair
+ liftReadPrec rp rl = readData $
+ readBinaryWith (liftReadPrec rp rl) (liftReadPrec rp rl) "Pair" Pair
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g) => Show1 (Product f g) where
@@ -65,7 +69,10 @@ instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where
-- | @since 4.9.0.0
instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where
- readsPrec = readsPrec1
+ readPrec = readPrec1
+
+ readListPrec = readListPrecDefault
+ readList = readListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where
diff --git a/libraries/base/Data/Functor/Sum.hs b/libraries/base/Data/Functor/Sum.hs
index 9279de45f9..f18feae2f0 100644
--- a/libraries/base/Data/Functor/Sum.hs
+++ b/libraries/base/Data/Functor/Sum.hs
@@ -21,12 +21,13 @@ module Data.Functor.Sum (
Sum(..),
) where
+import Control.Applicative ((<|>))
import Data.Data (Data)
import Data.Foldable (Foldable(foldMap))
import Data.Functor.Classes
-import Data.Monoid (mappend)
import Data.Traversable (Traversable(traverse))
import GHC.Generics (Generic, Generic1)
+import Text.Read (Read(..), readListDefault, readListPrecDefault)
-- | Lifted sum of functors.
data Sum f g a = InL (f a) | InR (g a)
@@ -48,9 +49,12 @@ instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where
-- | @since 4.9.0.0
instance (Read1 f, Read1 g) => Read1 (Sum f g) where
- liftReadsPrec rp rl = readsData $
- readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend`
- readsUnaryWith (liftReadsPrec rp rl) "InR" InR
+ liftReadPrec rp rl = readData $
+ readUnaryWith (liftReadPrec rp rl) "InL" InL <|>
+ readUnaryWith (liftReadPrec rp rl) "InR" InR
+
+ liftReadListPrec = liftReadListPrecDefault
+ liftReadList = liftReadListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g) => Show1 (Sum f g) where
@@ -67,7 +71,10 @@ instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
compare = compare1
-- | @since 4.9.0.0
instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
- readsPrec = readsPrec1
+ readPrec = readPrec1
+
+ readListPrec = readListPrecDefault
+ readList = readListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
showsPrec = showsPrec1
diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs
index d7df82f1f6..ebb72c77da 100644
--- a/libraries/base/GHC/Read.hs
+++ b/libraries/base/GHC/Read.hs
@@ -147,6 +147,31 @@ readParen b g = if b then mandatory else optional
-- > up_prec = 5
-- >
-- > readListPrec = readListPrecDefault
+--
+-- Why do both 'readsPrec' and 'readPrec' exist, and why does GHC opt to
+-- implement 'readPrec' in derived 'Read' instances instead of 'readsPrec'?
+-- The reason is that 'readsPrec' is based on the 'ReadS' type, and although
+-- 'ReadS' is mentioned in the Haskell 2010 Report, it is not a very efficient
+-- parser data structure.
+--
+-- 'readPrec', on the other hand, is based on a much more efficient 'ReadPrec'
+-- datatype (a.k.a \"new-style parsers\"), but its definition relies on the use
+-- of the @RankNTypes@ language extension. Therefore, 'readPrec' (and its
+-- cousin, 'readListPrec') are marked as GHC-only. Nevertheless, it is
+-- recommended to use 'readPrec' instead of 'readsPrec' whenever possible
+-- for the efficiency improvements it brings.
+--
+-- As mentioned above, derived 'Read' instances in GHC will implement
+-- 'readPrec' instead of 'readsPrec'. The default implementations of
+-- 'readsPrec' (and its cousin, 'readList') will simply use 'readPrec' under
+-- the hood. If you are writing a 'Read' instance by hand, it is recommended
+-- to write it like so:
+--
+-- @
+-- instance 'Read' T where
+-- 'readPrec' = ...
+-- 'readListPrec' = 'readListPrecDefault'
+-- @
class Read a where
{-# MINIMAL readsPrec | readPrec #-}
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index f8f6b10f30..d2cc42159b 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -18,6 +18,11 @@
* `Data.Type.Coercion` now provides `gcoerceWith` (#12493)
+ * New methods `liftReadList(2)` and `liftReadListPrec(2)` in the
+ `Read1`/`Read2` classes that are defined in terms of `ReadPrec` instead of
+ `ReadS`, as well as related combinators, have been added to
+ `Data.Functor.Classes` (#12358)
+
## 4.9.0.0 *May 2016*
* Bundled with GHC 8.0