1#if __GLASGOW_HASKELL__ >= 701 2{-# LANGUAGE Trustworthy #-} 3#endif 4 5----------------------------------------------------------------------------- 6-- | 7-- Module : System.Time 8-- Copyright : (c) The University of Glasgow 2001 9-- License : BSD-style (see the file libraries/old-time/LICENSE) 10-- 11-- Maintainer : libraries@haskell.org 12-- Stability : provisional 13-- Portability : portable 14-- 15-- The standard time library from Haskell 98. This library is 16-- deprecated, please look at @Data.Time@ in the @time@ package 17-- instead. 18-- 19-- "System.Time" provides functionality for clock times, including 20-- timezone information (i.e, the functionality of \"@time.h@\", 21-- adapted to the Haskell environment). It follows RFC 1129 in its 22-- use of Coordinated Universal Time (UTC). 23-- 24----------------------------------------------------------------------------- 25 26{- 27Haskell 98 Time of Day Library 28------------------------------ 29 302000/06/17 <michael.weber@post.rwth-aachen.de>: 31RESTRICTIONS: 32 * min./max. time diff currently is restricted to 33 [minBound::Int, maxBound::Int] 34 35 * surely other restrictions wrt. min/max bounds 36 37 38NOTES: 39 * printing times 40 41 `showTime' (used in `instance Show ClockTime') always prints time 42 converted to the local timezone (even if it is taken from 43 `(toClockTime . toUTCTime)'), whereas `calendarTimeToString' 44 honors the tzone & tz fields and prints UTC or whatever timezone 45 is stored inside CalendarTime. 46 47 Maybe `showTime' should be changed to use UTC, since it would 48 better correspond to the actual representation of `ClockTime' 49 (can be done by replacing localtime(3) by gmtime(3)). 50 51 52BUGS: 53 * add proper handling of microsecs, currently, they're mostly 54 ignored 55 56 * `formatFOO' case of `%s' is currently broken... 57 58 59TODO: 60 * check for unusual date cases, like 1970/1/1 00:00h, and conversions 61 between different timezone's etc. 62 63 * check, what needs to be in the IO monad, the current situation 64 seems to be a bit inconsistent to me 65 66 * check whether `isDst = -1' works as expected on other arch's 67 (Solaris anyone?) 68 69 * add functions to parse strings to `CalendarTime' (some day...) 70 71 * implement padding capabilities ("%_", "%-") in `formatFOO' 72 73 * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO' 74-} 75 76module System.Time 77 ( 78 -- * Clock times 79 80 ClockTime(..) -- non-standard, lib. report gives this as abstract 81 -- instance Eq, Ord 82 -- instance Show (non-standard) 83 84 , getClockTime 85 86 -- * Time differences 87 88 , TimeDiff(..) 89 , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) 90 , diffClockTimes 91 , addToClockTime 92 93 , normalizeTimeDiff -- non-standard 94 , timeDiffToString -- non-standard 95 , formatTimeDiff -- non-standard 96 97 -- * Calendar times 98 99 , CalendarTime(..) 100 , Month(..) 101 , Day(..) 102 , toCalendarTime 103 , toUTCTime 104 , toClockTime 105 , calendarTimeToString 106 , formatCalendarTime 107 108 ) where 109 110#ifdef __GLASGOW_HASKELL__ 111#include "HsTime.h" 112#endif 113 114import Prelude 115 116import Data.Ix 117import System.Locale 118import Foreign 119import System.IO.Unsafe (unsafePerformIO) 120 121#ifdef __HUGS__ 122import Hugs.Time ( getClockTimePrim, toCalTimePrim, toClockTimePrim ) 123#else 124import Foreign.C 125#endif 126 127-- One way to partition and give name to chunks of a year and a week: 128 129-- | A month of the year. 130 131data Month 132 = January | February | March | April 133 | May | June | July | August 134 | September | October | November | December 135 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) 136 137-- | A day of the week. 138 139data Day 140 = Sunday | Monday | Tuesday | Wednesday 141 | Thursday | Friday | Saturday 142 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) 143 144-- | A representation of the internal clock time. 145-- Clock times may be compared, converted to strings, or converted to an 146-- external calendar time 'CalendarTime' for I\/O or other manipulations. 147 148data ClockTime = TOD Integer Integer 149 -- ^ Construct a clock time. The arguments are a number 150 -- of seconds since 00:00:00 (UTC) on 1 January 1970, 151 -- and an additional number of picoseconds. 152 -- 153 -- In Haskell 98, the 'ClockTime' type is abstract. 154 deriving (Eq, Ord) 155 156-- When a ClockTime is shown, it is converted to a CalendarTime in the current 157-- timezone and then printed. FIXME: This is arguably wrong, since we can't 158-- get the current timezone without being in the IO monad. 159 160instance Show ClockTime where 161 showsPrec _ t = showString (calendarTimeToString 162 (unsafePerformIO (toCalendarTime t))) 163 164{- 165The numeric fields have the following ranges. 166 167\begin{verbatim} 168Value Range Comments 169----- ----- -------- 170 171year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] 172day 1 .. 31 173hour 0 .. 23 174min 0 .. 59 175sec 0 .. 61 [Allows for two leap seconds] 176picosec 0 .. (10^12)-1 [This could be over-precise?] 177yday 0 .. 365 [364 in non-Leap years] 178tz -43200 .. 50400 [Variation from UTC in seconds] 179\end{verbatim} 180-} 181 182-- | 'CalendarTime' is a user-readable and manipulable 183-- representation of the internal 'ClockTime' type. 184 185data CalendarTime 186 = CalendarTime { 187 ctYear :: Int -- ^ Year (pre-Gregorian dates are inaccurate) 188 , ctMonth :: Month -- ^ Month of the year 189 , ctDay :: Int -- ^ Day of the month (1 to 31) 190 , ctHour :: Int -- ^ Hour of the day (0 to 23) 191 , ctMin :: Int -- ^ Minutes (0 to 59) 192 , ctSec :: Int -- ^ Seconds (0 to 61, allowing for up to 193 -- two leap seconds) 194 , ctPicosec :: Integer -- ^ Picoseconds 195 , ctWDay :: Day -- ^ Day of the week 196 , ctYDay :: Int -- ^ Day of the year 197 -- (0 to 364, or 365 in leap years) 198 , ctTZName :: String -- ^ Name of the time zone 199 , ctTZ :: Int -- ^ Variation from UTC in seconds 200 , ctIsDST :: Bool -- ^ 'True' if Daylight Savings Time would 201 -- be in effect, and 'False' otherwise 202 } 203 deriving (Eq,Ord,Read,Show) 204 205-- | records the difference between two clock times in a user-readable way. 206 207data TimeDiff 208 = TimeDiff { 209 tdYear :: Int, 210 tdMonth :: Int, 211 tdDay :: Int, 212 tdHour :: Int, 213 tdMin :: Int, 214 tdSec :: Int, 215 tdPicosec :: Integer -- not standard 216 } 217 deriving (Eq,Ord,Read,Show) 218 219-- | null time difference. 220 221noTimeDiff :: TimeDiff 222noTimeDiff = TimeDiff 0 0 0 0 0 0 0 223 224-- ----------------------------------------------------------------------------- 225-- | returns the current time in its internal representation. 226 227realToInteger :: Real a => a -> Integer 228realToInteger ct = round (realToFrac ct :: Double) 229 -- CTime, CClock, CUShort etc are in Real but not Fractional, 230 -- so we must convert to Double before we can round it 231 232getClockTime :: IO ClockTime 233#ifdef __HUGS__ 234getClockTime = do 235 (sec,usec) <- getClockTimePrim 236 return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000)) 237 238#elif HAVE_GETTIMEOFDAY 239 240# if defined(mingw32_HOST_OS) 241type Timeval_tv_sec = CLong 242type Timeval_tv_usec = CLong 243# else 244type Timeval_tv_sec = CTime 245type Timeval_tv_usec = CSUSeconds 246# endif 247 248getClockTime = do 249 allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do 250 throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr 251 sec <- (#peek struct timeval,tv_sec) p_timeval :: IO Timeval_tv_sec 252 usec <- (#peek struct timeval,tv_usec) p_timeval :: IO Timeval_tv_usec 253 return (TOD (realToInteger sec) ((realToInteger usec) * 1000000)) 254 255#elif HAVE_FTIME 256getClockTime = do 257 allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do 258 ftime p_timeb 259 sec <- (#peek struct timeb,time) p_timeb :: IO CTime 260 msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort 261 return (TOD (realToInteger sec) (fromIntegral msec * 1000000000)) 262 263#else /* use POSIX time() */ 264getClockTime = do 265 secs <- time nullPtr -- can't fail, according to POSIX 266 return (TOD (realToInteger secs) 0) 267 268#endif 269 270-- ----------------------------------------------------------------------------- 271-- | @'addToClockTime' d t@ adds a time difference @d@ and a 272-- clock time @t@ to yield a new clock time. The difference @d@ 273-- may be either positive or negative. 274 275addToClockTime :: TimeDiff -> ClockTime -> ClockTime 276addToClockTime (TimeDiff year mon day hour minute sec psec) 277 (TOD c_sec c_psec) = 278 let 279 sec_diff = toInteger sec + 280 60 * toInteger minute + 281 3600 * toInteger hour + 282 24 * 3600 * toInteger day 283 (d_sec, d_psec) = (c_psec + psec) `quotRem` 1000000000000 284 cal = toUTCTime (TOD (c_sec + sec_diff + d_sec) d_psec) 285 new_mon = fromEnum (ctMonth cal) + r_mon 286 month' = fst tmp 287 yr_diff = snd tmp 288 tmp 289 | new_mon < 0 = (toEnum (12 + new_mon), (-1)) 290 | new_mon > 11 = (toEnum (new_mon `mod` 12), 1) 291 | otherwise = (toEnum new_mon, 0) 292 293 (r_yr, r_mon) = mon `quotRem` 12 294 295 year' = ctYear cal + year + r_yr + yr_diff 296 in 297 toClockTime cal{ctMonth=month', ctYear=year'} 298 299-- | @'diffClockTimes' t1 t2@ returns the difference between two clock 300-- times @t1@ and @t2@ as a 'TimeDiff'. 301 302diffClockTimes :: ClockTime -> ClockTime -> TimeDiff 303-- diffClockTimes is meant to be the dual to `addToClockTime'. 304-- If you want to have the TimeDiff properly splitted, use 305-- `normalizeTimeDiff' on this function's result 306-- 307-- CAVEAT: see comment of normalizeTimeDiff 308diffClockTimes (TOD sa pa) (TOD sb pb) = 309 noTimeDiff{ tdSec = fromIntegral (sa - sb) 310 -- FIXME: can handle just 68 years... 311 , tdPicosec = pa - pb 312 } 313 314 315-- | converts a time difference to normal form. 316 317normalizeTimeDiff :: TimeDiff -> TimeDiff 318-- FIXME: handle psecs properly 319-- FIXME: ?should be called by formatTimeDiff automagically? 320-- 321-- when applied to something coming out of `diffClockTimes', you loose 322-- the duality to `addToClockTime', since a year does not always have 323-- 365 days, etc. 324-- 325-- apply this function as late as possible to prevent those "rounding" 326-- errors 327normalizeTimeDiff td = 328 let 329 rest0 = toInteger (tdSec td) 330 + 60 * (toInteger (tdMin td) 331 + 60 * (toInteger (tdHour td) 332 + 24 * (toInteger (tdDay td) 333 + 30 * toInteger (tdMonth td) 334 + 365 * toInteger (tdYear td)))) 335 336 (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600) 337 (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600) 338 (diffDays, rest3) = rest2 `quotRem` (24 * 3600) 339 (diffHours, rest4) = rest3 `quotRem` 3600 340 (diffMins, diffSecs) = rest4 `quotRem` 60 341 in 342 td{ tdYear = fromInteger diffYears 343 , tdMonth = fromInteger diffMonths 344 , tdDay = fromInteger diffDays 345 , tdHour = fromInteger diffHours 346 , tdMin = fromInteger diffMins 347 , tdSec = fromInteger diffSecs 348 } 349 350#ifndef __HUGS__ 351-- ----------------------------------------------------------------------------- 352-- How do we deal with timezones on this architecture? 353 354-- The POSIX way to do it is through the global variable tzname[]. 355-- But that's crap, so we do it The BSD Way if we can: namely use the 356-- tm_zone and tm_gmtoff fields of struct tm, if they're available. 357 358zone :: Ptr CTm -> IO (Ptr CChar) 359gmtoff :: Ptr CTm -> IO CLong 360#if HAVE_TM_ZONE 361zone x = (#peek struct tm,tm_zone) x 362gmtoff x = (#peek struct tm,tm_gmtoff) x 363 364#else /* ! HAVE_TM_ZONE */ 365# if HAVE_TZNAME || defined(_WIN32) 366# if cygwin32_HOST_OS 367# define tzname _tzname 368# endif 369# ifndef mingw32_HOST_OS 370foreign import ccall unsafe "time.h &tzname" tzname :: Ptr CString 371# else 372foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong 373foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr CString 374# endif 375zone x = do 376 dst <- (#peek struct tm,tm_isdst) x 377 if dst then peekElemOff tzname 1 else peekElemOff tzname 0 378# else /* ! HAVE_TZNAME */ 379-- We're in trouble. If you should end up here, please report this as a bug. 380# error "Don't know how to get at timezone name on your OS." 381# endif /* ! HAVE_TZNAME */ 382 383-- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ 384# if HAVE_DECL_ALTZONE 385foreign import ccall "&altzone" altzone :: Ptr CTime 386foreign import ccall "&timezone" timezone :: Ptr CTime 387gmtoff x = do 388 dst <- (#peek struct tm,tm_isdst) x 389 tz <- if dst then peek altzone else peek timezone 390 return (-fromIntegral (realToInteger tz)) 391# else /* ! HAVE_DECL_ALTZONE */ 392 393#if !defined(mingw32_HOST_OS) 394foreign import ccall "time.h &timezone" timezone :: Ptr CLong 395#endif 396 397-- Assume that DST offset is 1 hour ... 398gmtoff x = do 399 dst <- (#peek struct tm,tm_isdst) x 400 tz <- peek timezone 401 -- According to the documentation for tzset(), 402 -- http://www.opengroup.org/onlinepubs/007908799/xsh/tzset.html 403 -- timezone offsets are > 0 west of the Prime Meridian. 404 -- 405 -- This module assumes the interpretation of tm_gmtoff, i.e., offsets 406 -- are > 0 East of the Prime Meridian, so flip the sign. 407 return (- (if dst then tz - 3600 else tz)) 408# endif /* ! HAVE_DECL_ALTZONE */ 409#endif /* ! HAVE_TM_ZONE */ 410#endif /* ! __HUGS__ */ 411 412-- ----------------------------------------------------------------------------- 413-- | converts an internal clock time to a local time, modified by the 414-- timezone and daylight savings time settings in force at the time 415-- of conversion. Because of this dependence on the local environment, 416-- 'toCalendarTime' is in the 'IO' monad. 417 418toCalendarTime :: ClockTime -> IO CalendarTime 419#ifdef __HUGS__ 420toCalendarTime = toCalTime False 421#elif HAVE_LOCALTIME_R 422toCalendarTime = clockToCalendarTime_reentrant (_throwAwayReturnPointer localtime_r) False 423#else 424toCalendarTime = clockToCalendarTime_static localtime False 425#endif 426 427-- | converts an internal clock time into a 'CalendarTime' in standard 428-- UTC format. 429 430toUTCTime :: ClockTime -> CalendarTime 431#ifdef __HUGS__ 432toUTCTime = unsafePerformIO . toCalTime True 433#elif HAVE_GMTIME_R 434toUTCTime = unsafePerformIO . clockToCalendarTime_reentrant (_throwAwayReturnPointer gmtime_r) True 435#else 436toUTCTime = unsafePerformIO . clockToCalendarTime_static gmtime True 437#endif 438 439#ifdef __HUGS__ 440toCalTime :: Bool -> ClockTime -> IO CalendarTime 441toCalTime toUTC (TOD s psecs) 442 | (s > fromIntegral (maxBound :: Int)) || 443 (s < fromIntegral (minBound :: Int)) 444 = error ((if toUTC then "toUTCTime: " else "toCalendarTime: ") ++ 445 "clock secs out of range") 446 | otherwise = do 447 (sec,min,hour,mday,mon,year,wday,yday,isdst,zone,off) <- 448 toCalTimePrim (if toUTC then 1 else 0) (fromIntegral s) 449 return (CalendarTime{ ctYear=1900+year 450 , ctMonth=toEnum mon 451 , ctDay=mday 452 , ctHour=hour 453 , ctMin=min 454 , ctSec=sec 455 , ctPicosec=psecs 456 , ctWDay=toEnum wday 457 , ctYDay=yday 458 , ctTZName=(if toUTC then "UTC" else zone) 459 , ctTZ=(if toUTC then 0 else off) 460 , ctIsDST=not toUTC && (isdst/=0) 461 }) 462#else /* ! __HUGS__ */ 463_throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm)) 464 -> (Ptr CTime -> Ptr CTm -> IO ( )) 465_throwAwayReturnPointer fun x y = fun x y >> return () 466 467#if !HAVE_LOCALTIME_R || !HAVE_GMTIME_R 468clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime 469 -> IO CalendarTime 470clockToCalendarTime_static fun is_utc (TOD secs psec) = do 471 with (fromIntegral secs :: CTime) $ \ p_timer -> do 472 p_tm <- fun p_timer -- can't fail, according to POSIX 473 clockToCalendarTime_aux is_utc p_tm psec 474#endif 475 476#if HAVE_LOCALTIME_R || HAVE_GMTIME_R 477clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime 478 -> IO CalendarTime 479clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do 480 with (fromIntegral secs :: CTime) $ \ p_timer -> do 481 allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do 482 fun p_timer p_tm 483 clockToCalendarTime_aux is_utc p_tm psec 484#endif 485 486clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime 487clockToCalendarTime_aux is_utc p_tm psec = do 488 sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt 489 minute <- (#peek struct tm,tm_min ) p_tm :: IO CInt 490 hour <- (#peek struct tm,tm_hour ) p_tm :: IO CInt 491 mday <- (#peek struct tm,tm_mday ) p_tm :: IO CInt 492 mon <- (#peek struct tm,tm_mon ) p_tm :: IO CInt 493 year <- (#peek struct tm,tm_year ) p_tm :: IO CInt 494 wday <- (#peek struct tm,tm_wday ) p_tm :: IO CInt 495 yday <- (#peek struct tm,tm_yday ) p_tm :: IO CInt 496 isdst <- (#peek struct tm,tm_isdst) p_tm :: IO CInt 497 zone' <- zone p_tm 498 tz <- gmtoff p_tm 499 500 tzname' <- peekCString zone' 501 502 let month | mon >= 0 && mon <= 11 = toEnum (fromIntegral mon) 503 | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon) 504 505 return (CalendarTime 506 (1900 + fromIntegral year) 507 month 508 (fromIntegral mday) 509 (fromIntegral hour) 510 (fromIntegral minute) 511 (fromIntegral sec) 512 psec 513 (toEnum (fromIntegral wday)) 514 (fromIntegral yday) 515 (if is_utc then "UTC" else tzname') 516 (if is_utc then 0 else fromIntegral tz) 517 (if is_utc then False else isdst /= 0)) 518#endif /* ! __HUGS__ */ 519 520-- | converts a 'CalendarTime' into the corresponding internal 521-- 'ClockTime', ignoring the contents of the 'ctWDay', 'ctYDay', 522-- 'ctTZName' and 'ctIsDST' fields. 523 524toClockTime :: CalendarTime -> ClockTime 525#ifdef __HUGS__ 526toClockTime (CalendarTime yr mon mday hour min sec psec 527 _wday _yday _tzname tz _isdst) = 528 unsafePerformIO $ do 529 s <- toClockTimePrim (yr-1900) (fromEnum mon) mday hour min sec tz 530 return (TOD (fromIntegral s) psec) 531#else /* ! __HUGS__ */ 532toClockTime (CalendarTime year mon mday hour minute sec psec 533 _wday _yday _tzname tz _isdst) = 534 535 -- `isDst' causes the date to be wrong by one hour... 536 -- FIXME: check, whether this works on other arch's than Linux, too... 537 -- 538 -- so we set it to (-1) (means `unknown') and let `mktime' determine 539 -- the real value... 540 let isDst = -1 :: CInt in -- if _isdst then (1::Int) else 0 541 542 if psec < 0 || psec > 999999999999 then 543 error "Time.toClockTime: picoseconds out of range" 544 else if tz < -43200 || tz > 50400 then 545 error "Time.toClockTime: timezone offset out of range" 546 else 547 unsafePerformIO $ do 548 allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do 549 (#poke struct tm,tm_sec ) p_tm (fromIntegral sec :: CInt) 550 (#poke struct tm,tm_min ) p_tm (fromIntegral minute :: CInt) 551 (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt) 552 (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt) 553 (#poke struct tm,tm_mon ) p_tm (fromIntegral (fromEnum mon) :: CInt) 554 (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt) 555 (#poke struct tm,tm_isdst) p_tm isDst 556 t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input") 557 (mktime p_tm) 558 -- 559 -- mktime expects its argument to be in the local timezone, but 560 -- toUTCTime makes UTC-encoded CalendarTime's ... 561 -- 562 -- Since there is no any_tz_struct_tm-to-time_t conversion 563 -- function, we have to fake one... :-) If not in all, it works in 564 -- most cases (before, it was the other way round...) 565 -- 566 -- Luckily, mktime tells us, what it *thinks* the timezone is, so, 567 -- to compensate, we add the timezone difference to mktime's 568 -- result. 569 -- 570 gmtoffset <- gmtoff p_tm 571 let res = realToInteger t - fromIntegral tz + fromIntegral gmtoffset 572 return (TOD res psec) 573#endif /* ! __HUGS__ */ 574 575-- ----------------------------------------------------------------------------- 576-- Converting time values to strings. 577 578-- | formats calendar times using local conventions. 579 580calendarTimeToString :: CalendarTime -> String 581calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" 582 583-- | formats calendar times using local conventions and a formatting string. 584-- The formatting string is that understood by the ISO C @strftime()@ 585-- function. 586 587formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String 588formatCalendarTime l fmt cal@(CalendarTime year mon day hour minute sec _ 589 wday yday tzname' _ _) = 590 doFmt fmt 591 where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented 592 doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented 593 doFmt ('%':c:cs) = decode c ++ doFmt cs 594 doFmt (c:cs) = c : doFmt cs 595 doFmt "" = "" 596 597 decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name 598 decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev. 599 decode 'B' = fst (months l !! fromEnum mon) -- month, full name 600 decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev 601 decode 'h' = snd (months l !! fromEnum mon) -- ditto 602 decode 'C' = show2 (year `quot` 100) -- century 603 decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format. 604 decode 'D' = doFmt "%m/%d/%y" 605 decode 'd' = show2 day -- day of the month 606 decode 'e' = show2' day -- ditto, padded 607 decode 'H' = show2 hour -- hours, 24-hour clock, padded 608 decode 'I' = show2 (to12 hour) -- hours, 12-hour clock 609 decode 'j' = show3 (yday + 1) -- day of the year 610 decode 'k' = show2' hour -- hours, 24-hour clock, no padding 611 decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding 612 decode 'M' = show2 minute -- minutes 613 decode 'm' = show2 (fromEnum mon+1) -- numeric month 614 decode 'n' = "\n" 615 decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm 616 decode 'R' = doFmt "%H:%M" 617 decode 'r' = doFmt (time12Fmt l) 618 decode 'T' = doFmt "%H:%M:%S" 619 decode 't' = "\t" 620 decode 'S' = show2 sec -- seconds 621 decode 's' = let TOD esecs _ = toClockTime cal in show esecs 622 -- number of secs since Epoch. 623 decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday. 624 decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday) 625 if n == 0 then 7 else n) 626 decode 'V' = -- week number (as per ISO-8601.) 627 let (week, days) = -- [yep, I've always wanted to be able to display that too.] 628 (yday + 7 - if fromEnum wday > 0 then 629 fromEnum wday - 1 else 6) `divMod` 7 630 in show2 (if days >= 4 then 631 week+1 632 else if week == 0 then 53 else week) 633 634 decode 'W' = -- week number, weeks starting on monday 635 show2 ((yday + 7 - if fromEnum wday > 0 then 636 fromEnum wday - 1 else 6) `div` 7) 637 decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday. 638 decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time. 639 decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates. 640 decode 'Y' = show year -- year, including century. 641 decode 'y' = show2 (year `rem` 100) -- year, within century. 642 decode 'Z' = tzname' -- timezone name 643 decode '%' = "%" 644 decode c = [c] 645 646 647show2, show2', show3 :: Int -> String 648show2 x 649 | x' < 10 = '0': show x' 650 | otherwise = show x' 651 where x' = x `rem` 100 652 653show2' x 654 | x' < 10 = ' ': show x' 655 | otherwise = show x' 656 where x' = x `rem` 100 657 658show3 x = show (x `quot` 100) ++ show2 (x `rem` 100) 659 660to12 :: Int -> Int 661to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' 662 663-- Useful extensions for formatting TimeDiffs. 664 665-- | formats time differences using local conventions. 666 667timeDiffToString :: TimeDiff -> String 668timeDiffToString = formatTimeDiff defaultTimeLocale "%c" 669 670-- | formats time differences using local conventions and a formatting string. 671-- The formatting string is that understood by the ISO C @strftime()@ 672-- function. 673 674formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String 675formatTimeDiff l fmt (TimeDiff year month day hour minute sec _) 676 = doFmt fmt 677 where 678 doFmt "" = "" 679 doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented 680 doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented 681 doFmt ('%':c:cs) = decode c ++ doFmt cs 682 doFmt (c:cs) = c : doFmt cs 683 684 decode spec = 685 case spec of 686 'B' -> fst (months l !! fromEnum month) 687 'b' -> snd (months l !! fromEnum month) 688 'h' -> snd (months l !! fromEnum month) 689 'c' -> defaultTimeDiffFmt 690 'C' -> show2 (year `quot` 100) 691 'D' -> doFmt "%m/%d/%y" 692 'd' -> show2 day 693 'e' -> show2' day 694 'H' -> show2 hour 695 'I' -> show2 (to12 hour) 696 'k' -> show2' hour 697 'l' -> show2' (to12 hour) 698 'M' -> show2 minute 699 'm' -> show2 (fromEnum month + 1) 700 'n' -> "\n" 701 'p' -> (if hour < 12 then fst else snd) (amPm l) 702 'R' -> doFmt "%H:%M" 703 'r' -> doFmt (time12Fmt l) 704 'T' -> doFmt "%H:%M:%S" 705 't' -> "\t" 706 'S' -> show2 sec 707 's' -> show2 sec -- Implementation-dependent, sez the lib doc.. 708 'X' -> doFmt (timeFmt l) 709 'x' -> doFmt (dateFmt l) 710 'Y' -> show year 711 'y' -> show2 (year `rem` 100) 712 '%' -> "%" 713 c -> [c] 714 715 defaultTimeDiffFmt = 716 foldr (\ (v,s) rest -> 717 (if v /= 0 718 then show v ++ ' ':(addS v s) 719 ++ if null rest then "" else ", " 720 else "") ++ rest 721 ) 722 "" 723 (zip [year, month, day, hour, minute, sec] (intervals l)) 724 725 addS v s = if abs v == 1 then fst s else snd s 726 727#ifndef __HUGS__ 728-- ----------------------------------------------------------------------------- 729-- Foreign time interface (POSIX) 730 731type CTm = () -- struct tm 732 733#if HAVE_LOCALTIME_R 734foreign import ccall unsafe "HsTime.h __hscore_localtime_r" 735 localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) 736#else 737foreign import ccall unsafe "time.h localtime" 738 localtime :: Ptr CTime -> IO (Ptr CTm) 739#endif 740#if HAVE_GMTIME_R 741foreign import ccall unsafe "HsTime.h __hscore_gmtime_r" 742 gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) 743#else 744foreign import ccall unsafe "time.h gmtime" 745 gmtime :: Ptr CTime -> IO (Ptr CTm) 746#endif 747foreign import ccall unsafe "time.h mktime" 748 mktime :: Ptr CTm -> IO CTime 749 750#if HAVE_GETTIMEOFDAY 751type CTimeVal = () 752type CTimeZone = () 753foreign import ccall unsafe "HsTime.h __hscore_gettimeofday" 754 gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt 755#elif HAVE_FTIME 756type CTimeB = () 757#ifndef mingw32_HOST_OS 758foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt 759#else 760foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO () 761#endif 762#else 763foreign import ccall unsafe "time.h time" time :: Ptr CTime -> IO CTime 764#endif 765#endif /* ! __HUGS__ */ 766