[project @ 2000-06-19 13:28:35 by simonmar]

Time fixes from Michael Weber <michael.weber@post.rwth-aachen.de>:

  * `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?

diff --git a/ghc/lib/std/List.lhs b/ghc/lib/std/List.lhs
index 709687a..08c2ddf 100644 (file)
--- a/ghc/lib/std/List.lhs
+++ b/ghc/lib/std/List.lhs
@@ -266,8 +266,8 @@ partition           :: (a -> Bool) -> [a] -> ([a],[a])
 {-# INLINE partition #-}
 partition p xs = foldr (select p) ([],[]) xs
 
 {-# INLINE partition #-}
 partition p xs = foldr (select p) ([],[]) xs
 

-select p x (ts,fs) | p x       = (x:ts,fs)
-                   | otherwise = (ts, x:fs)
+select p x ~(ts,fs) | p x       = (x:ts,fs)
+                    | otherwise = (ts, x:fs)

 \end{code}
 
 @mapAccumL@ behaves like a combination
 \end{code}
 
 @mapAccumL@ behaves like a combination

@@ -515,3 +515,35 @@ unfoldr f b  =
    Just (a,new_b) -> a : unfoldr f new_b
    Nothing        -> []
 \end{code}
    Just (a,new_b) -> a : unfoldr f new_b
    Nothing        -> []
 \end{code}

+
+#if 0  /* should go in PrelList, but dependency problems */
+foldl' is a strict version of foldl; that is, it doesn't build up a
+huge suspension in its first argument as it traverses the list.  Valid
+when f is strict.
+
+\begin{code}
+foldl'                   :: (a -> b -> a) -> a -> [b] -> a
+foldl' _ z []            =  z
+foldl' f z (x:xs)        =  let a = f z x in seq a (foldl f a xs)
+
+foldl1'                         :: (a -> a -> a) -> [a] -> a
+foldl1'        f (x:xs)         =  foldl' f x xs
+foldl1'        _ []             =  errorEmptyList "foldl1'"
+
+{-# RULES
+"maximumInt"    maximum = maximum' :: [Int]     -> Int
+"maximumInteger" maximum = maximum' :: [Integer] -> Integer
+"minimumInt"     minimum = minimum' :: [Int]     -> Int
+"minimumInteger" minimum = minimum' :: [Integer] -> Integer
+ #-}
+
+{-# SPECIALISE  maximum' :: [Int] -> Int #-}
+{-# SPECIALISE  minimum' :: [Int] -> Int #-}
+
+maximum' []             =  errorEmptyList "maximum'"
+maximum' xs             =  foldl1' max xs
+
+minimum' []             =  errorEmptyList "minimum'"
+minimum' xs             =  foldl1' min xs
+\end{code}
+#endif

diff --git a/ghc/lib/std/Locale.lhs b/ghc/lib/std/Locale.lhs
index 3248c8b..3c3d9d6 100644 (file)
--- a/ghc/lib/std/Locale.lhs
+++ b/ghc/lib/std/Locale.lhs
@@ -5,13 +5,21 @@
 
 
 \begin{code}
 
 
 \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
 
 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     
         amPm   :: (String, String),     -- AM/PM symbols
         dateTimeFmt, dateFmt,           -- formatting strings
         timeFmt, time12Fmt :: String     

@@ -31,6 +39,15 @@ defaultTimeLocale =  TimeLocale {
                   ("September", "Sep"), ("October",   "Oct"),
                   ("November",  "Nov"), ("December",  "Dec")],
 
                   ("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",
         amPm = ("AM", "PM"),
         dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y",
         dateFmt = "%m/%d/%y",

@@ -38,4 +55,14 @@ defaultTimeLocale =  TimeLocale {
         time12Fmt = "%I:%M:%S %p"
         }
 
         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}
 \end{code}

diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs
index a3d9a73..6d2ade9 100644 (file)
--- a/ghc/lib/std/Time.lhs
+++ b/ghc/lib/std/Time.lhs
@@ -1,4 +1,4 @@
-%
+e%

 % (c) The GRASP/AQUA Project, Glasgow University, 1995-99
 %
 \section[Time]{Haskell 1.4 Time of Day Library}
 % (c) The GRASP/AQUA Project, Glasgow University, 1995-99
 %
 \section[Time]{Haskell 1.4 Time of Day Library}

@@ -8,6 +8,61 @@ clock times, including timezone information (i.e, the functionality of
 "time.h",  adapted to the Haskell environment), It follows RFC 1129 in
 its use of Coordinated Universal Time (UTC).
 
 "time.h",  adapted to the Haskell environment), It follows RFC 1129 in
 its use of Coordinated Universal Time (UTC).
 

+2000/06/17 <michael.weber@post.rwth-aachen.de>:
+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 
 \begin{code}
 {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h"  #-}
 module Time 

@@ -23,6 +78,7 @@ module Time
      ,  diffClockTimes
      ,  addToClockTime
 
      ,  diffClockTimes
      ,  addToClockTime
 

+     ,  normalizeTimeDiff -- non-standard

      ,  timeDiffToString  -- non-standard
      ,  formatTimeDiff    -- non-standard
 
      ,  timeDiffToString  -- non-standard
      ,  formatTimeDiff    -- non-standard
 

@@ -255,7 +311,7 @@ addToClockTime (TimeDiff year mon day hour min sec psec)
        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))
        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))
           new_mon  = fromEnum (ctMonth cal) + r_mon 
          (month', yr_diff)
            | new_mon < 0  = (toEnum (12 + new_mon), (-1))

@@ -269,18 +325,51 @@ addToClockTime (TimeDiff year mon day hour min sec psec)
        toClockTime cal{ctMonth=month', ctYear=year'}
 
 diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
        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
   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
   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
 \end{code}
 
 @toCalendarTime@ {\em t} converts {\em t} to a local time, modified by

@@ -354,6 +443,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz is
         )
     where
      isDst = if isdst then (1::Int) else 0
         )
     where
      isDst = if isdst then (1::Int) else 0

+

 #else
 toCalendarTime :: ClockTime -> IO CalendarTime
 toCalendarTime (TOD (S# i) psec) 
 #else
 toCalendarTime :: ClockTime -> IO CalendarTime
 toCalendarTime (TOD (S# i) psec) 

@@ -421,7 +511,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz
     else
         unsafePerformIO ( do
            res <- malloc1
     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
             if rc /= 0
              then do
               i <- cvtUnsigned res

@@ -429,7 +519,12 @@ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz
             else error "Time.toClockTime: can't perform conversion"
         )
     where
             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
 
 
 #endif
 
 

@@ -468,7 +563,9 @@ formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
 formatCalendarTime l fmt (CalendarTime year mon day hour min sec _
                                        wday yday tzname _ _) =
         doFmt fmt
 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 "" = ""
 
         doFmt (c:cs) = c : doFmt cs
         doFmt "" = ""
 

@@ -539,10 +636,12 @@ timeDiffToString :: TimeDiff -> String
 timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
 
 formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
 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 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
 
    doFmt ('%':c:cs) = decode c ++ doFmt cs
    doFmt (c:cs)     = c : doFmt cs
 

@@ -551,6 +650,7 @@ formatTimeDiff l fmt (TimeDiff year month day hour min sec _)
       'B' -> fst (months l !! fromEnum month)
       'b' -> snd (months l !! fromEnum month)
       'h' -> snd (months l !! fromEnum month)
       '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
       'C' -> show2 (year `quot` 100)
       'D' -> doFmt "%m/%d/%y"
       'd' -> show2 day

@@ -576,6 +676,17 @@ formatTimeDiff l fmt (TimeDiff year month day hour min sec _)
       '%' -> "%"
       c   -> [c]
 
       '%' -> "%"
       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}
 \end{code}
 
 \begin{code}

@@ -619,7 +730,7 @@ foreign import "libHS_cbits" "GMTOFF"    unsafe get_GMTOFF :: MBytes -> IO Int
 
 foreign import "libHS_cbits" "toClockSec" unsafe 
             toClockSec   :: Int -> Int -> Int -> Int -> Int 
 
 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
 
 foreign import "libHS_cbits" "getClockTime"  unsafe 
            primGetClockTime :: MutableByteArray RealWorld Int

diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h
index c551226..6530eee 100644 (file)
--- a/ghc/lib/std/cbits/stgio.h
+++ b/ghc/lib/std/cbits/stgio.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------

- * $Id: stgio.h,v 1.21 2000/05/28 17:47:27 panne Exp $
+ * $Id: stgio.h,v 1.22 2000/06/19 13:28:35 simonmar Exp $

  *
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1999
  *
  *
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1999
  *

@@ -224,7 +224,7 @@ StgInt toUTCTime (StgInt, StgByteArray, StgByteArray);
 StgInt prim_toUTCTime ( StgInt64,StgByteArray );
 
 /* toClockSec.c */
 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);
 
 /* writeError.c */
 StgAddr addrOf_ErrorHdrHook(void);

diff --git a/ghc/lib/std/cbits/toClockSec.c b/ghc/lib/std/cbits/toClockSec.c
index b461fba..57b4830 100644 (file)
--- a/ghc/lib/std/cbits/toClockSec.c
+++ b/ghc/lib/std/cbits/toClockSec.c
@@ -1,7 +1,7 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *

- * $Id: toClockSec.c,v 1.5 1999/11/26 16:25:56 simonmar Exp $
+ * $Id: toClockSec.c,v 1.6 2000/06/19 13:28:35 simonmar Exp $

  *
  * toClockSec Runtime Support
  */
  *
  * toClockSec Runtime Support
  */

@@ -11,7 +11,7 @@
 #include "timezone.h"
 
 StgInt
 #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;
 {
     struct tm tm;
     time_t t;

@@ -33,7 +33,18 @@ toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ isdst, StgByteA
 #endif
     if (t == (time_t) -1)
        return 0;
 #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;
 }
     return 1;
 }