[commit: packages/time] master: correct time-zone handling (066e6ee)

[git at git.haskell.org]

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

On branch  : master
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);