ghc/lib/haskell-1.3/LibTime.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 \section[LibTime]{Haskell 1.3 Time of Day Library}
   5
   6 The {\em LibTime} library provides the functionality of "time.h",
   7 adapted to the Haskell environment.  It includes timezone information,
   8 as in System V, and follows RFC 1129 in its use of Coordinated
   9 Universal Time (UTC).
  10
  11 \begin{code}
  12 module LibTime (
  13         CalendarTime(..),
  14         ClockTime,
  15         TimeDiff(..),
  16         addToClockTime,
  17         diffClockTimes,
  18         getClockTime,
  19         toCalendarTime,
  20         toUTCTime,
  21         toClockTime
  22     ) where
  23
  24 import PreludeIOError
  25 import PreludeGlaST
  26 import PS
  27 import LibPosixUtil (allocWords, allocChars)
  28
  29 \end{code}
  30
  31 $ClockTime$ is an abstract type, used for the internal clock time.
  32 Clock times may be compared, converted to strings, or converted to an
  33 external calendar time $CalendarTime$.
  34
  35 \begin{code}
  36 data ClockTime = TOD Integer Integer
  37                  deriving (Eq, Ord)
  38 \end{code}
  39
  40 When a $ClockTime$ is shown, it is converted to a string of the form
  41 $"Mon Nov 28 21:45:41 GMT 1994"$.
  42
  43 For now, we are restricted to roughly:
  44 Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because
  45 we use the C library routines based on 32 bit integers.
  46
  47 \begin{code}
  48 instance Text ClockTime where
  49     showsPrec p (TOD sec@(J# a# s# d#) nsec) =
  50         showString (unsafePerformPrimIO (
  51             allocChars 32       `thenPrimIO` \ buf ->
  52             _ccall_ showTime (I# s#) (_ByteArray (error "ClockTime.show") d#) buf
  53                                                     `thenPrimIO` \ str ->
  54             _ccall_ strlen str                      `thenPrimIO` \ len ->
  55             _packCBytesST len str                   `thenStrictlyST` \ ps ->
  56             returnPrimIO (_unpackPS ps)))
  57 \end{code}
  58
  59
  60 $CalendarTime$ is a user-readable and manipulable
  61 representation of the internal $ClockTime$ type.  The
  62 numeric fields have the following ranges.
  63
  64 \begin{verbatim}
  65 Value         Range             Comments
  66 -----         -----             --------
  67
  68 year    -maxInt .. maxInt       [Pre-Gregorian dates are inaccurate]
  69 mon           0 .. 11           [Jan = 0, Dec = 11]
  70 day           1 .. 31
  71 hour          0 .. 23
  72 min           0 .. 59
  73 sec           0 .. 61           [Allows for two leap seconds]
  74 picosec       0 .. (10^12)-1    [This could be over-precise?]
  75 wday          0 .. 6            [Sunday = 0, Saturday = 6]
  76 yday          0 .. 365          [364 in non-Leap years]
  77 tz       -43200 .. 43200        [Variation from UTC in seconds]
  78 \end{verbatim}
  79
  80 The {\em tzname} field is the name of the time zone.  The {\em isdst}
  81 field indicates whether Daylight Savings Time would be in effect.
  82
  83 \begin{code}
  84 --                   year mon  day  hour min  sec  picosec wday yday tzname tz  isdst
  85 data CalendarTime =
  86        CalendarTime  Int  Int  Int  Int  Int  Int  Integer Int  Int  String Int Bool
  87 \end{code}
  88
  89 The $TimeDiff$ type records the difference between two clock times in
  90 a user-readable way.
  91
  92 \begin{code}
  93 --                          year mon  day  hour min  sec  picosec
  94 data TimeDiff    = TimeDiff Int  Int  Int  Int  Int  Int  Integer
  95                    deriving (Eq,Ord)
  96 \end{code}
  97
  98 $getClockTime$ returns the current time in its internal representation.
  99
 100 \begin{code}
 101 getClockTime :: IO ClockTime
 102 getClockTime =
 103     malloc1                                         `thenStrictlyST` \ i1 ->
 104     malloc1                                         `thenStrictlyST` \ i2 ->
 105     _ccall_ getClockTime i1 i2                      `thenPrimIO` \ rc ->
 106     if rc == 0 then
 107         cvtUnsigned i1                              `thenStrictlyST` \ sec ->
 108         cvtUnsigned i2                              `thenStrictlyST` \ nsec ->
 109         return (TOD sec (nsec * 1000))
 110     else
 111         _constructError                             `thenPrimIO` \ ioError ->
 112         failWith ioError
 113   where
 114     malloc1 (S# s#) =
 115         case newIntArray# 1# s# of
 116           StateAndMutableByteArray# s2# barr# -> (_MutableByteArray bot barr#, S# s2#)
 117     bot = error "getClockTime"
 118
 119     -- The C routine fills in an unsigned word.  We don't have `unsigned2Integer#,'
 120     -- so we freeze the data bits and use them for an MP_INT structure.  Note that
 121     -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably
 122     -- acceptable to gmp.
 123
 124     cvtUnsigned (_MutableByteArray _ arr#) (S# s#) =
 125         case readIntArray# arr# 0# s# of
 126           StateAndInt# s2# r# ->
 127             if r# ==# 0# then
 128                 (0, S# s2#)
 129             else
 130                 case unsafeFreezeByteArray# arr# s2# of
 131                   StateAndByteArray# s3# frozen# -> (J# 1# 1# frozen#, S# s3#)
 132
 133 \end{code}
 134
 135 $addToClockTime$ {\em d} {\em t} adds a time difference {\em d} and a
 136 clock time {\em t} to yield a new clock time.  The difference {\em d}
 137 may be either positive or negative.  $diffClockTimes$ {\em t1} {\em
 138 t2} returns the difference between two clock times {\em t1} and {\em
 139 t2} as a $TimeDiff$.
 140
 141
 142 \begin{code}
 143 addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
 144 addToClockTime _ _ = error "addToClockTime unimplemented"
 145
 146 diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
 147 diffClockTimes _ _ = error "diffClockTimes unimplemented"
 148 \end{code}
 149
 150 $toCalendarTime$ {\em t} converts {\em t} to a local time, modified by
 151 the current timezone and daylight savings time settings.  $toUTCTime$
 152 {\em t} converts {\em t} into UTC time.  $toClockTime$ {\em l}
 153 converts {\em l} into the corresponding internal $ClockTime$.  The
 154 {\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are
 155 ignored.
 156
 157 \begin{code}
 158 toCalendarTime :: ClockTime -> CalendarTime
 159 toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 160     allocWords (``sizeof(struct tm)''::Int) `thenPrimIO` \ res ->
 161     allocChars 32                           `thenPrimIO` \ zoneNm ->
 162     _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm   `thenPrimIO` \ () ->
 163     _ccall_ toLocalTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res
 164                                                     `thenPrimIO` \ tm ->
 165     if tm == (``NULL''::_Addr) then
 166         error "toCalendarTime{LibTime}: out of range"
 167     else
 168         _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm
 169                                                     `thenPrimIO` \ sec ->
 170         _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm
 171                                                     `thenPrimIO` \ min ->
 172         _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm
 173                                                     `thenPrimIO` \ hour ->
 174         _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm
 175                                                     `thenPrimIO` \ mday ->
 176         _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm
 177                                                     `thenPrimIO` \ mon ->
 178         _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm
 179                                                     `thenPrimIO` \ year ->
 180         _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm
 181                                                     `thenPrimIO` \ wday ->
 182         _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm
 183                                                     `thenPrimIO` \ yday ->
 184         _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm
 185                                                     `thenPrimIO` \ isdst ->
 186         _ccall_ ZONE tm                             `thenPrimIO` \ zone ->
 187         _ccall_ GMTOFF tm                           `thenPrimIO` \ tz ->
 188         _ccall_ strlen zone                         `thenPrimIO` \ len ->
 189         _packCBytesST len zone                      `thenStrictlyST` \ tzname ->
 190         returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec
 191                       wday yday (_unpackPS tzname) tz (isdst /= 0))
 192     )
 193
 194 toUTCTime :: ClockTime -> CalendarTime
 195 toUTCTime  (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 196         allocWords (``sizeof(struct tm)''::Int)                     `thenPrimIO` \ res ->
 197         allocChars 32                                               `thenPrimIO` \ zoneNm ->
 198         _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm `thenPrimIO` \ () ->
 199         _ccall_ toUTCTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res
 200                                                     `thenPrimIO` \ tm ->
 201     if tm == (``NULL''::_Addr) then
 202         error "toUTCTime{LibTime}: out of range"
 203     else
 204         _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm
 205                                                     `thenPrimIO` \ sec ->
 206         _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm
 207                                                     `thenPrimIO` \ min ->
 208         _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm
 209                                                     `thenPrimIO` \ hour ->
 210         _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm
 211                                                     `thenPrimIO` \ mday ->
 212         _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm
 213                                                     `thenPrimIO` \ mon ->
 214         _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm
 215                                                     `thenPrimIO` \ year ->
 216         _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm
 217                                                     `thenPrimIO` \ wday ->
 218         _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm
 219                                                     `thenPrimIO` \ yday ->
 220         returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec
 221                       wday yday "UTC" 0 False)
 222     )
 223
 224 toClockTime :: CalendarTime -> ClockTime
 225 toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) =
 226     if psec < 0 || psec > 999999999999 then
 227         error "toClockTime{LibTime}: picoseconds out of range"
 228     else if tz < -43200 || tz > 43200 then
 229         error "toClockTime{LibTime}: timezone offset out of range"
 230     else
 231         unsafePerformPrimIO (
 232             allocWords (``sizeof(time_t)'') `thenPrimIO` \ res ->
 233             _ccall_ toClockSec year mon mday hour min sec tz res
 234                                                     `thenPrimIO` \ ptr@(A# ptr#) ->
 235             if ptr /= ``NULL'' then
 236                 returnPrimIO (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec)
 237             else
 238                 error "toClockTime{LibTime}: can't perform conversion"
 239         )
 240 \end{code}
 241