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