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