diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2016-08-31 14:30:57 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-08-31 14:31:15 -0400 |
commit | 9cfef167dc0b2bfa881c5d9eca38227fbdfd507c (patch) | |
tree | f1987b7d88b22c991bb86599c3da20c0581cee4c | |
parent | 9306db051ff5835b453d55f32783d081ac79ec28 (diff) | |
download | haskell-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.rst | 6 | ||||
-rw-r--r-- | docs/users_guide/bugs.rst | 12 | ||||
-rw-r--r-- | libraries/base/Data/Functor/Classes.hs | 364 | ||||
-rw-r--r-- | libraries/base/Data/Functor/Compose.hs | 17 | ||||
-rw-r--r-- | libraries/base/Data/Functor/Product.hs | 13 | ||||
-rw-r--r-- | libraries/base/Data/Functor/Sum.hs | 17 | ||||
-rw-r--r-- | libraries/base/GHC/Read.hs | 25 | ||||
-rw-r--r-- | libraries/base/changelog.md | 5 |
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 |