ghc/lib/std/Time.lhs

   1 e%
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-99
   3 %
   4 \section[Time]{Haskell 1.4 Time of Day Library}
   5
   6 The {\em Time} library provides standard functionality for
   7 clock times, including timezone information (i.e, the functionality of
   8 "time.h",  adapted to the Haskell environment), It follows RFC 1129 in
   9 its use of Coordinated Universal Time (UTC).
  10
  11 2000/06/17 <michael.weber@post.rwth-aachen.de>:
  12 RESTRICTIONS:
  13   * min./max. time diff currently is restricted to
  14     [minBound::Int, maxBound::Int]
  15
  16   * surely other restrictions wrt. min/max bounds
  17
  18
  19 NOTES:
  20   * printing times
  21
  22     `showTime' (used in `instance Show ClockTime') always prints time
  23     converted to the local timezone (even if it is taken from
  24     `(toClockTime . toUTCTime)'), whereas `calendarTimeToString'
  25     honors the tzone & tz fields and prints UTC or whatever timezone
  26     is stored inside CalendarTime.
  27
  28     Maybe `showTime' should be changed to use UTC, since it would
  29     better correspond to the actual representation of `ClockTime'
  30     (can be done by replacing localtime(3) by gmtime(3)).
  31
  32
  33 BUGS:
  34   * obvious bugs now should be fixed, but there are surely more (and
  35     less obvious one's) lurking around :-}
  36
  37   * gettimeofday(2) returns secs and _microsecs_, not pico-secs!
  38     this should be changed accordingly (also means updating the H98
  39     report)
  40
  41   * add proper handling of microsecs, currently, they're mostly
  42     ignored
  43
  44   * `formatFOO' case of `%s' is currently broken...
  45
  46
  47 TODO:
  48   * check for unusual date cases, like 1970/1/1 00:00h, and conversions
  49     between different timezone's etc.
  50
  51   * check, what needs to be in the IO monad, the current situation
  52     seems to be a bit inconsistent to me
  53
  54   * sync #ifdef'ed __HUGS__ parts with current changes (only few)
  55
  56   * check whether `isDst = -1' works as expected on other arch's
  57     (Solaris anyone?)
  58
  59   * add functions to parse strings to `CalendarTime' (some day...)
  60
  61   * implement padding capabilities ("%_", "%-") in `formatFOO'
  62
  63   * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO'
  64
  65
  66 \begin{code}
  67 {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h"  #-}
  68 module Time
  69      (
  70         Month(..)
  71      ,  Day(..)
  72
  73      ,  ClockTime(..) -- non-standard, lib. report gives this as abstract
  74      ,  getClockTime
  75
  76      ,  TimeDiff(..)
  77      ,  noTimeDiff      -- non-standard (but useful when constructing TimeDiff vals.)
  78      ,  diffClockTimes
  79      ,  addToClockTime
  80
  81      ,  normalizeTimeDiff -- non-standard
  82      ,  timeDiffToString  -- non-standard
  83      ,  formatTimeDiff    -- non-standard
  84
  85      ,  CalendarTime(..)
  86      ,  toCalendarTime
  87      ,  toUTCTime
  88      ,  toClockTime
  89      ,  calendarTimeToString
  90      ,  formatCalendarTime
  91
  92      ) where
  93
  94 #ifdef __HUGS__
  95 import PreludeBuiltin
  96 #else
  97 import PrelGHC          ( RealWorld, (>#), (<#), (==#),
  98                           newIntArray#, readIntArray#,
  99                           unsafeFreezeByteArray#,
 100                           int2Integer#, negateInt# )
 101 import PrelBase         ( Int(..) )
 102 import PrelNum          ( Integer(..), fromInt )
 103 import PrelIOBase       ( IO(..), unsafePerformIO, stToIO, constructErrorAndFail )
 104 import PrelShow         ( showList__ )
 105 import PrelPack         ( unpackCString, unpackCStringBA,
 106                           new_ps_array, freeze_ps_array
 107                         )
 108 import PrelByteArr      ( MutableByteArray(..) )
 109 import PrelHandle       ( Bytes )
 110 import PrelAddr         ( Addr )
 111
 112 #endif
 113
 114 import Ix
 115 import Char             ( intToDigit )
 116 import Locale
 117
 118 \end{code}
 119
 120 One way to partition and give name to chunks of a year and a week:
 121
 122 \begin{code}
 123 data Month
 124  = January   | February | March    | April
 125  | May       | June     | July     | August
 126  | September | October  | November | December
 127  deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
 128
 129 data Day
 130  = Sunday   | Monday | Tuesday | Wednesday
 131  | Thursday | Friday | Saturday
 132  deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
 133
 134 \end{code}
 135
 136 @ClockTime@ is an abstract type, used for the internal clock time.
 137 Clock times may be compared, converted to strings, or converted to an
 138 external calendar time @CalendarTime@.
 139
 140 \begin{code}
 141 #ifdef __HUGS__
 142 -- I believe Int64 is more than big enough.
 143 -- In fact, I think one of Int32 or Word32 would do. - ADR
 144 data ClockTime = TOD Int64 Int64 deriving (Eq, Ord)
 145 #else
 146 data ClockTime = TOD Integer            -- Seconds since 00:00:00 on 1 Jan 1970
 147                      Integer            -- Picoseconds with the specified second
 148                deriving (Eq, Ord)
 149
 150 #endif
 151 \end{code}
 152
 153 When a @ClockTime@ is shown, it is converted to a string of the form
 154 @"Mon Nov 28 21:45:41 GMT 1994"@.
 155
 156 For now, we are restricted to roughly:
 157 Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because
 158 we use the C library routines based on 32 bit integers.
 159
 160 \begin{code}
 161 #ifdef __HUGS__
 162 #warning Show ClockTime is bogus
 163 instance Show ClockTime
 164 #else
 165 instance Show ClockTime where
 166     showsPrec p (TOD (S# i) _nsec) =
 167       case int2Integer# i of (# s, d #) -> showsPrec p (TOD (J# s d) _nsec)
 168     showsPrec _ (TOD (J# s# d#) _nsec) =
 169       showString $ unsafePerformIO $ do
 170             let buflen@(I# buflen#) = 50 -- big enough for error message
 171             buf <- allocChars buflen
 172             if s# <# (negateInt# 1#) || s# ># 1# then
 173                return "ClockTime.show{Time}: out of range"
 174              else do
 175                rc <- showTime (I# s#) d# buflen buf
 176                if rc < 0 then
 177                   return "ClockTime.show{Time}: internal error"
 178                 else do
 179                   ba <- stToIO (freeze_ps_array buf buflen#)
 180                   return (unpackCStringBA ba)
 181
 182     showList = showList__ (showsPrec 0)
 183 #endif
 184 \end{code}
 185
 186
 187 @CalendarTime@ is a user-readable and manipulable
 188 representation of the internal $ClockTime$ type.  The
 189 numeric fields have the following ranges.
 190
 191 \begin{verbatim}
 192 Value         Range             Comments
 193 -----         -----             --------
 194
 195 year    -maxInt .. maxInt       [Pre-Gregorian dates are inaccurate]
 196 mon           0 .. 11           [Jan = 0, Dec = 11]
 197 day           1 .. 31
 198 hour          0 .. 23
 199 min           0 .. 59
 200 sec           0 .. 61           [Allows for two leap seconds]
 201 picosec       0 .. (10^12)-1    [This could be over-precise?]
 202 wday          0 .. 6            [Sunday = 0, Saturday = 6]
 203 yday          0 .. 365          [364 in non-Leap years]
 204 tz       -43200 .. 43200        [Variation from UTC in seconds]
 205 \end{verbatim}
 206
 207 The {\em tzname} field is the name of the time zone.  The {\em isdst}
 208 field indicates whether Daylight Savings Time would be in effect.
 209
 210 \begin{code}
 211 data CalendarTime
 212  = CalendarTime  {
 213      ctYear    :: Int,
 214      ctMonth   :: Month,
 215      ctDay     :: Int,
 216      ctHour    :: Int,
 217      ctMin     :: Int,
 218      ctSec     :: Int,
 219 #ifdef __HUGS__
 220      ctPicosec :: Int64,
 221 #else
 222      ctPicosec :: Integer,
 223 #endif
 224      ctWDay    :: Day,
 225      ctYDay    :: Int,
 226      ctTZName  :: String,
 227      ctTZ      :: Int,
 228      ctIsDST   :: Bool
 229  }
 230  deriving (Eq,Ord,Read,Show)
 231
 232 \end{code}
 233
 234 The @TimeDiff@ type records the difference between two clock times in
 235 a user-readable way.
 236
 237 \begin{code}
 238 data TimeDiff
 239  = TimeDiff {
 240      tdYear    :: Int,
 241      tdMonth   :: Int,
 242      tdDay     :: Int,
 243      tdHour    :: Int,
 244      tdMin     :: Int,
 245      tdSec     :: Int,
 246 #ifdef __HUGS__
 247      tdPicosec :: Int64   -- not standard
 248 #else
 249      tdPicosec :: Integer -- not standard
 250 #endif
 251    }
 252    deriving (Eq,Ord,Read,Show)
 253
 254 noTimeDiff :: TimeDiff
 255 noTimeDiff = TimeDiff 0 0 0 0 0 0 0
 256 \end{code}
 257
 258 @getClockTime@ returns the current time in its internal representation.
 259
 260 \begin{code}
 261 getClockTime :: IO ClockTime
 262 getClockTime = do
 263     i1 <- malloc1
 264     i2 <- malloc1
 265     rc <- primGetClockTime i1 i2
 266     if rc == 0
 267         then do
 268             sec  <- cvtUnsigned i1
 269             nsec <- cvtUnsigned i2
 270             return (TOD sec (nsec * 1000))
 271         else
 272             constructErrorAndFail "getClockTime"
 273
 274 #ifdef __HUGS__
 275 malloc1 = primNewByteArray sizeof_int64
 276 cvtUnsigned arr = primReadInt64Array arr 0
 277 #else
 278 malloc1 :: IO (MutableByteArray RealWorld Int)
 279 malloc1 = IO $ \ s# ->
 280   case newIntArray# 1# s# of
 281    (# s2#, barr# #) -> (# s2#, MutableByteArray bot bot barr# #)
 282   where
 283         bot = error "Time.malloc1"
 284
 285    --  The C routine fills in an unsigned word.  We don't have
 286    --   `unsigned2Integer#,' so we freeze the data bits and use them
 287    --   for an MP_INT structure.  Note that zero is still handled specially,
 288    --   although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
 289
 290 cvtUnsigned :: MutableByteArray RealWorld Int -> IO Integer
 291 cvtUnsigned (MutableByteArray _ _ arr#) = IO $ \ s# ->
 292   case readIntArray# arr# 0# s# of
 293     (# s2#, r# #) | r# ==# 0#  -> (# s2#, 0 #)
 294                   | otherwise  ->
 295                      case unsafeFreezeByteArray# arr# s2# of
 296                        (# s3#, frozen# #) -> (# s3#, J# 1# frozen# #)
 297 #endif
 298 \end{code}
 299
 300 @addToClockTime@ {\em d} {\em t} adds a time difference {\em d} and a
 301 clock time {\em t} to yield a new clock time.  The difference {\em d}
 302 may be either positive or negative.  @[diffClockTimes@ {\em t1} {\em
 303 t2} returns the difference between two clock times {\em t1} and {\em
 304 t2} as a @TimeDiff@.
 305
 306
 307 \begin{code}
 308 addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
 309 addToClockTime (TimeDiff year mon day hour min sec psec)
 310                (TOD c_sec c_psec) =
 311         let
 312           sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day
 313           cal      = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec))
 314                                                        -- FIXME! ^^^^
 315           new_mon  = fromEnum (ctMonth cal) + r_mon
 316           (month', yr_diff)
 317             | new_mon < 0  = (toEnum (12 + new_mon), (-1))
 318             | new_mon > 11 = (toEnum (new_mon `mod` 12), 1)
 319             | otherwise    = (toEnum new_mon, 0)
 320
 321           (r_yr, r_mon) = mon `quotRem` 12
 322
 323           year' = ctYear cal + year + r_yr + yr_diff
 324         in
 325         toClockTime cal{ctMonth=month', ctYear=year'}
 326
 327 diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
 328 -- diffClockTimes is meant to be the dual to `addToClockTime'.
 329 -- If you want to have the TimeDiff properly splitted, use
 330 -- `normalizeTimeDiff' on this function's result
 331 --
 332 -- CAVEAT: see comment of normalizeTimeDiff
 333 diffClockTimes (TOD sa pa) (TOD sb pb) =
 334     noTimeDiff{ tdSec     = fromIntegral (sa - sb)
 335                 -- FIXME: can handle just 68 years...
 336               , tdPicosec = pa - pb
 337               }
 338
 339
 340 normalizeTimeDiff :: TimeDiff -> TimeDiff
 341 -- FIXME: handle psecs properly
 342 -- FIXME: ?should be called by formatTimeDiff automagically?
 343 --
 344 -- when applied to something coming out of `diffClockTimes', you loose
 345 -- the duality to `addToClockTime', since a year does not always have
 346 -- 365 days, etc.
 347 --
 348 -- apply this function as late as possible to prevent those "rounding"
 349 -- errors
 350 normalizeTimeDiff td =
 351   let
 352       rest0 = tdSec td
 353                + 60 * (tdMin td
 354                     + 60 * (tdHour td
 355                          + 24 * (tdDay td
 356                               + 30 * (tdMonth td
 357                                    + 365 * tdYear td))))
 358
 359       (diffYears,  rest1)    = rest0 `quotRem` (365 * 24 * 3600)
 360       (diffMonths, rest2)    = rest1 `quotRem` (30 * 24 * 3600)
 361       (diffDays,   rest3)    = rest2 `quotRem` (24 * 3600)
 362       (diffHours,  rest4)    = rest3 `quotRem` 3600
 363       (diffMins,   diffSecs) = rest4 `quotRem` 60
 364   in
 365       td{ tdYear = diffYears
 366         , tdMonth = diffMonths
 367         , tdDay   = diffDays
 368         , tdHour  = diffHours
 369         , tdMin   = diffMins
 370         , tdSec   = diffSecs
 371         }
 372
 373 \end{code}
 374
 375 @toCalendarTime@ {\em t} converts {\em t} to a local time, modified by
 376 the current timezone and daylight savings time settings.  @toUTCTime@
 377 {\em t} converts {\em t} into UTC time.  @toClockTime@ {\em l}
 378 converts {\em l} into the corresponding internal @ClockTime@.  The
 379 {\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are
 380 ignored.
 381
 382 \begin{code}
 383 #ifdef __HUGS__
 384 toCalendarTime :: ClockTime -> IO CalendarTime
 385 toCalendarTime (TOD sec psec) = do
 386     res    <- allocWords sizeof_int64
 387     zoneNm <- allocChars 32
 388     prim_SETZONE res zoneNm
 389     rc <- prim_toLocalTime sec res
 390     if rc /= 0
 391      then constructErrorAndFail "Time.toCalendarTime: out of range"
 392      else do
 393        sec   <-  get_tm_sec   res
 394        min   <-  get_tm_min   res
 395        hour  <-  get_tm_hour  res
 396        mday  <-  get_tm_mday  res
 397        mon   <-  get_tm_mon   res
 398        year  <-  get_tm_year  res
 399        wday  <-  get_tm_wday  res
 400        yday  <-  get_tm_yday  res
 401        isdst <-  get_tm_isdst res
 402        zone  <-  prim_ZONE    res
 403        tz    <-  prim_GMTOFF  res
 404        tzname <- primUnpackCString zone
 405        return (CalendarTime (1900+year) mon mday hour min sec psec
 406                             (toEnum wday) yday tzname tz (isdst /= 0))
 407
 408 toUTCTime :: ClockTime -> CalendarTime
 409 toUTCTime  (TOD sec psec) = unsafePerformIO $ do
 410        res    <- allocWords sizeof_int64
 411        zoneNm <- allocChars 32
 412        prim_SETZONE res zoneNm
 413        rc <- prim_toUTCTime sec res
 414        if rc /= 0
 415         then error "Time.toUTCTime: out of range"
 416         else do
 417             sec   <- get_tm_sec  res
 418             min   <- get_tm_min  res
 419             hour  <- get_tm_hour res
 420             mday  <- get_tm_mday res
 421             mon   <- get_tm_mon  res
 422             year  <- get_tm_year res
 423             wday  <- get_tm_wday res
 424             yday  <- get_tm_yday res
 425             return (CalendarTime (1900+year) mon mday hour min sec psec
 426                           (toEnum wday) yday "UTC" 0 False)
 427
 428 toClockTime :: CalendarTime -> ClockTime
 429 toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) =
 430     if psec < 0 || psec > 999999999999 then
 431         error "Time.toClockTime: picoseconds out of range"
 432     else if tz < -43200 || tz > 43200 then
 433         error "Time.toClockTime: timezone offset out of range"
 434     else
 435         unsafePerformIO ( do
 436             res <- allocWords sizeof_int64
 437             rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res
 438             if rc /= (0::Int)
 439              then do
 440                tm <- primReadInt64Array res 0
 441                return (TOD tm psec)
 442              else error "Time.toClockTime: can't perform conversion"
 443         )
 444     where
 445      isDst = if isdst then (1::Int) else 0
 446
 447 #else
 448 toCalendarTime :: ClockTime -> IO CalendarTime
 449 toCalendarTime (TOD (S# i) psec)
 450   = case int2Integer# i of (# s, d #) -> toCalendarTime (TOD (J# s d) psec)
 451 toCalendarTime (TOD (J# s# d#) psec) = do
 452     res    <- allocWords sizeof_struct_tm
 453     zoneNm <- allocChars 32
 454     prim_SETZONE res zoneNm
 455     rc     <- prim_toLocalTime (I# s#) d# res
 456     if rc == 0
 457      then constructErrorAndFail "Time.toCalendarTime: out of range"
 458      else do
 459        sec   <-  get_tm_sec res
 460        min   <-  get_tm_min res
 461        hour  <-  get_tm_hour res
 462        mday  <-  get_tm_mday res
 463        mon   <-  get_tm_mon  res
 464        year  <-  get_tm_year res
 465        wday  <-  get_tm_wday res
 466        yday  <-  get_tm_yday res
 467        isdst <-  get_tm_isdst res
 468        zone  <-  get_ZONE res
 469        tz    <-  get_GMTOFF res
 470        let tzname = unpackCString zone
 471            month
 472             | mon >= 0 && mon <= 11 = toEnum mon
 473             | otherwise             = error ("toCalendarTime: illegal month value: " ++ show mon)
 474
 475        return (CalendarTime (1900+year) month mday hour min sec psec
 476                             (toEnum wday) yday tzname tz (isdst /= (0::Int)))
 477
 478 toUTCTime :: ClockTime -> CalendarTime
 479 toUTCTime (TOD (S# i) psec)
 480   = case int2Integer# i of (# s, d #) -> toUTCTime (TOD (J# s d) psec)
 481 toUTCTime  (TOD (J# s# d#) psec) = unsafePerformIO $ do
 482        res    <- allocWords sizeof_struct_tm
 483        zoneNm <- allocChars 32
 484        prim_SETZONE res zoneNm
 485        rc     <-  prim_toUTCTime (I# s#) d# res
 486        if rc == 0
 487         then error "Time.toUTCTime: out of range"
 488         else do
 489             sec   <- get_tm_sec res
 490             min   <- get_tm_min res
 491             hour  <- get_tm_hour res
 492             mday  <- get_tm_mday res
 493             mon   <- get_tm_mon res
 494             year  <- get_tm_year res
 495             wday  <- get_tm_wday res
 496             yday  <- get_tm_yday res
 497             let
 498              month
 499               | mon >= 0 && mon <= 11 = toEnum mon
 500               | otherwise             = error ("toCalendarTime: illegal month value: " ++ show mon)
 501
 502             return (CalendarTime (1900+year) month mday hour min sec psec
 503                           (toEnum wday) yday "UTC" 0 False)
 504
 505 toClockTime :: CalendarTime -> ClockTime
 506 toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz isdst) =
 507     if psec < 0 || psec > 999999999999 then
 508         error "Time.toClockTime: picoseconds out of range"
 509     else if tz < -43200 || tz > 43200 then
 510         error "Time.toClockTime: timezone offset out of range"
 511     else
 512         unsafePerformIO ( do
 513             res <- malloc1
 514             rc  <- toClockSec year (fromEnum mon) mday hour min sec tz isDst res
 515             if rc /= 0
 516              then do
 517                i <- cvtUnsigned res
 518                return (TOD i psec)
 519              else error "Time.toClockTime: can't perform conversion"
 520         )
 521     where
 522      -- `isDst' causes the date to be wrong by one hour...
 523      -- FIXME: check, whether this works on other arch's than Linux, too...
 524      --
 525      -- so we set it to (-1) (means `unknown') and let `mktime' determine
 526      -- the real value...
 527      isDst = -1     -- if isdst then (1::Int) else 0
 528 #endif
 529
 530
 531 -- (copied from PosixUtil, for now)
 532 -- Allocate a mutable array of characters with no indices.
 533
 534 #ifdef __HUGS__
 535 allocChars :: Int -> IO (PrimMutableByteArray RealWorld)
 536 allocChars size = primNewByteArray size
 537
 538 -- Allocate a mutable array of words with no indices
 539
 540 allocWords :: Int -> IO (PrimMutableByteArray RealWorld)
 541 allocWords size = primNewByteArray size
 542 #else
 543 allocChars :: Int -> IO (MutableByteArray RealWorld Int)
 544 allocChars (I# size#) = stToIO (new_ps_array size#)
 545
 546 -- Allocate a mutable array of words with no indices
 547
 548 allocWords :: Int -> IO (MutableByteArray RealWorld Int)
 549 allocWords (I# size#) = IO $ \ s# ->
 550     case newIntArray# size# s# of
 551       (# s2#, barr# #) ->
 552         (# s2#, MutableByteArray bot bot barr# #)
 553   where
 554     bot = error "Time.allocWords"
 555 #endif
 556 \end{code}
 557
 558 \begin{code}
 559 calendarTimeToString  :: CalendarTime -> String
 560 calendarTimeToString  =  formatCalendarTime defaultTimeLocale "%c"
 561
 562 formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
 563 formatCalendarTime l fmt (CalendarTime year mon day hour min sec _
 564                                        wday yday tzname _ _) =
 565         doFmt fmt
 566   where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
 567         doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
 568         doFmt ('%':c:cs)   = decode c ++ doFmt cs
 569         doFmt (c:cs) = c : doFmt cs
 570         doFmt "" = ""
 571
 572         decode 'A' = fst (wDays l  !! fromEnum wday) -- day of the week, full name
 573         decode 'a' = snd (wDays l  !! fromEnum wday) -- day of the week, abbrev.
 574         decode 'B' = fst (months l !! fromEnum mon)  -- month, full name
 575         decode 'b' = snd (months l !! fromEnum mon)  -- month, abbrev
 576         decode 'h' = snd (months l !! fromEnum mon)  -- ditto
 577         decode 'C' = show2 (year `quot` 100)         -- century
 578         decode 'c' = doFmt (dateTimeFmt l)           -- locale's data and time format.
 579         decode 'D' = doFmt "%m/%d/%y"
 580         decode 'd' = show2 day                       -- day of the month
 581         decode 'e' = show2' day                      -- ditto, padded
 582         decode 'H' = show2 hour                      -- hours, 24-hour clock, padded
 583         decode 'I' = show2 (to12 hour)               -- hours, 12-hour clock
 584         decode 'j' = show3 yday                      -- day of the year
 585         decode 'k' = show2' hour                     -- hours, 24-hour clock, no padding
 586         decode 'l' = show2' (to12 hour)              -- hours, 12-hour clock, no padding
 587         decode 'M' = show2 min                       -- minutes
 588         decode 'm' = show2 (fromEnum mon+1)          -- numeric month
 589         decode 'n' = "\n"
 590         decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm
 591         decode 'R' = doFmt "%H:%M"
 592         decode 'r' = doFmt (time12Fmt l)
 593         decode 'T' = doFmt "%H:%M:%S"
 594         decode 't' = "\t"
 595         decode 'S' = show2 sec                       -- seconds
 596         decode 's' = show2 sec                       -- number of secs since Epoch. (ToDo.)
 597         decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday.
 598         decode 'u' = show (let n = fromEnum wday in  -- numeric day of the week (1=Monday, 7=Sunday)
 599                            if n == 0 then 7 else n)
 600         decode 'V' =                                 -- week number (as per ISO-8601.)
 601             let (week, days) =                       -- [yep, I've always wanted to be able to display that too.]
 602                    (yday + 7 - if fromEnum wday > 0 then
 603                                fromEnum wday - 1 else 6) `divMod` 7
 604             in  show2 (if days >= 4 then
 605                           week+1
 606                        else if week == 0 then 53 else week)
 607
 608         decode 'W' =                                 -- week number, weeks starting on monday
 609             show2 ((yday + 7 - if fromEnum wday > 0 then
 610                                fromEnum wday - 1 else 6) `div` 7)
 611         decode 'w' = show (fromEnum wday)            -- numeric day of the week, weeks starting on Sunday.
 612         decode 'X' = doFmt (timeFmt l)               -- locale's preferred way of printing time.
 613         decode 'x' = doFmt (dateFmt l)               -- locale's preferred way of printing dates.
 614         decode 'Y' = show year                       -- year, including century.
 615         decode 'y' = show2 (year `rem` 100)          -- year, within century.
 616         decode 'Z' = tzname                          -- timezone name
 617         decode '%' = "%"
 618         decode c   = [c]
 619
 620
 621 show2, show2', show3 :: Int -> String
 622 show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)]
 623
 624 show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x
 625
 626 show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100)
 627
 628 to12 :: Int -> Int
 629 to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'
 630 \end{code}
 631
 632 Useful extensions for formatting TimeDiffs.
 633
 634 \begin{code}
 635 timeDiffToString :: TimeDiff -> String
 636 timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
 637
 638 formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
 639 formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _)
 640  = doFmt fmt
 641   where
 642    doFmt ""         = ""
 643    doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
 644    doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
 645    doFmt ('%':c:cs) = decode c ++ doFmt cs
 646    doFmt (c:cs)     = c : doFmt cs
 647
 648    decode spec =
 649     case spec of
 650       'B' -> fst (months l !! fromEnum month)
 651       'b' -> snd (months l !! fromEnum month)
 652       'h' -> snd (months l !! fromEnum month)
 653       'c' -> defaultTimeDiffFmt td
 654       'C' -> show2 (year `quot` 100)
 655       'D' -> doFmt "%m/%d/%y"
 656       'd' -> show2 day
 657       'e' -> show2' day
 658       'H' -> show2 hour
 659       'I' -> show2 (to12 hour)
 660       'k' -> show2' hour
 661       'l' -> show2' (to12 hour)
 662       'M' -> show2 min
 663       'm' -> show2 (fromEnum month + 1)
 664       'n' -> "\n"
 665       'p' -> (if hour < 12 then fst else snd) (amPm l)
 666       'R' -> doFmt "%H:%M"
 667       'r' -> doFmt (time12Fmt l)
 668       'T' -> doFmt "%H:%M:%S"
 669       't' -> "\t"
 670       'S' -> show2 sec
 671       's' -> show2 sec -- Implementation-dependent, sez the lib doc..
 672       'X' -> doFmt (timeFmt l)
 673       'x' -> doFmt (dateFmt l)
 674       'Y' -> show year
 675       'y' -> show2 (year `rem` 100)
 676       '%' -> "%"
 677       c   -> [c]
 678
 679    defaultTimeDiffFmt (TimeDiff year month day hour min sec _) =
 680        foldr (\ (v,s) rest ->
 681                   (if v /= 0
 682                      then show v ++ ' ':(addS v s)
 683                        ++ if null rest then "" else ", "
 684                      else "") ++ rest
 685              )
 686              ""
 687              (zip [year, month, day, hour, min, sec] (intervals l))
 688
 689    addS v s = if abs v == 1 then fst s else snd s
 690 \end{code}
 691
 692 \begin{code}
 693 foreign import "libHS_cbits" "get_tm_sec"   unsafe get_tm_sec   :: MBytes -> IO Int
 694 foreign import "libHS_cbits" "get_tm_min"   unsafe get_tm_min   :: MBytes -> IO Int
 695 foreign import "libHS_cbits" "get_tm_hour"  unsafe get_tm_hour  :: MBytes -> IO Int
 696 foreign import "libHS_cbits" "get_tm_mday"  unsafe get_tm_mday  :: MBytes -> IO Int
 697 foreign import "libHS_cbits" "get_tm_mon"   unsafe get_tm_mon   :: MBytes -> IO Int
 698 foreign import "libHS_cbits" "get_tm_year"  unsafe get_tm_year  :: MBytes -> IO Int
 699 foreign import "libHS_cbits" "get_tm_wday"  unsafe get_tm_wday  :: MBytes -> IO Int
 700 foreign import "libHS_cbits" "get_tm_yday"  unsafe get_tm_yday  :: MBytes -> IO Int
 701 foreign import "libHS_cbits" "get_tm_isdst" unsafe get_tm_isdst :: MBytes -> IO Int
 702
 703 foreign import "libHS_cbits" "prim_ZONE"    unsafe prim_ZONE    :: Bytes -> IO Addr
 704 foreign import "libHS_cbits" "prim_GMTOFF"  unsafe prim_GMTOFF  :: Bytes -> IO Int
 705
 706 foreign import "libHS_cbits" "sizeof_struct_tm" unsafe sizeof_struct_tm :: Int
 707
 708 #ifdef __HUGS__
 709 -- believed to be at least 1 bit (the sign bit!) bigger than sizeof_time_t
 710 sizeof_int64 :: Int
 711 sizeof_int64 = 8
 712 #endif
 713
 714 type MBytes = MutableByteArray RealWorld Int
 715
 716 foreign import "libHS_cbits" "sizeof_time_t" unsafe sizeof_time_t    :: Int
 717
 718 foreign import "libHS_cbits" "prim_SETZONE" unsafe prim_SETZONE :: MBytes -> MBytes -> IO ()
 719 #ifdef __HUGS__
 720 foreign import "libHS_cbits" "prim_toLocalTime"  unsafe prim_toLocalTime :: Int64 -> MBytes -> IO Int
 721 foreign import "libHS_cbits" "prim_toUTCTime"    unsafe prim_toUTCTime   :: Int64 -> MBytes -> IO Int
 722 #else
 723 foreign import "libHS_cbits" "toLocalTime"  unsafe prim_toLocalTime :: Int -> Bytes -> MBytes -> IO Int
 724 foreign import "libHS_cbits" "toUTCTime"    unsafe prim_toUTCTime   :: Int -> Bytes -> MBytes -> IO Int
 725 #endif
 726
 727 foreign import "libHS_cbits" "get_ZONE"  unsafe get_ZONE   :: MBytes -> IO Addr
 728 foreign import "libHS_cbits" "GMTOFF"    unsafe get_GMTOFF :: MBytes -> IO Int
 729
 730
 731 foreign import "libHS_cbits" "toClockSec" unsafe
 732             toClockSec   :: Int -> Int -> Int -> Int -> Int
 733                          -> Int -> Int -> Int -> MBytes -> IO Int
 734
 735 foreign import "libHS_cbits" "getClockTime"  unsafe
 736            primGetClockTime :: MutableByteArray RealWorld Int
 737                             -> MutableByteArray RealWorld Int
 738                             -> IO Int
 739 foreign import "libHS_cbits" "showTime" unsafe
 740            showTime :: Int
 741                     -> Bytes
 742                     -> Int
 743                     -> MBytes
 744                     -> IO Int
 745 \end{code}