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