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