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