[commit: ghc] wip/issue15622: Data.Fixed fix for issue 15622 (15d9fb5)

[git at git.haskell.org]

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

On branch  : wip/issue15622
Link       : http://ghc.haskell.org/trac/ghc/changeset/15d9fb580736f880455f40368b4ee402f3d307f5/ghc

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

commit 15d9fb580736f880455f40368b4ee402f3d307f5
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Mon Mar 11 13:02:13 2019 -0700

    Data.Fixed fix for issue 15622


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

15d9fb580736f880455f40368b4ee402f3d307f5
 libraries/base/Data/Fixed.hs | 57 +++++++++++++++++---------------------------
 libraries/time               |  2 +-
 2 files changed, 23 insertions(+), 36 deletions(-)

diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs
index 482ec0a..d7930be 100644
--- a/libraries/base/Data/Fixed.hs
+++ b/libraries/base/Data/Fixed.hs
@@ -1,5 +1,10 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ExplicitNamespaces #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -37,6 +42,7 @@ module Data.Fixed
 ) where
 
 import Data.Data
+import GHC.TypeLits (KnownNat, natVal, type (^))
 import GHC.Read
 import Text.ParserCombinators.ReadPrec
 import Text.Read.Lex
@@ -58,7 +64,7 @@ mod' n d = n - (fromInteger f) * d where
     f = div' n d
 
 -- | The type parameter should be an instance of 'HasResolution'.
-newtype Fixed a = MkFixed Integer
+newtype Fixed (a :: k) = MkFixed Integer
         deriving ( Eq  -- ^ @since 2.01
                  , Ord -- ^ @since 2.01
                  )
@@ -71,17 +77,20 @@ conMkFixed :: Constr
 conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix
 
 -- | @since 4.1.0.0
-instance (Typeable a) => Data (Fixed a) where
+instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where
     gfoldl k z (MkFixed a) = k (z MkFixed) a
     gunfold k z _ = k (z MkFixed)
     dataTypeOf _ = tyFixed
     toConstr _ = conMkFixed
 
-class HasResolution a where
+class HasResolution (a :: k) where
     resolution :: p a -> Integer
 
-withType :: (p a -> f a) -> f a
-withType foo = foo undefined
+instance KnownNat n => HasResolution n where
+    resolution _ = natVal (Proxy :: Proxy n)
+
+withType :: (Proxy a -> f a) -> f a
+withType foo = foo Proxy
 
 withResolution :: (HasResolution a) => (Integer -> f a) -> f a
 withResolution foo = withType (foo . resolution)
@@ -170,65 +179,43 @@ convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)
 convertFixed (Number n)
  | Just (i, f) <- numberToFixed e n =
     return (fromInteger i + (fromInteger f / (10 ^ e)))
-    where r = resolution (undefined :: Fixed a)
+    where r = resolution (Proxy :: Proxy a)
           -- round 'e' up to help make the 'read . show == id' property
           -- possible also for cases where 'resolution' is not a
           -- power-of-10, such as e.g. when 'resolution = 128'
           e = ceiling (logBase 10 (fromInteger r) :: Double)
 convertFixed _ = pfail
 
-data E0
+type E0 = 10 ^ 0
 
--- | @since 4.1.0.0
-instance HasResolution E0 where
-    resolution _ = 1
 -- | resolution of 1, this works the same as Integer
 type Uni = Fixed E0
 
-data E1
+type E1 = 10 ^ 1
 
--- | @since 4.1.0.0
-instance HasResolution E1 where
-    resolution _ = 10
 -- | resolution of 10^-1 = .1
 type Deci = Fixed E1
 
-data E2
+type E2 = 10 ^ 2
 
--- | @since 4.1.0.0
-instance HasResolution E2 where
-    resolution _ = 100
 -- | resolution of 10^-2 = .01, useful for many monetary currencies
 type Centi = Fixed E2
 
-data E3
+type E3 = 10 ^ 3
 
--- | @since 4.1.0.0
-instance HasResolution E3 where
-    resolution _ = 1000
 -- | resolution of 10^-3 = .001
 type Milli = Fixed E3
 
-data E6
+type E6 = 10 ^ 6
 
--- | @since 2.01
-instance HasResolution E6 where
-    resolution _ = 1000000
 -- | resolution of 10^-6 = .000001
 type Micro = Fixed E6
 
-data E9
+type E9 = 10 ^ 9
 
--- | @since 4.1.0.0
-instance HasResolution E9 where
-    resolution _ = 1000000000
 -- | resolution of 10^-9 = .000000001
 type Nano = Fixed E9
 
-data E12
-
--- | @since 2.01
-instance HasResolution E12 where
-    resolution _ = 1000000000000
+type E12 = 10 ^ 12
 -- | resolution of 10^-12 = .000000000001
 type Pico = Fixed E12
diff --git a/libraries/time b/libraries/time
index 9e96c26..4302fdb 160000
--- a/libraries/time
+++ b/libraries/time
@@ -1 +1 @@
-Subproject commit 9e96c26132fef01a3113c8b152b1be96c0eccd86
+Subproject commit 4302fdbcff75a16296aab2ef6e46194ef147b886