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
  58     showList = _showList (showsPrec 0)
  59 \end{code}
  60
  61
  62 $CalendarTime$ is a user-readable and manipulable
  63 representation of the internal $ClockTime$ type.  The
  64 numeric fields have the following ranges.
  65
  66 \begin{verbatim}
  67 Value         Range             Comments
  68 -----         -----             --------
  69
  70 year    -maxInt .. maxInt       [Pre-Gregorian dates are inaccurate]
  71 mon           0 .. 11           [Jan = 0, Dec = 11]
  72 day           1 .. 31
  73 hour          0 .. 23
  74 min           0 .. 59
  75 sec           0 .. 61           [Allows for two leap seconds]
  76 picosec       0 .. (10^12)-1    [This could be over-precise?]
  77 wday          0 .. 6            [Sunday = 0, Saturday = 6]
  78 yday          0 .. 365          [364 in non-Leap years]
  79 tz       -43200 .. 43200        [Variation from UTC in seconds]
  80 \end{verbatim}
  81
  82 The {\em tzname} field is the name of the time zone.  The {\em isdst}
  83 field indicates whether Daylight Savings Time would be in effect.
  84
  85 \begin{code}
  86 --                   year mon  day  hour min  sec  picosec wday yday tzname tz  isdst
  87 data CalendarTime =
  88        CalendarTime  Int  Int  Int  Int  Int  Int  Integer Int  Int  String Int Bool
  89 \end{code}
  90
  91 The $TimeDiff$ type records the difference between two clock times in
  92 a user-readable way.
  93
  94 \begin{code}
  95 --                          year mon  day  hour min  sec  picosec
  96 data TimeDiff    = TimeDiff Int  Int  Int  Int  Int  Int  Integer
  97                    deriving (Eq,Ord)
  98 \end{code}
  99
 100 $getClockTime$ returns the current time in its internal representation.
 101
 102 \begin{code}
 103 getClockTime :: IO ClockTime
 104 getClockTime =
 105     malloc1                                         `thenStrictlyST` \ i1 ->
 106     malloc1                                         `thenStrictlyST` \ i2 ->
 107     _ccall_ getClockTime i1 i2                      `thenPrimIO` \ rc ->
 108     if rc == 0 then
 109         cvtUnsigned i1                              `thenStrictlyST` \ sec ->
 110         cvtUnsigned i2                              `thenStrictlyST` \ nsec ->
 111         return (TOD sec (nsec * 1000))
 112     else
 113         _constructError                             `thenPrimIO` \ ioError ->
 114         failWith ioError
 115   where
 116     malloc1 (S# s#) =
 117         case newIntArray# 1# s# of
 118           StateAndMutableByteArray# s2# barr# -> (_MutableByteArray bot barr#, S# s2#)
 119     bot = error "getClockTime"
 120
 121     -- The C routine fills in an unsigned word.  We don't have `unsigned2Integer#,'
 122     -- so we freeze the data bits and use them for an MP_INT structure.  Note that
 123     -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably
 124     -- acceptable to gmp.
 125
 126     cvtUnsigned (_MutableByteArray _ arr#) (S# s#) =
 127         case readIntArray# arr# 0# s# of
 128           StateAndInt# s2# r# ->
 129             if r# ==# 0# then
 130                 (0, S# s2#)
 131             else
 132                 case unsafeFreezeByteArray# arr# s2# of
 133                   StateAndByteArray# s3# frozen# -> (J# 1# 1# frozen#, S# s3#)
 134
 135 \end{code}
 136
 137 $addToClockTime$ {\em d} {\em t} adds a time difference {\em d} and a
 138 clock time {\em t} to yield a new clock time.  The difference {\em d}
 139 may be either positive or negative.  $diffClockTimes$ {\em t1} {\em
 140 t2} returns the difference between two clock times {\em t1} and {\em
 141 t2} as a $TimeDiff$.
 142
 143
 144 \begin{code}
 145 addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
 146 addToClockTime _ _ = error "addToClockTime unimplemented"
 147
 148 diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
 149 diffClockTimes _ _ = error "diffClockTimes unimplemented"
 150 \end{code}
 151
 152 $toCalendarTime$ {\em t} converts {\em t} to a local time, modified by
 153 the current timezone and daylight savings time settings.  $toUTCTime$
 154 {\em t} converts {\em t} into UTC time.  $toClockTime$ {\em l}
 155 converts {\em l} into the corresponding internal $ClockTime$.  The
 156 {\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are
 157 ignored.
 158
 159 \begin{code}
 160 toCalendarTime :: ClockTime -> CalendarTime
 161 toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 162     allocWords (``sizeof(struct tm)''::Int) `thenPrimIO` \ res ->
 163     allocChars 32                           `thenPrimIO` \ zoneNm ->
 164     _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm   `thenPrimIO` \ () ->
 165     _ccall_ toLocalTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res
 166                                                     `thenPrimIO` \ tm ->
 167     if tm == (``NULL''::_Addr) then
 168         error "toCalendarTime{LibTime}: out of range"
 169     else
 170         _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm
 171                                                     `thenPrimIO` \ sec ->
 172         _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm
 173                                                     `thenPrimIO` \ min ->
 174         _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm
 175                                                     `thenPrimIO` \ hour ->
 176         _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm
 177                                                     `thenPrimIO` \ mday ->
 178         _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm
 179                                                     `thenPrimIO` \ mon ->
 180         _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm
 181                                                     `thenPrimIO` \ year ->
 182         _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm
 183                                                     `thenPrimIO` \ wday ->
 184         _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm
 185                                                     `thenPrimIO` \ yday ->
 186         _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm
 187                                                     `thenPrimIO` \ isdst ->
 188         _ccall_ ZONE tm                             `thenPrimIO` \ zone ->
 189         _ccall_ GMTOFF tm                           `thenPrimIO` \ tz ->
 190         _ccall_ strlen zone                         `thenPrimIO` \ len ->
 191         _packCBytesST len zone                      `thenStrictlyST` \ tzname ->
 192         returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec
 193                       wday yday (_unpackPS tzname) tz (isdst /= 0))
 194     )
 195
 196 toUTCTime :: ClockTime -> CalendarTime
 197 toUTCTime  (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO (
 198         allocWords (``sizeof(struct tm)''::Int)                     `thenPrimIO` \ res ->
 199         allocChars 32                                               `thenPrimIO` \ zoneNm ->
 200         _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm `thenPrimIO` \ () ->
 201         _ccall_ toUTCTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res
 202                                                     `thenPrimIO` \ tm ->
 203     if tm == (``NULL''::_Addr) then
 204         error "toUTCTime{LibTime}: out of range"
 205     else
 206         _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm
 207                                                     `thenPrimIO` \ sec ->
 208         _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm
 209                                                     `thenPrimIO` \ min ->
 210         _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm
 211                                                     `thenPrimIO` \ hour ->
 212         _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm
 213                                                     `thenPrimIO` \ mday ->
 214         _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm
 215                                                     `thenPrimIO` \ mon ->
 216         _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm
 217                                                     `thenPrimIO` \ year ->
 218         _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm
 219                                                     `thenPrimIO` \ wday ->
 220         _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm
 221                                                     `thenPrimIO` \ yday ->
 222         returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec
 223                       wday yday "UTC" 0 False)
 224     )
 225
 226 toClockTime :: CalendarTime -> ClockTime
 227 toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) =
 228     if psec < 0 || psec > 999999999999 then
 229         error "toClockTime{LibTime}: picoseconds out of range"
 230     else if tz < -43200 || tz > 43200 then
 231         error "toClockTime{LibTime}: timezone offset out of range"
 232     else
 233         unsafePerformPrimIO (
 234             allocWords (``sizeof(time_t)'') `thenPrimIO` \ res ->
 235             _ccall_ toClockSec year mon mday hour min sec tz res
 236                                                     `thenPrimIO` \ ptr@(A# ptr#) ->
 237             if ptr /= ``NULL'' then
 238                 returnPrimIO (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec)
 239             else
 240                 error "toClockTime{LibTime}: can't perform conversion"
 241         )
 242 \end{code}
 243