[commit: packages/time] master, wip/travis: make diff times instances of Num (7339f64)
git at git.haskell.org
git at git.haskell.org
Sat May 7 06:39:26 UTC 2016
Repository : ssh://git@git.haskell.org/time
On branches: master,wip/travis
Link : http://git.haskell.org/packages/time.git/commitdiff/7339f6490cd349867b5cb93d8a59f31a4a92c9cd
>---------------------------------------------------------------
commit 7339f6490cd349867b5cb93d8a59f31a4a92c9cd
Author: Ashley Yakeley <ashley at semantic.org>
Date: Wed Feb 23 02:28:59 2005 -0800
make diff times instances of Num
darcs-hash:20050223102859-ac6dd-24d8169a3ff6da7e55dc008515c04dc56e5e902d
>---------------------------------------------------------------
7339f6490cd349867b5cb93d8a59f31a4a92c9cd
System/Time/Clock.hs | 36 +++++++++++++++---------------------
1 file changed, 15 insertions(+), 21 deletions(-)
diff --git a/System/Time/Clock.hs b/System/Time/Clock.hs
index 386c920..628a627 100644
--- a/System/Time/Clock.hs
+++ b/System/Time/Clock.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -ffi #-}
+{-# OPTIONS -ffi -fglasgow-exts #-}
module System.Time.Clock
(
@@ -27,38 +27,32 @@ type ModJulianDate = Rational
secondPicoseconds :: (Num a) => a
secondPicoseconds = 1000000000000
-newtype DiffTime = MkDiffTime Integer deriving (Eq,Ord,Show)
+newtype DiffTime = MkDiffTime Integer deriving (Eq,Ord,Num,Enum,Real,Integral)
-timeToSIPicoseconds :: DiffTime -> Integer
-timeToSIPicoseconds (MkDiffTime ps) = ps
-
-siPicosecondsToTime :: Integer -> DiffTime
-siPicosecondsToTime = MkDiffTime
+instance Show DiffTime where
+ show (MkDiffTime t) = (show t) ++ "ps"
timeToSISeconds :: (Fractional a) => DiffTime -> a
-timeToSISeconds t = fromRational ((toRational (timeToSIPicoseconds t)) / (toRational secondPicoseconds));
+timeToSISeconds t = fromRational ((toRational t) / (toRational secondPicoseconds));
siSecondsToTime :: (Real a) => a -> DiffTime
-siSecondsToTime t = siPicosecondsToTime (round ((toRational t) * secondPicoseconds))
+siSecondsToTime t = fromInteger (round ((toRational t) * secondPicoseconds))
data UTCTime = UTCTime {
utctDay :: ModJulianDay,
utctDayTime :: DiffTime
}
-newtype UTCDiffTime = MkUTCDiffTime Integer
-
-utcTimeToUTCPicoseconds :: UTCDiffTime -> Integer
-utcTimeToUTCPicoseconds (MkUTCDiffTime ps) = ps
+newtype UTCDiffTime = MkUTCDiffTime Integer deriving (Eq,Ord,Num,Enum,Real,Integral)
-utcPicosecondsToUTCTime :: Integer -> UTCDiffTime
-utcPicosecondsToUTCTime = MkUTCDiffTime
+instance Show UTCDiffTime where
+ show (MkUTCDiffTime t) = (show t) ++ "ps"
utcTimeToUTCSeconds :: (Fractional a) => UTCDiffTime -> a
-utcTimeToUTCSeconds t = fromRational ((toRational (utcTimeToUTCPicoseconds t)) / (toRational secondPicoseconds))
+utcTimeToUTCSeconds t = fromRational ((toRational t) / (toRational secondPicoseconds))
utcSecondsToUTCTime :: (Real a) => a -> UTCDiffTime
-utcSecondsToUTCTime t = utcPicosecondsToUTCTime (round ((toRational t) * secondPicoseconds))
+utcSecondsToUTCTime t = fromInteger (round ((toRational t) * secondPicoseconds))
posixDaySeconds :: (Num a) => a
posixDaySeconds = 86400
@@ -72,17 +66,17 @@ unixEpochMJD = 40587
posixPicosecondsToUTCTime :: Integer -> UTCTime
posixPicosecondsToUTCTime i = let
(d,t) = divMod i posixDayPicoseconds
- in UTCTime (d + unixEpochMJD) (siPicosecondsToTime t)
+ in UTCTime (d + unixEpochMJD) (fromInteger t)
utcTimeToPOSIXPicoseconds :: UTCTime -> Integer
utcTimeToPOSIXPicoseconds (UTCTime d t) =
- ((d - unixEpochMJD) * posixDayPicoseconds) + min posixDayPicoseconds (timeToSIPicoseconds t)
+ ((d - unixEpochMJD) * posixDayPicoseconds) + min posixDayPicoseconds (toInteger t)
addUTCTime :: UTCDiffTime -> UTCTime -> UTCTime
-addUTCTime x t = posixPicosecondsToUTCTime ((utcTimeToUTCPicoseconds x) + (utcTimeToPOSIXPicoseconds t))
+addUTCTime x t = posixPicosecondsToUTCTime ((toInteger x) + (utcTimeToPOSIXPicoseconds t))
diffUTCTime :: UTCTime -> UTCTime -> UTCDiffTime
-diffUTCTime a b = utcPicosecondsToUTCTime ((utcTimeToPOSIXPicoseconds a) - (utcTimeToPOSIXPicoseconds b))
+diffUTCTime a b = fromInteger ((utcTimeToPOSIXPicoseconds a) - (utcTimeToPOSIXPicoseconds b))
-- Get current time
More information about the ghc-commits
mailing list