[commit: packages/time] master, wip/travis: correct time-zone handling (066e6ee)
git at git.haskell.org
git at git.haskell.org
Sat May 7 06:40:04 UTC 2016
Repository : ssh://git@git.haskell.org/time
On branches: master,wip/travis
Link : http://git.haskell.org/packages/time.git/commitdiff/066e6ee153ebb020a34f27a23c0db05f433fc5ef
>---------------------------------------------------------------
commit 066e6ee153ebb020a34f27a23c0db05f433fc5ef
Author: Ashley Yakeley <ashley at semantic.org>
Date: Wed Apr 27 01:47:46 2005 -0700
correct time-zone handling
darcs-hash:20050427084746-ac6dd-6fe841a9a26be8954affc8cc42e5f080e4b355a2
>---------------------------------------------------------------
066e6ee153ebb020a34f27a23c0db05f433fc5ef
CurrentTime.hs | 2 +-
System/Time/Calendar.hs | 17 ++++++++++++-----
System/Time/Clock.hs | 35 ++++++++++++++++++++++++-----------
TimeLib.cabal | 1 -
timestuff.c | 5 ++---
timestuff.h | 4 +++-
6 files changed, 42 insertions(+), 22 deletions(-)
diff --git a/CurrentTime.hs b/CurrentTime.hs
index 770699d..62c88e5 100644
--- a/CurrentTime.hs
+++ b/CurrentTime.hs
@@ -10,5 +10,5 @@ main = do
putStrLn (show (utctDay now) ++ "," ++ show (utctDayTime now))
putStrLn (show (utcToCalendar utc now))
myzone <- getCurrentTimezone
- putStrLn ("timezone minutes: " ++ show (timezoneToMinutes myzone))
+ putStrLn ("timezone: " ++ show myzone)
putStrLn (show (utcToCalendar myzone now))
diff --git a/System/Time/Calendar.hs b/System/Time/Calendar.hs
index ca10a6e..58f38a3 100644
--- a/System/Time/Calendar.hs
+++ b/System/Time/Calendar.hs
@@ -52,16 +52,23 @@ instance Show TimeZone where
utc :: TimeZone
utc = minutesToTimezone 0
-foreign import ccall unsafe "timestuff.h get_current_timezone_seconds" get_current_timezone_seconds :: IO CLong
+foreign import ccall unsafe "timestuff.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> IO CLong
--- | Get the current time-zone
-getCurrentTimezone :: IO TimeZone
-getCurrentTimezone = do
- secs <- get_current_timezone_seconds
+posixToCTime :: POSIXTime -> CTime
+posixToCTime = floor
+
+-- | Get the local time-zone for a given time (varying as per summertime adjustments)
+getTimezone :: UTCTime -> IO TimeZone
+getTimezone time = do
+ secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time))
case secs of
0x80000000 -> fail "localtime_r failed"
_ -> return (minutesToTimezone (div (fromIntegral secs) 60))
+-- | Get the current time-zone
+getCurrentTimezone :: IO TimeZone
+getCurrentTimezone = getCurrentTime >>= getTimezone
+
-- | time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day
data TimeOfDay = TimeOfDay {
todHour :: Int,
diff --git a/System/Time/Clock.hs b/System/Time/Clock.hs
index 44192b5..2683841 100644
--- a/System/Time/Clock.hs
+++ b/System/Time/Clock.hs
@@ -13,7 +13,10 @@ module System.Time.Clock
addUTCTime,diffUTCTime,
-- getting the current UTC time
- getCurrentTime
+ getCurrentTime,
+
+ -- needed by System.Time.Calendar to talk to the Unix API
+ POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds
) where
import Data.Fixed
@@ -107,36 +110,46 @@ instance Fractional UTCDiffTime where
recip (MkUTCDiffTime a) = MkUTCDiffTime (recip a)
fromRational r = MkUTCDiffTime (fromRational r)
-posixDaySeconds :: Pico
-posixDaySeconds = 86400
+-- necessary because H98 doesn't have "cunning newtype" derivation
+instance RealFrac UTCDiffTime where
+ properFraction (MkUTCDiffTime a) = (i,MkUTCDiffTime f) where
+ (i,f) = properFraction a
+ truncate (MkUTCDiffTime a) = truncate a
+ round (MkUTCDiffTime a) = round a
+ ceiling (MkUTCDiffTime a) = ceiling a
+ floor (MkUTCDiffTime a) = floor a
+
+posixDay :: UTCDiffTime
+posixDay = 86400
unixEpochMJD :: ModJulianDay
unixEpochMJD = 40587
+type POSIXTime = UTCDiffTime
-posixSecondsToUTCTime :: Pico -> UTCTime
+posixSecondsToUTCTime :: POSIXTime -> UTCTime
posixSecondsToUTCTime i = let
- (d,t) = divMod' i posixDaySeconds
+ (d,t) = divMod' i posixDay
in UTCTime (d + unixEpochMJD) (realToFrac t)
-utcTimeToPOSIXSeconds :: UTCTime -> Pico
+utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime d t) =
- (fromInteger (d - unixEpochMJD) * posixDaySeconds) + min posixDaySeconds (realToFrac t)
+ (fromInteger (d - unixEpochMJD) * posixDay) + min posixDay (realToFrac t)
addUTCTime :: UTCDiffTime -> UTCTime -> UTCTime
-addUTCTime x t = posixSecondsToUTCTime ((realToFrac x) + (utcTimeToPOSIXSeconds t))
+addUTCTime x t = posixSecondsToUTCTime (x + (utcTimeToPOSIXSeconds t))
diffUTCTime :: UTCTime -> UTCTime -> UTCDiffTime
-diffUTCTime a b = realToFrac ((utcTimeToPOSIXSeconds a) - (utcTimeToPOSIXSeconds b))
+diffUTCTime a b = (utcTimeToPOSIXSeconds a) - (utcTimeToPOSIXSeconds b)
-- Get current time
data CTimeval = MkCTimeval CLong CLong
-ctimevalToPosixSeconds :: CTimeval -> Pico
-ctimevalToPosixSeconds (MkCTimeval s mus) = ((fromIntegral s) + (fromIntegral mus) / 1000000)
+ctimevalToPosixSeconds :: CTimeval -> POSIXTime
+ctimevalToPosixSeconds (MkCTimeval s mus) = (fromIntegral s) + (fromIntegral mus) / 1000000
instance Storable CTimeval where
sizeOf _ = (sizeOf (undefined :: CLong)) * 2
diff --git a/TimeLib.cabal b/TimeLib.cabal
index d7a8089..f609ac4 100644
--- a/TimeLib.cabal
+++ b/TimeLib.cabal
@@ -12,4 +12,3 @@ Synopsis: a new time library
Exposed-modules: Data.Fixed, System.Time.Clock, System.Time.TAI, System.Time.Calendar
Extensions: ForeignFunctionInterface
C-Sources: timestuff.c
-
diff --git a/timestuff.c b/timestuff.c
index 24c6983..92d9fbe 100644
--- a/timestuff.c
+++ b/timestuff.c
@@ -1,8 +1,7 @@
-#include <time.h>
+#include "timestuff.h"
-long int get_current_timezone_seconds ()
+long int get_current_timezone_seconds (time_t t)
{
- time_t t = 0;
struct tm tmd;
struct tm* ptm = localtime_r(&t,&tmd);
if (ptm)
diff --git a/timestuff.h b/timestuff.h
index f58c0f1..534ee67 100644
--- a/timestuff.h
+++ b/timestuff.h
@@ -1 +1,3 @@
-long int get_current_timezone_seconds ();
+#include <time.h>
+
+long int get_current_timezone_seconds (time_t);
More information about the ghc-commits
mailing list