2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-99
4 \section[Time]{Haskell 1.4 Time of Day Library}
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).
12 {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h" #-}
18 , ClockTime(..) -- non-standard, lib. report gives this as abstract
22 , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.)
26 , timeDiffToString -- non-standard
27 , formatTimeDiff -- non-standard
33 , calendarTimeToString
41 import PrelGHC ( RealWorld, (>#), (<#), (==#),
42 newIntArray#, readIntArray#,
43 unsafeFreezeByteArray#,
44 int2Integer#, negateInt# )
45 import PrelBase ( Int(..) )
46 import PrelNum ( Integer(..), fromInt )
47 import PrelIOBase ( IO(..), unsafePerformIO, stToIO, constructErrorAndFail )
48 import PrelShow ( showList__ )
49 import PrelPack ( unpackCString, unpackCStringBA,
50 new_ps_array, freeze_ps_array
52 import PrelByteArr ( MutableByteArray(..) )
53 import PrelHandle ( Bytes )
54 import PrelAddr ( Addr )
59 import Char ( intToDigit )
64 One way to partition and give name to chunks of a year and a week:
68 = January | February | March | April
69 | May | June | July | August
70 | September | October | November | December
71 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
74 = Sunday | Monday | Tuesday | Wednesday
75 | Thursday | Friday | Saturday
76 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
80 @ClockTime@ is an abstract type, used for the internal clock time.
81 Clock times may be compared, converted to strings, or converted to an
82 external calendar time @CalendarTime@.
86 -- I believe Int64 is more than big enough.
87 -- In fact, I think one of Int32 or Word32 would do. - ADR
88 data ClockTime = TOD Int64 Int64 deriving (Eq, Ord)
90 data ClockTime = TOD Integer -- Seconds since 00:00:00 on 1 Jan 1970
91 Integer -- Picoseconds with the specified second
97 When a @ClockTime@ is shown, it is converted to a string of the form
98 @"Mon Nov 28 21:45:41 GMT 1994"@.
100 For now, we are restricted to roughly:
101 Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because
102 we use the C library routines based on 32 bit integers.
106 #warning Show ClockTime is bogus
107 instance Show ClockTime
109 instance Show ClockTime where
110 showsPrec p (TOD (S# i) _nsec) =
111 case int2Integer# i of (# s, d #) -> showsPrec p (TOD (J# s d) _nsec)
112 showsPrec _ (TOD (J# s# d#) _nsec) =
113 showString $ unsafePerformIO $ do
114 let buflen@(I# buflen#) = 50 -- big enough for error message
115 buf <- allocChars buflen
116 if s# <# (negateInt# 1#) || s# ># 1# then
117 return "ClockTime.show{Time}: out of range"
119 rc <- showTime (I# s#) d# buflen buf
121 return "ClockTime.show{Time}: internal error"
123 ba <- stToIO (freeze_ps_array buf buflen#)
124 return (unpackCStringBA ba)
126 showList = showList__ (showsPrec 0)
131 @CalendarTime@ is a user-readable and manipulable
132 representation of the internal $ClockTime$ type. The
133 numeric fields have the following ranges.
139 year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate]
140 mon 0 .. 11 [Jan = 0, Dec = 11]
144 sec 0 .. 61 [Allows for two leap seconds]
145 picosec 0 .. (10^12)-1 [This could be over-precise?]
146 wday 0 .. 6 [Sunday = 0, Saturday = 6]
147 yday 0 .. 365 [364 in non-Leap years]
148 tz -43200 .. 43200 [Variation from UTC in seconds]
151 The {\em tzname} field is the name of the time zone. The {\em isdst}
152 field indicates whether Daylight Savings Time would be in effect.
166 ctPicosec :: Integer,
174 deriving (Eq,Ord,Read,Show)
178 The @TimeDiff@ type records the difference between two clock times in
191 tdPicosec :: Int64 -- not standard
193 tdPicosec :: Integer -- not standard
196 deriving (Eq,Ord,Read,Show)
198 noTimeDiff :: TimeDiff
199 noTimeDiff = TimeDiff 0 0 0 0 0 0 0
202 @getClockTime@ returns the current time in its internal representation.
205 getClockTime :: IO ClockTime
209 rc <- primGetClockTime i1 i2
212 sec <- cvtUnsigned i1
213 nsec <- cvtUnsigned i2
214 return (TOD sec (nsec * 1000))
216 constructErrorAndFail "getClockTime"
219 malloc1 = primNewByteArray sizeof_int64
220 cvtUnsigned arr = primReadInt64Array arr 0
222 malloc1 :: IO (MutableByteArray RealWorld Int)
223 malloc1 = IO $ \ s# ->
224 case newIntArray# 1# s# of
225 (# s2#, barr# #) -> (# s2#, MutableByteArray bot bot barr# #)
227 bot = error "Time.malloc1"
229 -- The C routine fills in an unsigned word. We don't have
230 -- `unsigned2Integer#,' so we freeze the data bits and use them
231 -- for an MP_INT structure. Note that zero is still handled specially,
232 -- although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
234 cvtUnsigned :: MutableByteArray RealWorld Int -> IO Integer
235 cvtUnsigned (MutableByteArray _ _ arr#) = IO $ \ s# ->
236 case readIntArray# arr# 0# s# of
237 (# s2#, r# #) | r# ==# 0# -> (# s2#, 0 #)
239 case unsafeFreezeByteArray# arr# s2# of
240 (# s3#, frozen# #) -> (# s3#, J# 1# frozen# #)
244 @addToClockTime@ {\em d} {\em t} adds a time difference {\em d} and a
245 clock time {\em t} to yield a new clock time. The difference {\em d}
246 may be either positive or negative. @[diffClockTimes@ {\em t1} {\em
247 t2} returns the difference between two clock times {\em t1} and {\em
252 addToClockTime :: TimeDiff -> ClockTime -> ClockTime
253 addToClockTime (TimeDiff year mon day hour min sec psec)
256 sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day
257 cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec))
259 new_mon = fromEnum (ctMonth cal) + r_mon
261 | new_mon < 0 = (toEnum (12 + new_mon), (-1))
262 | new_mon > 11 = (toEnum (new_mon `mod` 12), 1)
263 | otherwise = (toEnum new_mon, 0)
265 (r_yr, r_mon) = mon `quotRem` 12
267 year' = ctYear cal + year + r_yr + yr_diff
269 toClockTime cal{ctMonth=month', ctYear=year'}
271 diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
272 diffClockTimes tod_a tod_b =
274 CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toUTCTime tod_a
275 CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toUTCTime tod_b
277 TimeDiff (year_a - year_b)
278 (fromEnum mon_a - fromEnum mon_b)
286 @toCalendarTime@ {\em t} converts {\em t} to a local time, modified by
287 the current timezone and daylight savings time settings. @toUTCTime@
288 {\em t} converts {\em t} into UTC time. @toClockTime@ {\em l}
289 converts {\em l} into the corresponding internal @ClockTime@. The
290 {\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are
295 toCalendarTime :: ClockTime -> IO CalendarTime
296 toCalendarTime (TOD sec psec) = do
297 res <- allocWords sizeof_int64
298 zoneNm <- allocChars 32
299 prim_SETZONE res zoneNm
300 rc <- prim_toLocalTime sec res
302 then constructErrorAndFail "Time.toCalendarTime: out of range"
304 sec <- get_tm_sec res
305 min <- get_tm_min res
306 hour <- get_tm_hour res
307 mday <- get_tm_mday res
308 mon <- get_tm_mon res
309 year <- get_tm_year res
310 wday <- get_tm_wday res
311 yday <- get_tm_yday res
312 isdst <- get_tm_isdst res
313 zone <- prim_ZONE res
314 tz <- prim_GMTOFF res
315 tzname <- primUnpackCString zone
316 return (CalendarTime (1900+year) mon mday hour min sec psec
317 (toEnum wday) yday tzname tz (isdst /= 0))
319 toUTCTime :: ClockTime -> CalendarTime
320 toUTCTime (TOD sec psec) = unsafePerformIO $ do
321 res <- allocWords sizeof_int64
322 zoneNm <- allocChars 32
323 prim_SETZONE res zoneNm
324 rc <- prim_toUTCTime sec res
326 then error "Time.toUTCTime: out of range"
328 sec <- get_tm_sec res
329 min <- get_tm_min res
330 hour <- get_tm_hour res
331 mday <- get_tm_mday res
332 mon <- get_tm_mon res
333 year <- get_tm_year res
334 wday <- get_tm_wday res
335 yday <- get_tm_yday res
336 return (CalendarTime (1900+year) mon mday hour min sec psec
337 (toEnum wday) yday "UTC" 0 False)
339 toClockTime :: CalendarTime -> ClockTime
340 toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) =
341 if psec < 0 || psec > 999999999999 then
342 error "Time.toClockTime: picoseconds out of range"
343 else if tz < -43200 || tz > 43200 then
344 error "Time.toClockTime: timezone offset out of range"
347 res <- allocWords sizeof_int64
348 rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res
351 tm <- primReadInt64Array res 0
353 else error "Time.toClockTime: can't perform conversion"
356 isDst = if isdst then (1::Int) else 0
358 toCalendarTime :: ClockTime -> IO CalendarTime
359 toCalendarTime (TOD (S# i) psec)
360 = case int2Integer# i of (# s, d #) -> toCalendarTime (TOD (J# s d) psec)
361 toCalendarTime (TOD (J# s# d#) psec) = do
362 res <- allocWords sizeof_struct_tm
363 zoneNm <- allocChars 32
364 prim_SETZONE res zoneNm
365 rc <- prim_toLocalTime (I# s#) d# res
367 then constructErrorAndFail "Time.toCalendarTime: out of range"
369 sec <- get_tm_sec res
370 min <- get_tm_min res
371 hour <- get_tm_hour res
372 mday <- get_tm_mday res
373 mon <- get_tm_mon res
374 year <- get_tm_year res
375 wday <- get_tm_wday res
376 yday <- get_tm_yday res
377 isdst <- get_tm_isdst res
380 let tzname = unpackCString zone
382 | mon >= 0 && mon <= 11 = toEnum mon
383 | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon)
385 return (CalendarTime (1900+year) month mday hour min sec psec
386 (toEnum wday) yday tzname tz (isdst /= (0::Int)))
388 toUTCTime :: ClockTime -> CalendarTime
389 toUTCTime (TOD (S# i) psec)
390 = case int2Integer# i of (# s, d #) -> toUTCTime (TOD (J# s d) psec)
391 toUTCTime (TOD (J# s# d#) psec) = unsafePerformIO $ do
392 res <- allocWords sizeof_struct_tm
393 zoneNm <- allocChars 32
394 prim_SETZONE res zoneNm
395 rc <- prim_toUTCTime (I# s#) d# res
397 then error "Time.toUTCTime: out of range"
399 sec <- get_tm_sec res
400 min <- get_tm_min res
401 hour <- get_tm_hour res
402 mday <- get_tm_mday res
403 mon <- get_tm_mon res
404 year <- get_tm_year res
405 wday <- get_tm_wday res
406 yday <- get_tm_yday res
409 | mon >= 0 && mon <= 11 = toEnum mon
410 | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon)
412 return (CalendarTime (1900+year) month mday hour min sec psec
413 (toEnum wday) yday "UTC" 0 False)
415 toClockTime :: CalendarTime -> ClockTime
416 toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz isdst) =
417 if psec < 0 || psec > 999999999999 then
418 error "Time.toClockTime: picoseconds out of range"
419 else if tz < -43200 || tz > 43200 then
420 error "Time.toClockTime: timezone offset out of range"
424 rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res
429 else error "Time.toClockTime: can't perform conversion"
432 isDst = if isdst then (1::Int) else 0
436 -- (copied from PosixUtil, for now)
437 -- Allocate a mutable array of characters with no indices.
440 allocChars :: Int -> IO (PrimMutableByteArray RealWorld)
441 allocChars size = primNewByteArray size
443 -- Allocate a mutable array of words with no indices
445 allocWords :: Int -> IO (PrimMutableByteArray RealWorld)
446 allocWords size = primNewByteArray size
448 allocChars :: Int -> IO (MutableByteArray RealWorld Int)
449 allocChars (I# size#) = stToIO (new_ps_array size#)
451 -- Allocate a mutable array of words with no indices
453 allocWords :: Int -> IO (MutableByteArray RealWorld Int)
454 allocWords (I# size#) = IO $ \ s# ->
455 case newIntArray# size# s# of
457 (# s2#, MutableByteArray bot bot barr# #)
459 bot = error "Time.allocWords"
464 calendarTimeToString :: CalendarTime -> String
465 calendarTimeToString = formatCalendarTime defaultTimeLocale "%c"
467 formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
468 formatCalendarTime l fmt (CalendarTime year mon day hour min sec _
469 wday yday tzname _ _) =
471 where doFmt ('%':c:cs) = decode c ++ doFmt cs
472 doFmt (c:cs) = c : doFmt cs
475 decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name
476 decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev.
477 decode 'B' = fst (months l !! fromEnum mon) -- month, full name
478 decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev
479 decode 'h' = snd (months l !! fromEnum mon) -- ditto
480 decode 'C' = show2 (year `quot` 100) -- century
481 decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format.
482 decode 'D' = doFmt "%m/%d/%y"
483 decode 'd' = show2 day -- day of the month
484 decode 'e' = show2' day -- ditto, padded
485 decode 'H' = show2 hour -- hours, 24-hour clock, padded
486 decode 'I' = show2 (to12 hour) -- hours, 12-hour clock
487 decode 'j' = show3 yday -- day of the year
488 decode 'k' = show2' hour -- hours, 24-hour clock, no padding
489 decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding
490 decode 'M' = show2 min -- minutes
491 decode 'm' = show2 (fromEnum mon+1) -- numeric month
493 decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm
494 decode 'R' = doFmt "%H:%M"
495 decode 'r' = doFmt (time12Fmt l)
496 decode 'T' = doFmt "%H:%M:%S"
498 decode 'S' = show2 sec -- seconds
499 decode 's' = show2 sec -- number of secs since Epoch. (ToDo.)
500 decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday.
501 decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday)
502 if n == 0 then 7 else n)
503 decode 'V' = -- week number (as per ISO-8601.)
504 let (week, days) = -- [yep, I've always wanted to be able to display that too.]
505 (yday + 7 - if fromEnum wday > 0 then
506 fromEnum wday - 1 else 6) `divMod` 7
507 in show2 (if days >= 4 then
509 else if week == 0 then 53 else week)
511 decode 'W' = -- week number, weeks starting on monday
512 show2 ((yday + 7 - if fromEnum wday > 0 then
513 fromEnum wday - 1 else 6) `div` 7)
514 decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday.
515 decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time.
516 decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates.
517 decode 'Y' = show year -- year, including century.
518 decode 'y' = show2 (year `rem` 100) -- year, within century.
519 decode 'Z' = tzname -- timezone name
524 show2, show2', show3 :: Int -> String
525 show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)]
527 show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x
529 show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100)
532 to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'
535 Useful extensions for formatting TimeDiffs.
538 timeDiffToString :: TimeDiff -> String
539 timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
541 formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
542 formatTimeDiff l fmt (TimeDiff year month day hour min sec _)
546 doFmt ('%':c:cs) = decode c ++ doFmt cs
547 doFmt (c:cs) = c : doFmt cs
551 'B' -> fst (months l !! fromEnum month)
552 'b' -> snd (months l !! fromEnum month)
553 'h' -> snd (months l !! fromEnum month)
554 'C' -> show2 (year `quot` 100)
555 'D' -> doFmt "%m/%d/%y"
559 'I' -> show2 (to12 hour)
561 'l' -> show2' (to12 hour)
563 'm' -> show2 (fromEnum month + 1)
565 'p' -> (if hour < 12 then fst else snd) (amPm l)
567 'r' -> doFmt (time12Fmt l)
568 'T' -> doFmt "%H:%M:%S"
571 's' -> show2 sec -- Implementation-dependent, sez the lib doc..
572 'X' -> doFmt (timeFmt l)
573 'x' -> doFmt (dateFmt l)
575 'y' -> show2 (year `rem` 100)
582 foreign import "libHS_cbits" "get_tm_sec" unsafe get_tm_sec :: MBytes -> IO Int
583 foreign import "libHS_cbits" "get_tm_min" unsafe get_tm_min :: MBytes -> IO Int
584 foreign import "libHS_cbits" "get_tm_hour" unsafe get_tm_hour :: MBytes -> IO Int
585 foreign import "libHS_cbits" "get_tm_mday" unsafe get_tm_mday :: MBytes -> IO Int
586 foreign import "libHS_cbits" "get_tm_mon" unsafe get_tm_mon :: MBytes -> IO Int
587 foreign import "libHS_cbits" "get_tm_year" unsafe get_tm_year :: MBytes -> IO Int
588 foreign import "libHS_cbits" "get_tm_wday" unsafe get_tm_wday :: MBytes -> IO Int
589 foreign import "libHS_cbits" "get_tm_yday" unsafe get_tm_yday :: MBytes -> IO Int
590 foreign import "libHS_cbits" "get_tm_isdst" unsafe get_tm_isdst :: MBytes -> IO Int
592 foreign import "libHS_cbits" "prim_ZONE" prim_ZONE :: Bytes -> IO Addr
593 foreign import "libHS_cbits" "prim_GMTOFF" prim_GMTOFF :: Bytes -> IO Int
595 foreign import "libHS_cbits" "sizeof_struct_tm" sizeof_struct_tm :: Int
598 -- believed to be at least 1 bit (the sign bit!) bigger than sizeof_time_t
603 type MBytes = MutableByteArray RealWorld Int
605 foreign import "libHS_cbits" "sizeof_time_t" sizeof_time_t :: Int
607 foreign import "libHS_cbits" "prim_SETZONE" unsafe prim_SETZONE :: MBytes -> MBytes -> IO ()
609 foreign import "libHS_cbits" "prim_toLocalTime" unsafe prim_toLocalTime :: Int64 -> MBytes -> IO Int
610 foreign import "libHS_cbits" "prim_toUTCTime" unsafe prim_toUTCTime :: Int64 -> MBytes -> IO Int
612 foreign import "libHS_cbits" "toLocalTime" unsafe prim_toLocalTime :: Int -> Bytes -> MBytes -> IO Int
613 foreign import "libHS_cbits" "toUTCTime" unsafe prim_toUTCTime :: Int -> Bytes -> MBytes -> IO Int
616 foreign import "libHS_cbits" "get_ZONE" unsafe get_ZONE :: MBytes -> IO Addr
617 foreign import "libHS_cbits" "GMTOFF" unsafe get_GMTOFF :: MBytes -> IO Int
620 foreign import "libHS_cbits" "toClockSec" unsafe
621 toClockSec :: Int -> Int -> Int -> Int -> Int
622 -> Int -> Int -> MBytes -> IO Int
624 foreign import "libHS_cbits" "getClockTime" unsafe
625 primGetClockTime :: MutableByteArray RealWorld Int
626 -> MutableByteArray RealWorld Int
628 foreign import "libHS_cbits" "showTime" unsafe