ghc/lib/std/Time.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-97
   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 \begin{code}
  12 {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h"  #-}
  13
  14 module Time
  15        (
  16         Month,
  17         Day,
  18         CalendarTime(CalendarTime),
  19         TimeDiff(TimeDiff),
  20         ClockTime(..), -- non-standard, lib. report gives this as abstract
  21
  22         getClockTime,
  23         addToClockTime,
  24         diffClockTimes,
  25
  26         toCalendarTime,
  27         toUTCTime,
  28         toClockTime,
  29         calendarTimeToString,
  30         formatCalendarTime
  31        ) where
  32
  33 import PrelBase
  34 import PrelIOBase
  35 import PrelArr
  36 import PrelST
  37 import PrelUnsafe       ( unsafePerformIO )
  38 import PrelAddr
  39 import PrelPack         ( unpackCString )
  40
  41 import Ix
  42 import Char             ( intToDigit )
  43 import Locale
  44
  45 \end{code}
  46
  47 One way to partition and give name to chunks of a year and a week:
  48
  49 \begin{code}
  50 data Month
  51  = January   | February | March    | April
  52  | May       | June     | July     | August
  53  | September | October  | November | December
  54  deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
  55
  56 data Day
  57  = Sunday | Monday | Tuesday | Wednesday
  58  | Thursday | Friday | Saturday
  59  deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
  60
  61 \end{code}
  62
  63 @ClockTime@ is an abstract type, used for the internal clock time.
  64 Clock times may be compared, converted to strings, or converted to an
  65 external calendar time @CalendarTime@.
  66
  67 \begin{code}
  68 data ClockTime = TOD Integer Integer deriving (Eq, Ord)
  69 \end{code}
  70
  71 When a @ClockTime@ is shown, it is converted to a string of the form
  72 @"Mon Nov 28 21:45:41 GMT 1994"@.
  73
  74 For now, we are restricted to roughly:
  75 Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because
  76 we use the C library routines based on 32 bit integers.
  77
  78 \begin{code}
  79 instance Show ClockTime where
  80     showsPrec p (TOD sec@(J# a# s# d#) nsec) = showString $ unsafePerformIO $
  81             allocChars 32               >>= \ buf ->
  82             _ccall_ showTime (I# s#) (ByteArray bottom d#) buf
  83                                         >>= \ str ->
  84             return (unpackCString str)
  85
  86     showList = showList__ (showsPrec 0)
  87 \end{code}
  88
  89
  90 @CalendarTime@ is a user-readable and manipulable
  91 representation of the internal $ClockTime$ type.  The
  92 numeric fields have the following ranges.
  93
  94 \begin{verbatim}
  95 Value         Range             Comments
  96 -----         -----             --------
  97
  98 year    -maxInt .. maxInt       [Pre-Gregorian dates are inaccurate]
  99 mon           0 .. 11           [Jan = 0, Dec = 11]
 100 day           1 .. 31
 101 hour          0 .. 23
 102 min           0 .. 59
 103 sec           0 .. 61           [Allows for two leap seconds]
 104 picosec       0 .. (10^12)-1    [This could be over-precise?]
 105 wday          0 .. 6            [Sunday = 0, Saturday = 6]
 106 yday          0 .. 365          [364 in non-Leap years]
 107 tz       -43200 .. 43200        [Variation from UTC in seconds]
 108 \end{verbatim}
 109
 110 The {\em tzname} field is the name of the time zone.  The {\em isdst}
 111 field indicates whether Daylight Savings Time would be in effect.
 112
 113 \begin{code}
 114 data CalendarTime
 115  = CalendarTime  {
 116      ctYear    :: Int,
 117      ctMonth   :: Int,
 118      ctDay     :: Int,
 119      ctHour    :: Int,
 120      ctMin     :: Int,
 121      ctSec     :: Int,
 122      ctPicosec :: Integer,
 123      ctWDay    :: Day,
 124      ctYDay    :: Int,
 125      ctTZName  :: String,
 126      ctTZ      :: Int,
 127      ctIsDST   :: Bool
 128  }
 129  deriving (Eq,Ord,Read,Show)
 130
 131 \end{code}
 132
 133 The @TimeDiff@ type records the difference between two clock times in
 134 a user-readable way.
 135
 136 \begin{code}
 137 data TimeDiff
 138  = TimeDiff {
 139      tdYear    :: Int,
 140      tdMonth   :: Int,
 141      tdDay     :: Int,
 142      tdHour    :: Int,
 143      tdMin     :: Int,
 144      tdSec     :: Int,
 145      tdPicosec :: Integer -- not standard
 146    }
 147    deriving (Eq,Ord,Read,Show)
 148 \end{code}
 149
 150 @getClockTime@ returns the current time in its internal representation.
 151
 152 \begin{code}
 153 getClockTime :: IO ClockTime
 154 getClockTime =
 155     malloc1                                         >>= \ i1 ->
 156     malloc1                                         >>= \ i2 ->
 157     _ccall_ getClockTime i1 i2                      >>= \ rc ->
 158     if rc == 0
 159         then
 160             cvtUnsigned i1                          >>= \ sec ->
 161             cvtUnsigned i2                          >>= \ nsec ->
 162             return (TOD sec (nsec * 1000))
 163         else
 164             constructErrorAndFail "getClockTime"
 165   where
 166     malloc1 = IO $ \ s# ->
 167         case newIntArray# 1# s# of
 168           StateAndMutableByteArray# s2# barr# ->
 169                 IOok s2# (MutableByteArray bottom barr#)
 170
 171     --  The C routine fills in an unsigned word.  We don't have
 172     --  `unsigned2Integer#,' so we freeze the data bits and use them
 173     --  for an MP_INT structure.  Note that zero is still handled specially,
 174     --  although (J# 1# 1# (ptr to 0#)) is probably acceptable to gmp.
 175
 176     cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
 177         case readIntArray# arr# 0# s# of
 178           StateAndInt# s2# r# ->
 179             if r# ==# 0#
 180                 then IOok s2# 0
 181                 else case unsafeFreezeByteArray# arr# s2# of
 182                         StateAndByteArray# s3# frozen# ->
 183                                 IOok s3# (J# 1# 1# frozen#)
 184
 185 \end{code}
 186
 187 @addToClockTime@ {\em d} {\em t} adds a time difference {\em d} and a
 188 clock time {\em t} to yield a new clock time.  The difference {\em d}
 189 may be either positive or negative.  @[diffClockTimes@ {\em t1} {\em
 190 t2} returns the difference between two clock times {\em t1} and {\em
 191 t2} as a @TimeDiff@.
 192
 193
 194 \begin{code}
 195 addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
 196 addToClockTime (TimeDiff year mon day hour min sec psec)
 197                (TOD c_sec c_psec) = unsafePerformIO $
 198     allocWords (``sizeof(time_t)'') >>= \ res ->
 199     _ccall_ toClockSec year mon day hour min sec 0 res
 200                                     >>= \ ptr@(A# ptr#) ->
 201     if ptr /= ``NULL''
 202         then let
 203                diff_sec  = (int2Integer# (indexIntOffAddr# ptr# 0#))
 204                diff_psec = psec
 205              in
 206              return (TOD (c_sec + diff_sec) (c_psec + diff_psec))
 207         else
 208             error "Time.addToClockTime: can't perform conversion of TimeDiff"
 209
 210
 211 diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
 212 diffClockTimes tod_a tod_b =
 213   let
 214    CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toCalendarTime tod_a
 215    CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toCalendarTime tod_b
 216   in
 217   TimeDiff (year_a - year_b)
 218            (mon_a  - mon_b)
 219            (day_a  - day_b)
 220            (hour_a - hour_b)
 221            (min_b  - min_a)
 222            (sec_a  - sec_b)
 223            (psec_a - psec_b)
 224 \end{code}
 225
 226 @toCalendarTime@ {\em t} converts {\em t} to a local time, modified by
 227 the current timezone and daylight savings time settings.  @toUTCTime@
 228 {\em t} converts {\em t} into UTC time.  @toClockTime@ {\em l}
 229 converts {\em l} into the corresponding internal @ClockTime@.  The
 230 {\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are
 231 ignored.
 232
 233 \begin{code}
 234 toCalendarTime :: ClockTime -> CalendarTime
 235 toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformIO $
 236     allocWords (``sizeof(struct tm)''::Int)         >>= \ res ->
 237     allocChars 32                                   >>= \ zoneNm ->
 238     _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm   >>= \ () ->
 239     _ccall_ toLocalTime (I# s#) (ByteArray bottom d#) res
 240                                                     >>= \ tm ->
 241     if tm == (``NULL''::Addr)
 242         then error "Time.toCalendarTime: out of range"
 243         else
 244             _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm       >>= \ sec ->
 245             _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm       >>= \ min ->
 246             _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm      >>= \ hour ->
 247             _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm      >>= \ mday ->
 248             _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm       >>= \ mon ->
 249             _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm      >>= \ year ->
 250             _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm      >>= \ wday ->
 251             _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm      >>= \ yday ->
 252             _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm     >>= \ isdst ->
 253             _ccall_ ZONE tm                                     >>= \ zone ->
 254             _ccall_ GMTOFF tm                                   >>= \ tz ->
 255             let
 256              tzname = unpackCString zone
 257             in
 258             return (CalendarTime (1900+year) mon mday hour min sec psec
 259                           (toEnum wday) yday tzname tz (isdst /= 0))
 260
 261 toUTCTime :: ClockTime -> CalendarTime
 262 toUTCTime  (TOD sec@(J# a# s# d#) psec) = unsafePerformIO (
 263         allocWords (``sizeof(struct tm)''::Int)                     >>= \ res ->
 264         allocChars 32                                               >>= \ zoneNm ->
 265         _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm >>= \ () ->
 266         _ccall_ toUTCTime (I# s#) (ByteArray bottom d#) res
 267                                                     >>= \ tm ->
 268     if tm == (``NULL''::Addr)
 269         then error "Time.toUTCTime: out of range"
 270         else
 271             _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm       >>= \ sec ->
 272             _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm       >>= \ min ->
 273             _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm      >>= \ hour ->
 274             _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm      >>= \ mday ->
 275             _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm       >>= \ mon ->
 276             _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm      >>= \ year ->
 277             _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm      >>= \ wday ->
 278             _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm      >>= \ yday ->
 279             return (CalendarTime (1900+year) mon mday hour min sec psec
 280                           (toEnum wday) yday "UTC" 0 False)
 281     )
 282
 283 toClockTime :: CalendarTime -> ClockTime
 284 toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) =
 285     if psec < 0 || psec > 999999999999 then
 286         error "Time.toClockTime: picoseconds out of range"
 287     else if tz < -43200 || tz > 43200 then
 288         error "Time.toClockTime: timezone offset out of range"
 289     else
 290         unsafePerformIO (
 291             allocWords (``sizeof(time_t)'') >>= \ res ->
 292             _ccall_ toClockSec year mon mday hour min sec isDst res
 293                                                     >>= \ ptr@(A# ptr#) ->
 294             if ptr /= ``NULL'' then
 295                 return (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec)
 296             else
 297                 error "Time.toClockTime: can't perform conversion"
 298         )
 299     where
 300      isDst = if isdst then (1::Int) else 0
 301
 302 bottom :: (Int,Int)
 303 bottom = error "Time.bottom"
 304
 305
 306 -- (copied from PosixUtil, for now)
 307 -- Allocate a mutable array of characters with no indices.
 308
 309 allocChars :: Int -> IO (MutableByteArray RealWorld ())
 310 allocChars (I# size#) = IO $ \ s# ->
 311     case newCharArray# size# s# of
 312       StateAndMutableByteArray# s2# barr# ->
 313         IOok s2# (MutableByteArray bot barr#)
 314   where
 315     bot = error "Time.allocChars"
 316
 317 -- Allocate a mutable array of words with no indices
 318
 319 allocWords :: Int -> IO (MutableByteArray RealWorld ())
 320 allocWords (I# size#) = IO $ \ s# ->
 321     case newIntArray# size# s# of
 322       StateAndMutableByteArray# s2# barr# ->
 323         IOok s2# (MutableByteArray bot barr#)
 324   where
 325     bot = error "Time.allocWords"
 326
 327 \end{code}
 328
 329 \begin{code}
 330 calendarTimeToString  :: CalendarTime -> String
 331 calendarTimeToString  =  formatCalendarTime defaultTimeLocale "%c"
 332
 333 formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
 334 formatCalendarTime l fmt ct@(CalendarTime year mon day hour min sec sdec
 335                                            wday yday tzname _ _) =
 336         doFmt fmt
 337   where doFmt ('%':c:cs) = decode c ++ doFmt cs
 338         doFmt (c:cs) = c : doFmt cs
 339         doFmt "" = ""
 340         to12 h = let h' = h `mod` 12 in if h == 0 then 12 else h
 341         decode 'A' = fst (wDays l  !! fromEnum wday)
 342         decode 'a' = snd (wDays l  !! fromEnum wday)
 343         decode 'B' = fst (months l !! fromEnum mon)
 344         decode 'b' = snd (months l !! fromEnum mon)
 345         decode 'h' = snd (months l !! fromEnum mon)
 346         decode 'C' = show2 (year `quot` 100)
 347         decode 'c' = doFmt (dateTimeFmt l)
 348         decode 'D' = doFmt "%m/%d/%y"
 349         decode 'd' = show2 day
 350         decode 'e' = show2' day
 351         decode 'H' = show2 hour
 352         decode 'I' = show2 (to12 hour)
 353         decode 'j' = show3 yday
 354         decode 'k' = show2' hour
 355         decode 'l' = show2' (to12 hour)
 356         decode 'M' = show2 min
 357         decode 'm' = show2 (fromEnum mon+1)
 358         decode 'n' = "\n"
 359         decode 'p' = (if hour < 12 then fst else snd) (amPm l)
 360         decode 'R' = doFmt "%H:%M"
 361         decode 'r' = doFmt (time12Fmt l)
 362         decode 'T' = doFmt "%H:%M:%S"
 363         decode 't' = "\t"
 364         decode 'S' = show2 sec
 365         decode 's' = show2 sec -- Implementation-dependent, sez the lib doc..
 366         decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7)
 367         decode 'u' = show (let n = fromEnum wday in
 368                            if n == 0 then 7 else n)
 369         decode 'V' =
 370             let (week, days) =
 371                    (yday + 7 - if fromEnum wday > 0 then
 372                                fromEnum wday - 1 else 6) `divMod` 7
 373             in  show2 (if days >= 4 then
 374                           week+1
 375                        else if week == 0 then 53 else week)
 376
 377         decode 'W' =
 378             show2 ((yday + 7 - if fromEnum wday > 0 then
 379                                fromEnum wday - 1 else 6) `div` 7)
 380         decode 'w' = show (fromEnum wday)
 381         decode 'X' = doFmt (timeFmt l)
 382         decode 'x' = doFmt (dateFmt l)
 383         decode 'Y' = show year
 384         decode 'y' = show2 (year `rem` 100)
 385         decode 'Z' = tzname
 386         decode '%' = "%"
 387         decode c   = [c]
 388
 389 show2, show2', show3 :: Int -> String
 390 show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)]
 391
 392 show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x
 393
 394 show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100)
 395 \end{code}