1 -----------------------------------------------------------------------------
3 -- Module : System.Time
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
11 -- The standard Time library, providing standard functionality for clock
12 -- times, including timezone information (i.e, the functionality of
13 -- \"@time.h@\", adapted to the Haskell environment). It follows RFC
14 -- 1129 in its use of Coordinated Universal Time (UTC).
15 -----------------------------------------------------------------------------
18 Haskell 98 Time of Day Library
19 ------------------------------
21 2000/06/17 <michael.weber@post.rwth-aachen.de>:
23 * min./max. time diff currently is restricted to
24 [minBound::Int, maxBound::Int]
26 * surely other restrictions wrt. min/max bounds
32 `showTime' (used in `instance Show ClockTime') always prints time
33 converted to the local timezone (even if it is taken from
34 `(toClockTime . toUTCTime)'), whereas `calendarTimeToString'
35 honors the tzone & tz fields and prints UTC or whatever timezone
36 is stored inside CalendarTime.
38 Maybe `showTime' should be changed to use UTC, since it would
39 better correspond to the actual representation of `ClockTime'
40 (can be done by replacing localtime(3) by gmtime(3)).
44 * add proper handling of microsecs, currently, they're mostly
47 * `formatFOO' case of `%s' is currently broken...
51 * check for unusual date cases, like 1970/1/1 00:00h, and conversions
52 between different timezone's etc.
54 * check, what needs to be in the IO monad, the current situation
55 seems to be a bit inconsistent to me
57 * check whether `isDst = -1' works as expected on other arch's
60 * add functions to parse strings to `CalendarTime' (some day...)
62 * implement padding capabilities ("%_", "%-") in `formatFOO'
64 * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO'
71 ClockTime(..) -- non-standard, lib. report gives this as abstract
73 -- instance Show (non-standard)
80 , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.)
84 , normalizeTimeDiff -- non-standard
85 , timeDiffToString -- non-standard
86 , formatTimeDiff -- non-standard
96 , calendarTimeToString
101 #ifdef __GLASGOW_HASKELL__
107 # if defined(__sun) || defined(__CYGWIN32__)
108 # define HAVE_TZNAME 1
110 # define HAVE_TM_ZONE 1
119 import System.IO.Unsafe
122 import Hugs.Time ( getClockTimePrim, toCalTimePrim, toClockTimePrim )
128 -- One way to partition and give name to chunks of a year and a week:
130 -- | A month of the year.
133 = January | February | March | April
134 | May | June | July | August
135 | September | October | November | December
136 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
138 -- | A day of the week.
141 = Sunday | Monday | Tuesday | Wednesday
142 | Thursday | Friday | Saturday
143 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
145 -- | A representation of the internal clock time.
146 -- Clock times may be compared, converted to strings, or converted to an
147 -- external calendar time 'CalendarTime' for I\/O or other manipulations.
149 data ClockTime = TOD Integer Integer
150 -- ^ Construct a clock time. The arguments are a number
151 -- of seconds since 00:00:00 (UTC) on 1 January 1970,
152 -- and an additional number of picoseconds.
154 -- In Haskell 98, the 'ClockTime' type is abstract.
157 -- When a ClockTime is shown, it is converted to a CalendarTime in the current
158 -- timezone and then printed. FIXME: This is arguably wrong, since we can't
159 -- get the current timezone without being in the IO monad.
161 instance Show ClockTime where
162 showsPrec _ t = showString (calendarTimeToString
163 (unsafePerformIO (toCalendarTime t)))
166 The numeric fields have the following ranges.
172 year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate]
176 sec 0 .. 61 [Allows for two leap seconds]
177 picosec 0 .. (10^12)-1 [This could be over-precise?]
178 yday 0 .. 365 [364 in non-Leap years]
179 tz -43200 .. 43200 [Variation from UTC in seconds]
183 -- | 'CalendarTime' is a user-readable and manipulable
184 -- representation of the internal 'ClockTime' type.
188 ctYear :: Int -- ^ Year (pre-Gregorian dates are inaccurate)
189 , ctMonth :: Month -- ^ Month of the year
190 , ctDay :: Int -- ^ Day of the month (1 to 31)
191 , ctHour :: Int -- ^ Hour of the day (0 to 23)
192 , ctMin :: Int -- ^ Minutes (0 to 59)
193 , ctSec :: Int -- ^ Seconds (0 to 61, allowing for up to
195 , ctPicosec :: Integer -- ^ Picoseconds
196 , ctWDay :: Day -- ^ Day of the week
197 , ctYDay :: Int -- ^ Day of the year
198 -- (0 to 364, or 365 in leap years)
199 , ctTZName :: String -- ^ Name of the time zone
200 , ctTZ :: Int -- ^ Variation from UTC in seconds
201 , ctIsDST :: Bool -- ^ 'True' if Daylight Savings Time would
202 -- be in effect, and 'False' otherwise
204 deriving (Eq,Ord,Read,Show)
206 -- | records the difference between two clock times in a user-readable way.
216 tdPicosec :: Integer -- not standard
218 deriving (Eq,Ord,Read,Show)
220 -- | null time difference.
222 noTimeDiff :: TimeDiff
223 noTimeDiff = TimeDiff 0 0 0 0 0 0 0
225 -- -----------------------------------------------------------------------------
226 -- | returns the current time in its internal representation.
228 getClockTime :: IO ClockTime
231 (sec,usec) <- getClockTimePrim
232 return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000))
234 #elif HAVE_GETTIMEOFDAY
236 let realToInteger = round . realToFrac :: Real a => a -> Integer
237 allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do
238 throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr
239 sec <- (#peek struct timeval,tv_sec) p_timeval :: IO CTime
240 usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime
241 return (TOD (realToInteger sec) ((realToInteger usec) * 1000000))
245 let realToInteger = round . realToFrac :: Real a => a -> Integer
246 allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do
248 sec <- (#peek struct timeb,time) p_timeb :: IO CTime
249 msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort
250 return (TOD (realToInteger sec) (fromIntegral msec * 1000000000))
252 #else /* use POSIX time() */
254 secs <- time nullPtr -- can't fail, according to POSIX
255 let realToInteger = round . realToFrac :: Real a => a -> Integer
256 return (TOD (realToInteger secs) 0)
260 -- -----------------------------------------------------------------------------
261 -- | @'addToClockTime' d t@ adds a time difference @d@ and a
262 -- clock time @t@ to yield a new clock time. The difference @d@
263 -- may be either positive or negative.
265 addToClockTime :: TimeDiff -> ClockTime -> ClockTime
266 addToClockTime (TimeDiff year mon day hour min sec psec)
269 sec_diff = toInteger sec +
271 3600 * toInteger hour +
272 24 * 3600 * toInteger day
273 (d_sec, d_psec) = (c_psec + psec) `quotRem` 1000000000000
274 cal = toUTCTime (TOD (c_sec + sec_diff + d_sec) d_psec)
275 new_mon = fromEnum (ctMonth cal) + r_mon
279 | new_mon < 0 = (toEnum (12 + new_mon), (-1))
280 | new_mon > 11 = (toEnum (new_mon `mod` 12), 1)
281 | otherwise = (toEnum new_mon, 0)
283 (r_yr, r_mon) = mon `quotRem` 12
285 year' = ctYear cal + year + r_yr + yr_diff
287 toClockTime cal{ctMonth=month', ctYear=year'}
289 -- | @'diffClockTimes' t1 t2@ returns the difference between two clock
290 -- times @t1@ and @t2@ as a 'TimeDiff'.
292 diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
293 -- diffClockTimes is meant to be the dual to `addToClockTime'.
294 -- If you want to have the TimeDiff properly splitted, use
295 -- `normalizeTimeDiff' on this function's result
297 -- CAVEAT: see comment of normalizeTimeDiff
298 diffClockTimes (TOD sa pa) (TOD sb pb) =
299 noTimeDiff{ tdSec = fromIntegral (sa - sb)
300 -- FIXME: can handle just 68 years...
301 , tdPicosec = pa - pb
305 -- | converts a time difference to normal form.
307 normalizeTimeDiff :: TimeDiff -> TimeDiff
308 -- FIXME: handle psecs properly
309 -- FIXME: ?should be called by formatTimeDiff automagically?
311 -- when applied to something coming out of `diffClockTimes', you loose
312 -- the duality to `addToClockTime', since a year does not always have
315 -- apply this function as late as possible to prevent those "rounding"
317 normalizeTimeDiff td =
319 rest0 = toInteger (tdSec td)
320 + 60 * (toInteger (tdMin td)
321 + 60 * (toInteger (tdHour td)
322 + 24 * (toInteger (tdDay td)
323 + 30 * toInteger (tdMonth td)
324 + 365 * toInteger (tdYear td))))
326 (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600)
327 (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600)
328 (diffDays, rest3) = rest2 `quotRem` (24 * 3600)
329 (diffHours, rest4) = rest3 `quotRem` 3600
330 (diffMins, diffSecs) = rest4 `quotRem` 60
332 td{ tdYear = fromInteger diffYears
333 , tdMonth = fromInteger diffMonths
334 , tdDay = fromInteger diffDays
335 , tdHour = fromInteger diffHours
336 , tdMin = fromInteger diffMins
337 , tdSec = fromInteger diffSecs
341 -- -----------------------------------------------------------------------------
342 -- How do we deal with timezones on this architecture?
344 -- The POSIX way to do it is through the global variable tzname[].
345 -- But that's crap, so we do it The BSD Way if we can: namely use the
346 -- tm_zone and tm_gmtoff fields of struct tm, if they're available.
348 zone :: Ptr CTm -> IO (Ptr CChar)
349 gmtoff :: Ptr CTm -> IO CLong
351 zone x = (#peek struct tm,tm_zone) x
352 gmtoff x = (#peek struct tm,tm_gmtoff) x
354 #else /* ! HAVE_TM_ZONE */
355 # if HAVE_TZNAME || defined(_WIN32)
356 # if cygwin32_HOST_OS
357 # define tzname _tzname
359 # ifndef mingw32_HOST_OS
360 foreign import ccall unsafe "time.h &tzname" tzname :: Ptr CString
362 foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong
363 foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr CString
366 dst <- (#peek struct tm,tm_isdst) x
367 if dst then peekElemOff tzname 1 else peekElemOff tzname 0
368 # else /* ! HAVE_TZNAME */
369 -- We're in trouble. If you should end up here, please report this as a bug.
370 # error "Don't know how to get at timezone name on your OS."
371 # endif /* ! HAVE_TZNAME */
373 -- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */
374 # if HAVE_DECL_ALTZONE
375 foreign import ccall "&altzone" altzone :: Ptr CTime
376 foreign import ccall "&timezone" timezone :: Ptr CTime
378 dst <- (#peek struct tm,tm_isdst) x
379 tz <- if dst then peek altzone else peek timezone
380 let realToInteger = round . realToFrac :: Real a => a -> Integer
381 return (-fromIntegral (realToInteger tz))
382 # else /* ! HAVE_DECL_ALTZONE */
384 #if !defined(mingw32_HOST_OS)
385 foreign import ccall "time.h &timezone" timezone :: Ptr CLong
388 -- Assume that DST offset is 1 hour ...
390 dst <- (#peek struct tm,tm_isdst) x
392 -- According to the documentation for tzset(),
393 -- http://www.opengroup.org/onlinepubs/007908799/xsh/tzset.html
394 -- timezone offsets are > 0 west of the Prime Meridian.
396 -- This module assumes the interpretation of tm_gmtoff, i.e., offsets
397 -- are > 0 East of the Prime Meridian, so flip the sign.
398 return (- (if dst then (fromIntegral tz - 3600) else tz))
399 # endif /* ! HAVE_DECL_ALTZONE */
400 #endif /* ! HAVE_TM_ZONE */
401 #endif /* ! __HUGS__ */
403 -- -----------------------------------------------------------------------------
404 -- | converts an internal clock time to a local time, modified by the
405 -- timezone and daylight savings time settings in force at the time
406 -- of conversion. Because of this dependence on the local environment,
407 -- 'toCalendarTime' is in the 'IO' monad.
409 toCalendarTime :: ClockTime -> IO CalendarTime
411 toCalendarTime = toCalTime False
412 #elif HAVE_LOCALTIME_R
413 toCalendarTime = clockToCalendarTime_reentrant (throwAwayReturnPointer localtime_r) False
415 toCalendarTime = clockToCalendarTime_static localtime False
418 -- | converts an internal clock time into a 'CalendarTime' in standard
421 toUTCTime :: ClockTime -> CalendarTime
423 toUTCTime = unsafePerformIO . toCalTime True
425 toUTCTime = unsafePerformIO . clockToCalendarTime_reentrant (throwAwayReturnPointer gmtime_r) True
427 toUTCTime = unsafePerformIO . clockToCalendarTime_static gmtime True
431 toCalTime :: Bool -> ClockTime -> IO CalendarTime
432 toCalTime toUTC (TOD s psecs)
433 | (s > fromIntegral (maxBound :: Int)) ||
434 (s < fromIntegral (minBound :: Int))
435 = error ((if toUTC then "toUTCTime: " else "toCalendarTime: ") ++
436 "clock secs out of range")
438 (sec,min,hour,mday,mon,year,wday,yday,isdst,zone,off) <-
439 toCalTimePrim (if toUTC then 1 else 0) (fromIntegral s)
440 return (CalendarTime{ ctYear=1900+year
449 , ctTZName=(if toUTC then "UTC" else zone)
450 , ctTZ=(if toUTC then 0 else off)
451 , ctIsDST=not toUTC && (isdst/=0)
453 #else /* ! __HUGS__ */
454 throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm))
455 -> (Ptr CTime -> Ptr CTm -> IO ( ))
456 throwAwayReturnPointer fun x y = fun x y >> return ()
458 #if !HAVE_LOCALTIME_R || !HAVE_GMTIME_R
459 clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime
461 clockToCalendarTime_static fun is_utc (TOD secs psec) = do
462 with (fromIntegral secs :: CTime) $ \ p_timer -> do
463 p_tm <- fun p_timer -- can't fail, according to POSIX
464 clockToCalendarTime_aux is_utc p_tm psec
467 #if HAVE_LOCALTIME_R || HAVE_GMTIME_R
468 clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime
470 clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do
471 with (fromIntegral secs :: CTime) $ \ p_timer -> do
472 allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do
474 clockToCalendarTime_aux is_utc p_tm psec
477 clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime
478 clockToCalendarTime_aux is_utc p_tm psec = do
479 sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt
480 min <- (#peek struct tm,tm_min ) p_tm :: IO CInt
481 hour <- (#peek struct tm,tm_hour ) p_tm :: IO CInt
482 mday <- (#peek struct tm,tm_mday ) p_tm :: IO CInt
483 mon <- (#peek struct tm,tm_mon ) p_tm :: IO CInt
484 year <- (#peek struct tm,tm_year ) p_tm :: IO CInt
485 wday <- (#peek struct tm,tm_wday ) p_tm :: IO CInt
486 yday <- (#peek struct tm,tm_yday ) p_tm :: IO CInt
487 isdst <- (#peek struct tm,tm_isdst) p_tm :: IO CInt
491 tzname <- peekCString zone
493 let month | mon >= 0 && mon <= 11 = toEnum (fromIntegral mon)
494 | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon)
497 (1900 + fromIntegral year)
504 (toEnum (fromIntegral wday))
506 (if is_utc then "UTC" else tzname)
507 (if is_utc then 0 else fromIntegral tz)
508 (if is_utc then False else isdst /= 0))
509 #endif /* ! __HUGS__ */
511 -- | converts a 'CalendarTime' into the corresponding internal
512 -- 'ClockTime', ignoring the contents of the 'ctWDay', 'ctYDay',
513 -- 'ctTZName' and 'ctIsDST' fields.
515 toClockTime :: CalendarTime -> ClockTime
517 toClockTime (CalendarTime yr mon mday hour min sec psec
518 _wday _yday _tzname tz _isdst) =
520 s <- toClockTimePrim (yr-1900) (fromEnum mon) mday hour min sec tz
521 return (TOD (fromIntegral s) psec)
522 #else /* ! __HUGS__ */
523 toClockTime (CalendarTime year mon mday hour min sec psec
524 _wday _yday _tzname tz isdst) =
526 -- `isDst' causes the date to be wrong by one hour...
527 -- FIXME: check, whether this works on other arch's than Linux, too...
529 -- so we set it to (-1) (means `unknown') and let `mktime' determine
531 let isDst = -1 :: CInt in -- if isdst then (1::Int) else 0
533 if psec < 0 || psec > 999999999999 then
534 error "Time.toClockTime: picoseconds out of range"
535 else if tz < -43200 || tz > 43200 then
536 error "Time.toClockTime: timezone offset out of range"
539 allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do
540 (#poke struct tm,tm_sec ) p_tm (fromIntegral sec :: CInt)
541 (#poke struct tm,tm_min ) p_tm (fromIntegral min :: CInt)
542 (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt)
543 (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt)
544 (#poke struct tm,tm_mon ) p_tm (fromIntegral (fromEnum mon) :: CInt)
545 (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt)
546 (#poke struct tm,tm_isdst) p_tm isDst
547 t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input")
550 -- mktime expects its argument to be in the local timezone, but
551 -- toUTCTime makes UTC-encoded CalendarTime's ...
553 -- Since there is no any_tz_struct_tm-to-time_t conversion
554 -- function, we have to fake one... :-) If not in all, it works in
555 -- most cases (before, it was the other way round...)
557 -- Luckily, mktime tells us, what it *thinks* the timezone is, so,
558 -- to compensate, we add the timezone difference to mktime's
561 gmtoff <- gmtoff p_tm
562 let realToInteger = round . realToFrac :: Real a => a -> Integer
563 res = realToInteger t - fromIntegral tz + fromIntegral gmtoff
564 return (TOD res psec)
565 #endif /* ! __HUGS__ */
567 -- -----------------------------------------------------------------------------
568 -- Converting time values to strings.
570 -- | formats calendar times using local conventions.
572 calendarTimeToString :: CalendarTime -> String
573 calendarTimeToString = formatCalendarTime defaultTimeLocale "%c"
575 -- | formats calendar times using local conventions and a formatting string.
576 -- The formatting string is that understood by the ISO C @strftime()@
579 formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
580 formatCalendarTime l fmt (CalendarTime year mon day hour min sec _
581 wday yday tzname _ _) =
583 where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
584 doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
585 doFmt ('%':c:cs) = decode c ++ doFmt cs
586 doFmt (c:cs) = c : doFmt cs
589 decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name
590 decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev.
591 decode 'B' = fst (months l !! fromEnum mon) -- month, full name
592 decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev
593 decode 'h' = snd (months l !! fromEnum mon) -- ditto
594 decode 'C' = show2 (year `quot` 100) -- century
595 decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format.
596 decode 'D' = doFmt "%m/%d/%y"
597 decode 'd' = show2 day -- day of the month
598 decode 'e' = show2' day -- ditto, padded
599 decode 'H' = show2 hour -- hours, 24-hour clock, padded
600 decode 'I' = show2 (to12 hour) -- hours, 12-hour clock
601 decode 'j' = show3 yday -- day of the year
602 decode 'k' = show2' hour -- hours, 24-hour clock, no padding
603 decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding
604 decode 'M' = show2 min -- minutes
605 decode 'm' = show2 (fromEnum mon+1) -- numeric month
607 decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm
608 decode 'R' = doFmt "%H:%M"
609 decode 'r' = doFmt (time12Fmt l)
610 decode 'T' = doFmt "%H:%M:%S"
612 decode 'S' = show2 sec -- seconds
613 decode 's' = show2 sec -- number of secs since Epoch. (ToDo.)
614 decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday.
615 decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday)
616 if n == 0 then 7 else n)
617 decode 'V' = -- week number (as per ISO-8601.)
618 let (week, days) = -- [yep, I've always wanted to be able to display that too.]
619 (yday + 7 - if fromEnum wday > 0 then
620 fromEnum wday - 1 else 6) `divMod` 7
621 in show2 (if days >= 4 then
623 else if week == 0 then 53 else week)
625 decode 'W' = -- week number, weeks starting on monday
626 show2 ((yday + 7 - if fromEnum wday > 0 then
627 fromEnum wday - 1 else 6) `div` 7)
628 decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday.
629 decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time.
630 decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates.
631 decode 'Y' = show year -- year, including century.
632 decode 'y' = show2 (year `rem` 100) -- year, within century.
633 decode 'Z' = tzname -- timezone name
638 show2, show2', show3 :: Int -> String
640 | x' < 10 = '0': show x'
641 | otherwise = show x'
642 where x' = x `rem` 100
645 | x' < 10 = ' ': show x'
646 | otherwise = show x'
647 where x' = x `rem` 100
649 show3 x = show (x `quot` 100) ++ show2 (x `rem` 100)
652 to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'
654 -- Useful extensions for formatting TimeDiffs.
656 -- | formats time differences using local conventions.
658 timeDiffToString :: TimeDiff -> String
659 timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
661 -- | formats time differences using local conventions and a formatting string.
662 -- The formatting string is that understood by the ISO C @strftime()@
665 formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
666 formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _)
670 doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
671 doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
672 doFmt ('%':c:cs) = decode c ++ doFmt cs
673 doFmt (c:cs) = c : doFmt cs
677 'B' -> fst (months l !! fromEnum month)
678 'b' -> snd (months l !! fromEnum month)
679 'h' -> snd (months l !! fromEnum month)
680 'c' -> defaultTimeDiffFmt td
681 'C' -> show2 (year `quot` 100)
682 'D' -> doFmt "%m/%d/%y"
686 'I' -> show2 (to12 hour)
688 'l' -> show2' (to12 hour)
690 'm' -> show2 (fromEnum month + 1)
692 'p' -> (if hour < 12 then fst else snd) (amPm l)
694 'r' -> doFmt (time12Fmt l)
695 'T' -> doFmt "%H:%M:%S"
698 's' -> show2 sec -- Implementation-dependent, sez the lib doc..
699 'X' -> doFmt (timeFmt l)
700 'x' -> doFmt (dateFmt l)
702 'y' -> show2 (year `rem` 100)
706 defaultTimeDiffFmt (TimeDiff year month day hour min sec _) =
707 foldr (\ (v,s) rest ->
709 then show v ++ ' ':(addS v s)
710 ++ if null rest then "" else ", "
714 (zip [year, month, day, hour, min, sec] (intervals l))
716 addS v s = if abs v == 1 then fst s else snd s
719 -- -----------------------------------------------------------------------------
720 -- Foreign time interface (POSIX)
722 type CTm = () -- struct tm
725 foreign import ccall unsafe "time.h localtime_r"
726 localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
728 foreign import ccall unsafe "time.h localtime"
729 localtime :: Ptr CTime -> IO (Ptr CTm)
732 foreign import ccall unsafe "time.h gmtime_r"
733 gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
735 foreign import ccall unsafe "time.h gmtime"
736 gmtime :: Ptr CTime -> IO (Ptr CTm)
738 foreign import ccall unsafe "time.h mktime"
739 mktime :: Ptr CTm -> IO CTime
741 #if HAVE_GETTIMEOFDAY
744 foreign import ccall unsafe "time.h gettimeofday"
745 gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt
748 #ifndef mingw32_HOST_OS
749 foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt
751 foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO ()
754 foreign import ccall unsafe "time.h time" time :: Ptr CTime -> IO CTime
756 #endif /* ! __HUGS__ */