Hi all!
I took a look (or maybe some more) at the well-known, totally buggy
Time module...
I think, I sorted out the main problems and fixed them:
* toClockTime couldn't deal properly with anything but local
TZ-encoded CalendarTime's (i.e. not with UTC-encoded CT's for
example)
* as a result, addToClockTime did weird things
* diffClockTimes, in some situations, gave strange results, i.e. "1
day, -22 hours" instead of "2 hours"
* timeDiffToString always returned "c", regardless of its parameters
[this one was really hard to find ;-)]
For the tedious details, refer to the comments in the patch for
[Time.lhs,Locale.lhs,toClockSec.c]. There's also a BUGS/TODO list with
some open issues... comments welcome!
I tested on Linux, so if someone could try the patch on a Solaris
version of GHC, it would be of greater help.
Besides normal testing and debugging, I recompiled the time001 test
and it still produced the same output, which made me wonder. So I
recompiled it with the old (broken) version of Time and tested again.
Result: running the old time001 like (Bashism ahead)
$ env TZ=<foo> ./time001
and <foo> `elem` [CET,EST,PST8,PST8PDT,...] yields different results,
which is clearly wrong, since we're using UTC encoding. Did somebody
ever try to run time001 with a TZ /= UTC or friends? :-)
Anyway, the modified version always yields the same result, regardless
of the TZ setting, which is IMHO The Right Behaviour(tm)...
Oh, BTW: 2 remarks
1) *ahem* Hereby I state, that I really doubt, that anyone has been
using the Time-module for longer than a couple of compilation
runs, ever... ;-)
2) Does anybody know a mail address of the inventor(s) of the Unix
Time Handling Functions (K&R, maybe?)? I'd like to "thank" them for
this great stuff... I thought about a source+binary release of
ghc-4.07, tar'ed, uuencoded and piped through hexdump, and of
course, split into 1k-pieces, just to be sure, it gets through...
>:-)
Cheers,
Michael
--
() ASCII ribbon campaign | Chair for Computer Science II | GPG: F65C68CD
/\ against HTML mail | RWTH Aachen, Germany | PGP: 1D0DD0B9
Ninety percent of the time things will turn out worse than you expect.
The other 10 percent of the time you had no right to expect so much.
diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/Locale.lhs
ghc4-4.07.20000615/ghc/lib/std/Locale.lhs
--- ghc4-4.07.20000615.orig/ghc/lib/std/Locale.lhs Thu Jan 14 19:12:51 1999
+++ ghc4-4.07.20000615/ghc/lib/std/Locale.lhs Sat Jun 17 13:49:35 2000
@@ -5,13 +5,21 @@
\begin{code}
-module Locale(TimeLocale(..), defaultTimeLocale) where
+module Locale
+ ( TimeLocale(..)
+ , defaultTimeLocale
+
+ , iso8601DateFormat
+ , rfc822DateFormat
+ )
+where
import Prelude -- so as to force recompilations when reqd.
data TimeLocale = TimeLocale {
wDays :: [(String, String)], -- full and abbreviated week days
months :: [(String, String)], -- full and abbreviated months
+ intervals :: [(String, String)],
amPm :: (String, String), -- AM/PM symbols
dateTimeFmt, dateFmt, -- formatting strings
timeFmt, time12Fmt :: String
@@ -31,6 +39,15 @@
("September", "Sep"), ("October", "Oct"),
("November", "Nov"), ("December", "Dec")],
+ intervals = [ ("year","years")
+ , ("month", "months")
+ , ("day","days")
+ , ("hour","hours")
+ , ("min","mins")
+ , ("sec","secs")
+ , ("usec","usecs")
+ ],
+
amPm = ("AM", "PM"),
dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y",
dateFmt = "%m/%d/%y",
@@ -38,4 +55,14 @@
time12Fmt = "%I:%M:%S %p"
}
+
+iso8601DateFormat :: Maybe String -> String
+iso8601DateFormat timeFmt =
+ "%Y-%m-%d" ++ case timeFmt of
+ Nothing -> "" -- normally, ISO-8601 just defines YYYY-MM-DD
+ Just fmt -> ' ' : fmt -- but we can add a time spec
+
+
+rfc822DateFormat :: String
+rfc822DateFormat = "%a, %_d %b %Y %H:%M:%S %Z"
\end{code}
diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/Time.lhs
ghc4-4.07.20000615/ghc/lib/std/Time.lhs
--- ghc4-4.07.20000615.orig/ghc/lib/std/Time.lhs Thu May 4 19:03:16 2000
+++ ghc4-4.07.20000615/ghc/lib/std/Time.lhs Sat Jun 17 16:23:19 2000
@@ -8,6 +8,109 @@
"time.h", adapted to the Haskell environment), It follows RFC 1129 in
its use of Coordinated Universal Time (UTC).
+CHANGES:
+2000/06/17 <[EMAIL PROTECTED]>:
+ * `toClockTime' previously didn't honor the `tz' field of a
+ `CalendarTime', which led to time warping when applying
+
+ => (toUTCTime (toClockTime ... (toUTCTime (toClockTime someTime) ... )))
+
+ continuously.
+
+ Now it accepts at least <local>- and UTC-encoded `CalendarTime's
+ (TODO: test, whether all timezones work) and converts them
+ correctly to <secs from epoch>-format (which is always UTC, as one
+ might have guessed).
+
+ * `addToClockTime' now works.
+
+ Previously, `tz' seconds were added(!) when used like:
+
+ => addToClockTime noTimeDiff someTime
+
+ which is clearly wrong.
+ Now, the following (hopefully) always holds
+
+ => someTime == (addToClockTime noTimeDiff someTime)
+
+ * `diffClockTimes' works correctly, and is the dual to
+ `addToClockTime', i.e.
+
+ => diff == ((addToClockTime diff someTime) `diffClockTimes` someTime)
+
+ should now hold for all diff, someTime
+
+ Previously, it reports ugly diffs at {min,hour,day,...}-breaks,
+ for example:
+
+ => "2000/06/18 01:00 UTC"
+ `diffClockTimes` "2000/06/17 23:00 UTC" == 1 day, -22 hours
+
+ whereas now it emits "7200 secs". This number can be converted
+ with `normalizeTimeDiff' to "2 hours".
+
+ * added `normalizeTimeDiff', which calculates year, month, days,
+ etc. out of an unnormalized `TimeDiff' (generated by
+ `diffClockTimes', for example)
+
+ * `formatTimeDiff': added the missing "%c" case. The
+ format is proprietary, though... Is there a nicer one?
+
+
+RESTRICTIONS:
+ * min./max. time diff currently is restricted to
+ [minBound::Int, maxBound::Int]
+
+ * surely other restrictions wrt. min/max bounds
+
+
+NOTES:
+ * printing times
+
+ `showTime' (used in `instance Show ClockTime') always prints time
+ converted to the local timezone (even if it is taken from
+ `(toClockTime . toUTCTime)'), whereas `calendarTimeToString'
+ honors the tzone & tz fields and prints UTC or whatever timezone
+ is stored inside CalendarTime.
+
+ Maybe `showTime' should be changed to use UTC, since it would
+ better correspond to the actual representation of `ClockTime'
+ (can be done by replacing localtime(3) by gmtime(3)).
+
+
+BUGS:
+ * obvious bugs now should be fixed, but there are surely more (and
+ less obvious one's) lurking around :-}
+
+ * gettimeofday(2) returns secs and _microsecs_, not pico-secs!
+ this should be changed accordingly (also means updating the H98
+ report)
+
+ * add proper handling of microsecs, currently, they're mostly
+ ignored
+
+ * `formatFOO' case of `%s' is currently broken...
+
+
+TODO:
+ * check for unusual date cases, like 1970/1/1 00:00h, and conversions
+ between different timezone's etc.
+
+ * check, what needs to be in the IO monad, the current situation
+ seems to be a bit inconsistent to me
+
+ * sync #ifdef'ed __HUGS__ parts with current changes (only few)
+
+ * check whether `isDst = -1' works as expected on other arch's
+ (Solaris anyone?)
+
+ * add functions to parse strings to `CalendarTime' (some day...)
+
+ * implement padding capabilities ("%_", "%-") in `formatFOO'
+
+ * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO'
+
+
\begin{code}
{-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h" #-}
module Time
@@ -23,6 +126,7 @@
, diffClockTimes
, addToClockTime
+ , normalizeTimeDiff -- non-standard
, timeDiffToString -- non-standard
, formatTimeDiff -- non-standard
@@ -255,7 +359,7 @@
let
sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600
* fromInt day
cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec))
-
+ -- FIXME! ^^^^
new_mon = fromEnum (ctMonth cal) + r_mon
(month', yr_diff)
| new_mon < 0 = (toEnum (12 + new_mon), (-1))
@@ -269,18 +373,51 @@
toClockTime cal{ctMonth=month', ctYear=year'}
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
-diffClockTimes tod_a tod_b =
+-- diffClockTimes is meant to be the dual to `addToClockTime'.
+-- If you want to have the TimeDiff properly splitted, use
+-- `normalizeTimeDiff' on this function's result
+--
+-- CAVEAT: see comment of normalizeTimeDiff
+diffClockTimes (TOD sa pa) (TOD sb pb) =
+ noTimeDiff{ tdSec = fromIntegral (sa - sb)
+ -- FIXME: can handle just 68 years...
+ , tdPicosec = pa - pb
+ }
+
+
+normalizeTimeDiff :: TimeDiff -> TimeDiff
+-- FIXME: handle psecs properly
+-- FIXME: ?should be called by formatTimeDiff automagically?
+--
+-- when applied to something coming out of `diffClockTimes', you loose
+-- the duality to `addToClockTime', since a year does not always have
+-- 365 days, etc.
+--
+-- apply this function as late as possible to prevent those "rounding"
+-- errors
+normalizeTimeDiff td =
let
- CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toUTCTime
tod_a
- CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toUTCTime
tod_b
+ rest0 = tdSec td
+ + 60 * (tdMin td
+ + 60 * (tdHour td
+ + 24 * (tdDay td
+ + 30 * (tdMonth td
+ + 365 * tdYear td))))
+
+ (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600)
+ (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600)
+ (diffDays, rest3) = rest2 `quotRem` (24 * 3600)
+ (diffHours, rest4) = rest3 `quotRem` 3600
+ (diffMins, diffSecs) = rest4 `quotRem` 60
in
- TimeDiff (year_a - year_b)
- (fromEnum mon_a - fromEnum mon_b)
- (day_a - day_b)
- (hour_a - hour_b)
- (min_a - min_b)
- (sec_a - sec_b)
- (psec_a - psec_b)
+ td{ tdYear = diffYears
+ , tdMonth = diffMonths
+ , tdDay = diffDays
+ , tdHour = diffHours
+ , tdMin = diffMins
+ , tdSec = diffSecs
+ }
+
\end{code}
@toCalendarTime@ {\em t} converts {\em t} to a local time, modified by
@@ -354,6 +491,7 @@
)
where
isDst = if isdst then (1::Int) else 0
+
#else
toCalendarTime :: ClockTime -> IO CalendarTime
toCalendarTime (TOD (S# i) psec)
@@ -421,7 +559,7 @@
else
unsafePerformIO ( do
res <- malloc1
- rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res
+ rc <- toClockSec year (fromEnum mon) mday hour min sec tz isDst res
if rc /= 0
then do
i <- cvtUnsigned res
@@ -429,7 +567,12 @@
else error "Time.toClockTime: can't perform conversion"
)
where
- isDst = if isdst then (1::Int) else 0
+ -- `isDst' causes the date to be wrong by one hour...
+ -- FIXME: check, whether this works on other arch's than Linux, too...
+ --
+ -- so we set it to (-1) (means `unknown') and let `mktime' determine
+ -- the real value...
+ isDst = -1 -- if isdst then (1::Int) else 0
#endif
@@ -468,7 +611,9 @@
formatCalendarTime l fmt (CalendarTime year mon day hour min sec _
wday yday tzname _ _) =
doFmt fmt
- where doFmt ('%':c:cs) = decode c ++ doFmt cs
+ where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
+ doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
+ doFmt ('%':c:cs) = decode c ++ doFmt cs
doFmt (c:cs) = c : doFmt cs
doFmt "" = ""
@@ -539,10 +684,12 @@
timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
-formatTimeDiff l fmt (TimeDiff year month day hour min sec _)
+formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _)
= doFmt fmt
where
doFmt "" = ""
+ doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
+ doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
doFmt ('%':c:cs) = decode c ++ doFmt cs
doFmt (c:cs) = c : doFmt cs
@@ -551,6 +698,7 @@
'B' -> fst (months l !! fromEnum month)
'b' -> snd (months l !! fromEnum month)
'h' -> snd (months l !! fromEnum month)
+ 'c' -> defaultTimeDiffFmt td
'C' -> show2 (year `quot` 100)
'D' -> doFmt "%m/%d/%y"
'd' -> show2 day
@@ -576,6 +724,17 @@
'%' -> "%"
c -> [c]
+ defaultTimeDiffFmt (TimeDiff year month day hour min sec _) =
+ foldr (\ (v,s) rest ->
+ (if v /= 0
+ then show v ++ ' ':(addS v s)
+ ++ if null rest then "" else ", "
+ else "") ++ rest
+ )
+ ""
+ (zip [year, month, day, hour, min, sec] (intervals l))
+
+ addS v s = if abs v == 1 then fst s else snd s
\end{code}
\begin{code}
@@ -619,7 +778,7 @@
foreign import "libHS_cbits" "toClockSec" unsafe
toClockSec :: Int -> Int -> Int -> Int -> Int
- -> Int -> Int -> MBytes -> IO Int
+ -> Int -> Int -> Int -> MBytes -> IO Int
foreign import "libHS_cbits" "getClockTime" unsafe
primGetClockTime :: MutableByteArray RealWorld Int
diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/cbits/stgio.h
ghc4-4.07.20000615/ghc/lib/std/cbits/stgio.h
--- ghc4-4.07.20000615.orig/ghc/lib/std/cbits/stgio.h Thu Jun 15 20:54:27 2000
+++ ghc4-4.07.20000615/ghc/lib/std/cbits/stgio.h Sat Jun 17 01:49:54 2000
@@ -224,7 +224,7 @@
StgInt prim_toUTCTime ( StgInt64,StgByteArray );
/* toClockSec.c */
-StgInt toClockSec (StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt,
StgByteArray);
+StgInt toClockSec (StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt,
+StgByteArray);
/* writeError.c */
StgAddr addrOf_ErrorHdrHook(void);
diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/cbits/toClockSec.c
ghc4-4.07.20000615/ghc/lib/std/cbits/toClockSec.c
--- ghc4-4.07.20000615.orig/ghc/lib/std/cbits/toClockSec.c Mon Dec 6 22:34:02
1999
+++ ghc4-4.07.20000615/ghc/lib/std/cbits/toClockSec.c Sat Jun 17 13:09:36 2000
@@ -11,7 +11,7 @@
#include "timezone.h"
StgInt
-toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ isdst, StgByteArray
res)
+toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ tz, I_ isdst,
+StgByteArray res)
{
struct tm tm;
time_t t;
@@ -33,7 +33,18 @@
#endif
if (t == (time_t) -1)
return 0;
-
- *(time_t *)res = t;
+ /*
+ * mktime expects its argument to be in the local timezone, but
+ * toUTCTime makes UTC-encoded CalendarTime's ...
+ *
+ * Since there is no any_tz_struct_tm-to-time_t conversion
+ * function, we have to fake one... :-) If not in all, it works in
+ * most cases (before, it was the other way round...)
+ *
+ * Luckily, mktime tells us, what it *thinks* the timezone is, so,
+ * to compensate, we add the timezone difference to mktime's
+ * result.
+ */
+ *(time_t *)res = t + tz - GMTOFF(&tm);
return 1;
}
