[commit: ghc] master: Make `read . show = id` for Data.Fixed (fix #9240) (7c38e98)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7c38e985aa211ca44039c6d1db9fa13690749c59/ghc

>---------------------------------------------------------------

commit 7c38e985aa211ca44039c6d1db9fa13690749c59
Author: Brian McKenna <brian at brianmckenna.org>
Date:   Tue Dec 2 17:53:38 2014 +0100

    Make `read . show = id` for Data.Fixed (fix #9240)
    
    The QuickCheck property now succeeds:
    
        prop :: Fixed B7 -> Bool
        prop a = read (show a) == a
    
    This changes the Show instance for Fixed to round up, rather than down
    when calculating a digit. This needs to happen because Read also
    rounds down:
    
        data B7
    
        instance HasResolution B7 where
          resolution _ = 128
    
        1 / 128 = 0.0078125
    
        read "0.007" = (0.000 :: Fixed B7)
    
    Here is an example of the change to Show:
    
        showFixed False (0.009 :: Fixed B7)
    
        -- Broken: "0.007"
        -- Fixed:  "0.008"
    
    And now Read can continue to round down:
    
        read "0.008" = (0.0078125 :: Fixed B7)
    
    Reviewed By: hvr, ekmett
    
    Differential Revision: https://phabricator.haskell.org/D547


>---------------------------------------------------------------

7c38e985aa211ca44039c6d1db9fa13690749c59
 libraries/base/Data/Fixed.hs                     | 4 +++-
 libraries/base/changelog.md                      | 2 ++
 libraries/base/tests/data-fixed-show-read.hs     | 7 +++++++
 libraries/base/tests/data-fixed-show-read.stdout | 2 ++
 4 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs
index 068eec5..f12a0e4 100644
--- a/libraries/base/Data/Fixed.hs
+++ b/libraries/base/Data/Fixed.hs
@@ -143,7 +143,9 @@ showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZe
     -- enough digits to be unambiguous
     digits = ceiling (logBase 10 (fromInteger res) :: Double)
     maxnum = 10 ^ digits
-    fracNum = div (d * maxnum) res
+    -- read floors, so show must ceil for `read . show = id` to hold. See #9240
+    fracNum = divCeil (d * maxnum) res
+    divCeil x y = (x + y - 1) `div` y
 
 instance (HasResolution a) => Show (Fixed a) where
     show = showFixed False
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 07c91a3..ef3e9ae 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -128,6 +128,8 @@
 
     together with a new exception `AllocationLimitExceeded`.
 
+  * Make `read . show = id` for `Data.Fixed` (#9240)
+
 ## 4.7.0.2  *Dec 2014*
 
   * Bundled with GHC 7.8.4
diff --git a/libraries/base/tests/data-fixed-show-read.hs b/libraries/base/tests/data-fixed-show-read.hs
index 349f639..7e947f4 100644
--- a/libraries/base/tests/data-fixed-show-read.hs
+++ b/libraries/base/tests/data-fixed-show-read.hs
@@ -3,6 +3,11 @@ module Main (main) where
 
 import Data.Fixed
 
+data B7
+
+instance HasResolution B7 where
+  resolution _ = 128
+
 main :: IO ()
 main = do doit 38.001
           doit 38.009
@@ -14,6 +19,8 @@ main = do doit 38.001
           doit (-38.01)
           doit (-38.09)
           print (read "-38" :: Centi)
+          print (read "0.008" :: Fixed B7)
+          print (read "-0.008" :: Fixed B7)
 
 doit :: Centi -> IO ()
 doit c = do let s = show c
diff --git a/libraries/base/tests/data-fixed-show-read.stdout b/libraries/base/tests/data-fixed-show-read.stdout
index 0e5d7ca..4abb2d9 100644
--- a/libraries/base/tests/data-fixed-show-read.stdout
+++ b/libraries/base/tests/data-fixed-show-read.stdout
@@ -16,3 +16,5 @@
 -38.09
 -38.09
 -38.00
+0.008
+-0.008