[commit: packages/time] master: add DST field to Timezone (471f5ea)
git at git.haskell.org
git at git.haskell.org
Fri Jan 23 22:53:30 UTC 2015
Repository : ssh://git@git.haskell.org/time
On branch : master
Link : http://git.haskell.org/packages/time.git/commitdiff/471f5ea9c67160d9740c63e6aab87a9b72c72747
>---------------------------------------------------------------
commit 471f5ea9c67160d9740c63e6aab87a9b72c72747
Author: Ashley Yakeley <ashley at semantic.org>
Date: Sun May 1 02:05:11 2005 -0700
add DST field to Timezone
darcs-hash:20050501090511-ac6dd-7dfe69ea72cee8b3fe4bd070dd0a1065fdd30280
>---------------------------------------------------------------
471f5ea9c67160d9740c63e6aab87a9b72c72747
System/Time/Calendar/TimeOfDay.hs | 4 ++--
System/Time/Calendar/Timezone.hs | 24 ++++++++++++++----------
TestFormat.hs | 6 +++---
timestuff.c | 5 ++++-
timestuff.h | 2 +-
5 files changed, 24 insertions(+), 17 deletions(-)
diff --git a/System/Time/Calendar/TimeOfDay.hs b/System/Time/Calendar/TimeOfDay.hs
index d71c334..17cdc93 100644
--- a/System/Time/Calendar/TimeOfDay.hs
+++ b/System/Time/Calendar/TimeOfDay.hs
@@ -46,12 +46,12 @@ instance FormatTime TimeOfDay where
-- | convert a ToD in UTC to a ToD in some timezone, together with a day adjustment
utcToLocalTimeOfDay :: Timezone -> TimeOfDay -> (Integer,TimeOfDay)
utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where
- m' = m + timezoneToMinutes zone
+ m' = m + timezoneMinutes zone
h' = h + (div m' 60)
-- | convert a ToD in some timezone to a ToD in UTC, together with a day adjustment
localToUTCTimeOfDay :: Timezone -> TimeOfDay -> (Integer,TimeOfDay)
-localToUTCTimeOfDay zone = utcToLocalTimeOfDay (minutesToTimezone (negate (timezoneToMinutes zone)))
+localToUTCTimeOfDay zone = utcToLocalTimeOfDay (minutesToTimezone (negate (timezoneMinutes zone)))
posixDay :: DiffTime
posixDay = fromInteger 86400
diff --git a/System/Time/Calendar/Timezone.hs b/System/Time/Calendar/Timezone.hs
index acfcad0..87defcd 100644
--- a/System/Time/Calendar/Timezone.hs
+++ b/System/Time/Calendar/Timezone.hs
@@ -3,7 +3,7 @@
module System.Time.Calendar.Timezone
(
-- time zones
- Timezone,timezoneToMinutes,minutesToTimezone,hoursToTimezone,utc,
+ Timezone(..),minutesToTimezone,hoursToTimezone,utc,
-- getting the locale time zone
getTimezone,getCurrentTimezone
@@ -17,12 +17,13 @@ import Foreign
import Foreign.C
-- | count of minutes
-newtype Timezone = MkTimezone {
- timezoneToMinutes :: Int
+data Timezone = MkTimezone {
+ timezoneDST :: Bool,
+ timezoneMinutes :: Int
} deriving (Eq,Ord)
minutesToTimezone :: Int -> Timezone
-minutesToTimezone = MkTimezone
+minutesToTimezone = MkTimezone False
hoursToTimezone :: Int -> Timezone
hoursToTimezone i = minutesToTimezone (60 * i)
@@ -31,8 +32,8 @@ showT :: Int -> String
showT t = (show2 (div t 60)) ++ (show2 (mod t 60))
instance Show Timezone where
- show (MkTimezone t) | t < 0 = '-':(showT (negate t))
- show (MkTimezone t) = '+':(showT t)
+ show (MkTimezone _ t) | t < 0 = '-':(showT (negate t))
+ show (MkTimezone _ t) = '+':(showT t)
instance FormatTime Timezone where
formatCharacter _ 'z' zone = Just (show zone)
@@ -42,18 +43,21 @@ instance FormatTime Timezone where
utc :: Timezone
utc = minutesToTimezone 0
-foreign import ccall unsafe "timestuff.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> IO CLong
+foreign import ccall unsafe "timestuff.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> Ptr CInt -> IO CLong
posixToCTime :: POSIXTime -> CTime
posixToCTime = fromInteger . 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))
+getTimezone time = with 0 (\pdst -> do
+ secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time)) pdst
case secs of
0x80000000 -> fail "localtime_r failed"
- _ -> return (minutesToTimezone (div (fromIntegral secs) 60))
+ _ -> do
+ dst <- peek pdst
+ return (MkTimezone (dst == 1) (div (fromIntegral secs) 60))
+ )
-- | Get the current time-zone
getCurrentTimezone :: IO Timezone
diff --git a/TestFormat.hs b/TestFormat.hs
index 6675884..4d7f800 100644
--- a/TestFormat.hs
+++ b/TestFormat.hs
@@ -26,11 +26,11 @@ withBuffer n f = withArray (replicate n 0) (\buffer -> do
unixFormatTime :: String -> Timezone -> UTCTime -> IO String
unixFormatTime fmt zone time = withCString fmt (\pfmt ->
- withBuffer 100 (\buffer -> format_time buffer 100 pfmt 0 (fromIntegral (timezoneToMinutes zone * 60)) (fromInteger (truncate (utcTimeToPOSIXSeconds time))))
+ withBuffer 100 (\buffer -> format_time buffer 100 pfmt (if timezoneDST zone then 1 else 0) (fromIntegral (timezoneMinutes zone * 60)) (fromInteger (truncate (utcTimeToPOSIXSeconds time))))
)
locale :: TimeLocale
-locale = defaultTimeLocale
+locale = defaultTimeLocale {dateTimeFmt = "%a %b %e %H:%M:%S %Y"}
zones :: [Timezone]
zones = [utc,hoursToTimezone (- 7)]
@@ -46,7 +46,7 @@ times = [baseTime1,addUTCTime posixDay baseTime1,addUTCTime (2 * posixDay) baseT
-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
chars :: [Char]
-chars = "aAbBcCdDehHIjmMnprRStTuUVwWxXyYZ%"
+chars = "aAbBcCdDehHIjmMnprRStTuUVwWxXyYzZ%"
main :: IO ()
main = mapM_ (\char -> let fmt = '%':char:[] in mapM_ (\time -> mapM_ (\zone -> let
diff --git a/timestuff.c b/timestuff.c
index 92d9fbe..6968a9d 100644
--- a/timestuff.c
+++ b/timestuff.c
@@ -1,10 +1,13 @@
#include "timestuff.h"
-long int get_current_timezone_seconds (time_t t)
+long int get_current_timezone_seconds (time_t t,int* dst)
{
struct tm tmd;
struct tm* ptm = localtime_r(&t,&tmd);
if (ptm)
+ {
+ *dst = ptm -> tm_isdst;
return ptm -> tm_gmtoff;
+ }
else return 0x80000000;
}
diff --git a/timestuff.h b/timestuff.h
index 534ee67..6eaf614 100644
--- a/timestuff.h
+++ b/timestuff.h
@@ -1,3 +1,3 @@
#include <time.h>
-long int get_current_timezone_seconds (time_t);
+long int get_current_timezone_seconds (time_t,int* dst);
More information about the ghc-commits
mailing list