Add Read1/Read2 methods defined in terms of ReadPrec
authorRyan Scott <ryan.gl.scott@gmail.com>
Wed, 31 Aug 2016 18:30:57 +0000 (14:30 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 31 Aug 2016 18:31:15 +0000 (14:31 -0400)
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

docs/users_guide/8.2.1-notes.rst
docs/users_guide/bugs.rst
libraries/base/Data/Functor/Classes.hs
libraries/base/Data/Functor/Compose.hs
libraries/base/Data/Functor/Product.hs
libraries/base/Data/Functor/Sum.hs
libraries/base/GHC/Read.hs
libraries/base/changelog.md

index bb31d95..fdd8f5c 100644 (file)
@@ -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
 ~~~~~~
 
index 5b710aa..5d30363 100644 (file)
@@ -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: ::
 
index 460ecc1..2510da9 100644 (file)
@@ -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
 
index a09b2ac..901489c 100644 (file)
@@ -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
index a70f04b..b176d4e 100644 (file)
@@ -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
index 9279de4..f18feae 100644 (file)
@@ -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
index d7df82f..ebb72c7 100644 (file)
@@ -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 #-}
index f8f6b10..d2cc421 100644 (file)
 
   * `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