[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: fix Enums to conform with Haskell 98 (and GHC 6.4) (59ab29a)

git at git.haskell.org git at git.haskell.org
Fri Apr 21 16:43:40 UTC 2017


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

On branches: format-widths,ghc,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/59ab29ace05cdab48bb25566f31f56d443c5fc53

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

commit 59ab29ace05cdab48bb25566f31f56d443c5fc53
Author: ashley <ashley at semantic.org>
Date:   Tue Apr 12 00:02:57 2005 -0700

    fix Enums to conform with Haskell 98 (and GHC 6.4)
    
    darcs-hash:20050412070257-ca2d0-fc71ddb95a4c9ca4f6c77e5a90020d194bd814c7


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

59ab29ace05cdab48bb25566f31f56d443c5fc53
 Data/Fixed.hs        | 12 +++++++++++-
 System/Time/Clock.hs | 24 ++++++++++++++++++++++--
 2 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/Data/Fixed.hs b/Data/Fixed.hs
index 971a39b..697c460 100644
--- a/Data/Fixed.hs
+++ b/Data/Fixed.hs
@@ -24,7 +24,7 @@ mod' :: (Real a) => a -> a -> a
 mod' n d = n - (fromInteger f) * d where
 	f = div' n d
 
-newtype Fixed a = MkFixed Integer deriving (Eq,Ord,Enum)
+newtype Fixed a = MkFixed Integer deriving (Eq,Ord)
 
 class HasResolution a where
 	resolution :: a -> Integer
@@ -40,6 +40,16 @@ withType foo = foo undefined
 withResolution :: (HasResolution a) => (Integer -> f a) -> f a
 withResolution foo = withType (foo . resolution)
 
+instance Enum (Fixed a) where
+	succ (MkFixed a) = MkFixed (succ a)
+	pred (MkFixed a) = MkFixed (pred a)
+	toEnum = MkFixed . toEnum
+	fromEnum (MkFixed a) = fromEnum a
+	enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)
+	enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)
+	enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)
+	enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)
+
 instance (HasResolution a) => Num (Fixed a) where
 	(MkFixed a) + (MkFixed b) = MkFixed (a + b)
 	(MkFixed a) - (MkFixed b) = MkFixed (a - b)
diff --git a/System/Time/Clock.hs b/System/Time/Clock.hs
index c13fb61..44192b5 100644
--- a/System/Time/Clock.hs
+++ b/System/Time/Clock.hs
@@ -28,7 +28,17 @@ type ModJulianDay = Integer
 type ModJulianDate = Rational
 
 -- | a length of time
-newtype DiffTime = MkDiffTime Pico deriving (Eq,Ord,Enum)
+newtype DiffTime = MkDiffTime Pico deriving (Eq,Ord)
+
+instance Enum DiffTime where
+	succ (MkDiffTime a) = MkDiffTime (succ a)
+	pred (MkDiffTime a) = MkDiffTime (pred a)
+	toEnum = MkDiffTime . toEnum
+	fromEnum (MkDiffTime a) = fromEnum a
+	enumFrom (MkDiffTime a) = fmap MkDiffTime (enumFrom a)
+	enumFromThen (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromThen a b)
+	enumFromTo (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromTo a b)
+	enumFromThenTo (MkDiffTime a) (MkDiffTime b) (MkDiffTime c) = fmap MkDiffTime (enumFromThenTo a b c)
 
 instance Show DiffTime where
 	show (MkDiffTime t) = (showFixed True t) ++ "s"
@@ -62,7 +72,17 @@ data UTCTime = UTCTime {
 }
 
 -- | a length of time for UTC, ignoring leap-seconds
-newtype UTCDiffTime = MkUTCDiffTime Pico deriving (Eq,Ord,Enum)
+newtype UTCDiffTime = MkUTCDiffTime Pico deriving (Eq,Ord)
+
+instance Enum UTCDiffTime where
+	succ (MkUTCDiffTime a) = MkUTCDiffTime (succ a)
+	pred (MkUTCDiffTime a) = MkUTCDiffTime (pred a)
+	toEnum = MkUTCDiffTime . toEnum
+	fromEnum (MkUTCDiffTime a) = fromEnum a
+	enumFrom (MkUTCDiffTime a) = fmap MkUTCDiffTime (enumFrom a)
+	enumFromThen (MkUTCDiffTime a) (MkUTCDiffTime b) = fmap MkUTCDiffTime (enumFromThen a b)
+	enumFromTo (MkUTCDiffTime a) (MkUTCDiffTime b) = fmap MkUTCDiffTime (enumFromTo a b)
+	enumFromThenTo (MkUTCDiffTime a) (MkUTCDiffTime b) (MkUTCDiffTime c) = fmap MkUTCDiffTime (enumFromThenTo a b c)
 
 instance Show UTCDiffTime where
 	show (MkUTCDiffTime t) = (showFixed True t) ++ "s"



More information about the ghc-commits mailing list