{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} #endif -- XXX with some combinations of #defines we get warnings, e.g. -- Warning: Defined but not used: `throwAwayReturnPointer' ----------------------------------------------------------------------------- -- | -- Module : System.Time -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/old-time/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The standard time library from Haskell 98. This library is -- deprecated, please look at @Data.Time@ in the @time@ package -- instead. -- -- "System.Time" provides functionality for clock times, including -- timezone information (i.e, the functionality of \"@time.h@\", -- adapted to the Haskell environment). It follows RFC 1129 in its -- use of Coordinated Universal Time (UTC). -- ----------------------------------------------------------------------------- {- Haskell 98 Time of Day Library ------------------------------ 2000/06/17 : RESTRICTIONS: * min./max. time diff currently is restricted to [minBound::Int, maxBound::Int] * surely other restrictions wrt. min/max bounds NOTES: * printing times `showTime' (used in `instance Show ClockTime') always prints time converted to the local timezone (even if it is taken from `(toClockTime . toUTCTime)'), whereas `calendarTimeToString' honors the tzone & tz fields and prints UTC or whatever timezone is stored inside CalendarTime. Maybe `showTime' should be changed to use UTC, since it would better correspond to the actual representation of `ClockTime' (can be done by replacing localtime(3) by gmtime(3)). BUGS: * add proper handling of microsecs, currently, they're mostly ignored * `formatFOO' case of `%s' is currently broken... TODO: * check for unusual date cases, like 1970/1/1 00:00h, and conversions between different timezone's etc. * check, what needs to be in the IO monad, the current situation seems to be a bit inconsistent to me * check whether `isDst = -1' works as expected on other arch's (Solaris anyone?) * add functions to parse strings to `CalendarTime' (some day...) * implement padding capabilities ("%_", "%-") in `formatFOO' * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO' -} module System.Time ( -- * Clock times ClockTime(..) -- non-standard, lib. report gives this as abstract -- instance Eq, Ord -- instance Show (non-standard) , getClockTime -- * Time differences , TimeDiff(..) , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) , diffClockTimes , addToClockTime , normalizeTimeDiff -- non-standard , timeDiffToString -- non-standard , formatTimeDiff -- non-standard -- * Calendar times , CalendarTime(..) , Month(..) , Day(..) , toCalendarTime , toUTCTime , toClockTime , calendarTimeToString , formatCalendarTime ) where #ifdef __GLASGOW_HASKELL__ #include "HsTime.h" #endif #ifdef __NHC__ #include # if defined(__sun) || defined(__CYGWIN32__) # define HAVE_TZNAME 1 # else # define HAVE_TM_ZONE 1 # endif import Ix #endif import Prelude import Data.Ix import System.Locale import Foreign hiding (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO) #ifdef __HUGS__ import Hugs.Time ( getClockTimePrim, toCalTimePrim, toClockTimePrim ) #else import Foreign.C #endif -- One way to partition and give name to chunks of a year and a week: -- | A month of the year. data Month = January | February | March | April | May | June | July | August | September | October | November | December deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) -- | A day of the week. data Day = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) -- | A representation of the internal clock time. -- Clock times may be compared, converted to strings, or converted to an -- external calendar time 'CalendarTime' for I\/O or other manipulations. data ClockTime = TOD Integer Integer -- ^ Construct a clock time. The arguments are a number -- of seconds since 00:00:00 (UTC) on 1 January 1970, -- and an additional number of picoseconds. -- -- In Haskell 98, the 'ClockTime' type is abstract. deriving (Eq, Ord) -- When a ClockTime is shown, it is converted to a CalendarTime in the current -- timezone and then printed. FIXME: This is arguably wrong, since we can't -- get the current timezone without being in the IO monad. instance Show ClockTime where showsPrec _ t = showString (calendarTimeToString (unsafePerformIO (toCalendarTime t))) {- The numeric fields have the following ranges. \begin{verbatim} Value Range Comments ----- ----- -------- year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] day 1 .. 31 hour 0 .. 23 min 0 .. 59 sec 0 .. 61 [Allows for two leap seconds] picosec 0 .. (10^12)-1 [This could be over-precise?] yday 0 .. 365 [364 in non-Leap years] tz -43200 .. 50400 [Variation from UTC in seconds] \end{verbatim} -} -- | 'CalendarTime' is a user-readable and manipulable -- representation of the internal 'ClockTime' type. data CalendarTime = CalendarTime { ctYear :: Int -- ^ Year (pre-Gregorian dates are inaccurate) , ctMonth :: Month -- ^ Month of the year , ctDay :: Int -- ^ Day of the month (1 to 31) , ctHour :: Int -- ^ Hour of the day (0 to 23) , ctMin :: Int -- ^ Minutes (0 to 59) , ctSec :: Int -- ^ Seconds (0 to 61, allowing for up to -- two leap seconds) , ctPicosec :: Integer -- ^ Picoseconds , ctWDay :: Day -- ^ Day of the week , ctYDay :: Int -- ^ Day of the year -- (0 to 364, or 365 in leap years) , ctTZName :: String -- ^ Name of the time zone , ctTZ :: Int -- ^ Variation from UTC in seconds , ctIsDST :: Bool -- ^ 'True' if Daylight Savings Time would -- be in effect, and 'False' otherwise } deriving (Eq,Ord,Read,Show) -- | records the difference between two clock times in a user-readable way. data TimeDiff = TimeDiff { tdYear :: Int, tdMonth :: Int, tdDay :: Int, tdHour :: Int, tdMin :: Int, tdSec :: Int, tdPicosec :: Integer -- not standard } deriving (Eq,Ord,Read,Show) -- | null time difference. noTimeDiff :: TimeDiff noTimeDiff = TimeDiff 0 0 0 0 0 0 0 -- ----------------------------------------------------------------------------- -- | returns the current time in its internal representation. realToInteger :: Real a => a -> Integer realToInteger ct = round (realToFrac ct :: Double) -- CTime, CClock, CUShort etc are in Real but not Fractional, -- so we must convert to Double before we can round it getClockTime :: IO ClockTime #ifdef __HUGS__ getClockTime = do (sec,usec) <- getClockTimePrim return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000)) #elif HAVE_GETTIMEOFDAY # if defined(mingw32_HOST_OS) type Timeval_tv_sec = CLong type Timeval_tv_usec = CLong # else type Timeval_tv_sec = CTime type Timeval_tv_usec = CSUSeconds # endif getClockTime = do allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr sec <- (#peek struct timeval,tv_sec) p_timeval :: IO Timeval_tv_sec usec <- (#peek struct timeval,tv_usec) p_timeval :: IO Timeval_tv_usec return (TOD (realToInteger sec) ((realToInteger usec) * 1000000)) #elif HAVE_FTIME getClockTime = do allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do ftime p_timeb sec <- (#peek struct timeb,time) p_timeb :: IO CTime msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort return (TOD (realToInteger sec) (fromIntegral msec * 1000000000)) #else /* use POSIX time() */ getClockTime = do secs <- time nullPtr -- can't fail, according to POSIX return (TOD (realToInteger secs) 0) #endif -- ----------------------------------------------------------------------------- -- | @'addToClockTime' d t@ adds a time difference @d@ and a -- clock time @t@ to yield a new clock time. The difference @d@ -- may be either positive or negative. addToClockTime :: TimeDiff -> ClockTime -> ClockTime addToClockTime (TimeDiff year mon day hour minute sec psec) (TOD c_sec c_psec) = let sec_diff = toInteger sec + 60 * toInteger minute + 3600 * toInteger hour + 24 * 3600 * toInteger day (d_sec, d_psec) = (c_psec + psec) `quotRem` 1000000000000 cal = toUTCTime (TOD (c_sec + sec_diff + d_sec) d_psec) new_mon = fromEnum (ctMonth cal) + r_mon month' = fst tmp yr_diff = snd tmp tmp | new_mon < 0 = (toEnum (12 + new_mon), (-1)) | new_mon > 11 = (toEnum (new_mon `mod` 12), 1) | otherwise = (toEnum new_mon, 0) (r_yr, r_mon) = mon `quotRem` 12 year' = ctYear cal + year + r_yr + yr_diff in toClockTime cal{ctMonth=month', ctYear=year'} -- | @'diffClockTimes' t1 t2@ returns the difference between two clock -- times @t1@ and @t2@ as a 'TimeDiff'. diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -- diffClockTimes is meant to be the dual to `addToClockTime'. -- If you want to have the TimeDiff properly splitted, use -- `normalizeTimeDiff' on this function's result -- -- CAVEAT: see comment of normalizeTimeDiff diffClockTimes (TOD sa pa) (TOD sb pb) = noTimeDiff{ tdSec = fromIntegral (sa - sb) -- FIXME: can handle just 68 years... , tdPicosec = pa - pb } -- | converts a time difference to normal form. normalizeTimeDiff :: TimeDiff -> TimeDiff -- FIXME: handle psecs properly -- FIXME: ?should be called by formatTimeDiff automagically? -- -- when applied to something coming out of `diffClockTimes', you loose -- the duality to `addToClockTime', since a year does not always have -- 365 days, etc. -- -- apply this function as late as possible to prevent those "rounding" -- errors normalizeTimeDiff td = let rest0 = toInteger (tdSec td) + 60 * (toInteger (tdMin td) + 60 * (toInteger (tdHour td) + 24 * (toInteger (tdDay td) + 30 * toInteger (tdMonth td) + 365 * toInteger (tdYear td)))) (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600) (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600) (diffDays, rest3) = rest2 `quotRem` (24 * 3600) (diffHours, rest4) = rest3 `quotRem` 3600 (diffMins, diffSecs) = rest4 `quotRem` 60 in td{ tdYear = fromInteger diffYears , tdMonth = fromInteger diffMonths , tdDay = fromInteger diffDays , tdHour = fromInteger diffHours , tdMin = fromInteger diffMins , tdSec = fromInteger diffSecs } #ifndef __HUGS__ -- ----------------------------------------------------------------------------- -- How do we deal with timezones on this architecture? -- The POSIX way to do it is through the global variable tzname[]. -- But that's crap, so we do it The BSD Way if we can: namely use the -- tm_zone and tm_gmtoff fields of struct tm, if they're available. zone :: Ptr CTm -> IO (Ptr CChar) gmtoff :: Ptr CTm -> IO CLong #if HAVE_TM_ZONE zone x = (#peek struct tm,tm_zone) x gmtoff x = (#peek struct tm,tm_gmtoff) x #else /* ! HAVE_TM_ZONE */ # if HAVE_TZNAME || defined(_WIN32) # if cygwin32_HOST_OS # define tzname _tzname # endif # ifndef mingw32_HOST_OS foreign import ccall unsafe "time.h &tzname" tzname :: Ptr CString # else foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr CString # endif zone x = do dst <- (#peek struct tm,tm_isdst) x if dst then peekElemOff tzname 1 else peekElemOff tzname 0 # else /* ! HAVE_TZNAME */ -- We're in trouble. If you should end up here, please report this as a bug. # error "Don't know how to get at timezone name on your OS." # endif /* ! HAVE_TZNAME */ -- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ # if HAVE_DECL_ALTZONE foreign import ccall "&altzone" altzone :: Ptr CTime foreign import ccall "&timezone" timezone :: Ptr CTime gmtoff x = do dst <- (#peek struct tm,tm_isdst) x tz <- if dst then peek altzone else peek timezone return (-fromIntegral (realToInteger tz)) # else /* ! HAVE_DECL_ALTZONE */ #if !defined(mingw32_HOST_OS) foreign import ccall "time.h &timezone" timezone :: Ptr CLong #endif -- Assume that DST offset is 1 hour ... gmtoff x = do dst <- (#peek struct tm,tm_isdst) x tz <- peek timezone -- According to the documentation for tzset(), -- http://www.opengroup.org/onlinepubs/007908799/xsh/tzset.html -- timezone offsets are > 0 west of the Prime Meridian. -- -- This module assumes the interpretation of tm_gmtoff, i.e., offsets -- are > 0 East of the Prime Meridian, so flip the sign. return (- (if dst then tz - 3600 else tz)) # endif /* ! HAVE_DECL_ALTZONE */ #endif /* ! HAVE_TM_ZONE */ #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- -- | converts an internal clock time to a local time, modified by the -- timezone and daylight savings time settings in force at the time -- of conversion. Because of this dependence on the local environment, -- 'toCalendarTime' is in the 'IO' monad. toCalendarTime :: ClockTime -> IO CalendarTime #ifdef __HUGS__ toCalendarTime = toCalTime False #elif HAVE_LOCALTIME_R toCalendarTime = clockToCalendarTime_reentrant (throwAwayReturnPointer localtime_r) False #else toCalendarTime = clockToCalendarTime_static localtime False #endif -- | converts an internal clock time into a 'CalendarTime' in standard -- UTC format. toUTCTime :: ClockTime -> CalendarTime #ifdef __HUGS__ toUTCTime = unsafePerformIO . toCalTime True #elif HAVE_GMTIME_R toUTCTime = unsafePerformIO . clockToCalendarTime_reentrant (throwAwayReturnPointer gmtime_r) True #else toUTCTime = unsafePerformIO . clockToCalendarTime_static gmtime True #endif #ifdef __HUGS__ toCalTime :: Bool -> ClockTime -> IO CalendarTime toCalTime toUTC (TOD s psecs) | (s > fromIntegral (maxBound :: Int)) || (s < fromIntegral (minBound :: Int)) = error ((if toUTC then "toUTCTime: " else "toCalendarTime: ") ++ "clock secs out of range") | otherwise = do (sec,min,hour,mday,mon,year,wday,yday,isdst,zone,off) <- toCalTimePrim (if toUTC then 1 else 0) (fromIntegral s) return (CalendarTime{ ctYear=1900+year , ctMonth=toEnum mon , ctDay=mday , ctHour=hour , ctMin=min , ctSec=sec , ctPicosec=psecs , ctWDay=toEnum wday , ctYDay=yday , ctTZName=(if toUTC then "UTC" else zone) , ctTZ=(if toUTC then 0 else off) , ctIsDST=not toUTC && (isdst/=0) }) #else /* ! __HUGS__ */ throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm)) -> (Ptr CTime -> Ptr CTm -> IO ( )) throwAwayReturnPointer fun x y = fun x y >> return () #if !HAVE_LOCALTIME_R || !HAVE_GMTIME_R clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime -> IO CalendarTime clockToCalendarTime_static fun is_utc (TOD secs psec) = do with (fromIntegral secs :: CTime) $ \ p_timer -> do p_tm <- fun p_timer -- can't fail, according to POSIX clockToCalendarTime_aux is_utc p_tm psec #endif #if HAVE_LOCALTIME_R || HAVE_GMTIME_R clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime -> IO CalendarTime clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do with (fromIntegral secs :: CTime) $ \ p_timer -> do allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do fun p_timer p_tm clockToCalendarTime_aux is_utc p_tm psec #endif clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime clockToCalendarTime_aux is_utc p_tm psec = do sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt minute <- (#peek struct tm,tm_min ) p_tm :: IO CInt hour <- (#peek struct tm,tm_hour ) p_tm :: IO CInt mday <- (#peek struct tm,tm_mday ) p_tm :: IO CInt mon <- (#peek struct tm,tm_mon ) p_tm :: IO CInt year <- (#peek struct tm,tm_year ) p_tm :: IO CInt wday <- (#peek struct tm,tm_wday ) p_tm :: IO CInt yday <- (#peek struct tm,tm_yday ) p_tm :: IO CInt isdst <- (#peek struct tm,tm_isdst) p_tm :: IO CInt zone' <- zone p_tm tz <- gmtoff p_tm tzname' <- peekCString zone' let month | mon >= 0 && mon <= 11 = toEnum (fromIntegral mon) | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon) return (CalendarTime (1900 + fromIntegral year) month (fromIntegral mday) (fromIntegral hour) (fromIntegral minute) (fromIntegral sec) psec (toEnum (fromIntegral wday)) (fromIntegral yday) (if is_utc then "UTC" else tzname') (if is_utc then 0 else fromIntegral tz) (if is_utc then False else isdst /= 0)) #endif /* ! __HUGS__ */ -- | converts a 'CalendarTime' into the corresponding internal -- 'ClockTime', ignoring the contents of the 'ctWDay', 'ctYDay', -- 'ctTZName' and 'ctIsDST' fields. toClockTime :: CalendarTime -> ClockTime #ifdef __HUGS__ toClockTime (CalendarTime yr mon mday hour min sec psec _wday _yday _tzname tz _isdst) = unsafePerformIO $ do s <- toClockTimePrim (yr-1900) (fromEnum mon) mday hour min sec tz return (TOD (fromIntegral s) psec) #else /* ! __HUGS__ */ toClockTime (CalendarTime year mon mday hour minute sec psec _wday _yday _tzname tz _isdst) = -- `isDst' causes the date to be wrong by one hour... -- FIXME: check, whether this works on other arch's than Linux, too... -- -- so we set it to (-1) (means `unknown') and let `mktime' determine -- the real value... let isDst = -1 :: CInt in -- if _isdst then (1::Int) else 0 if psec < 0 || psec > 999999999999 then error "Time.toClockTime: picoseconds out of range" else if tz < -43200 || tz > 50400 then error "Time.toClockTime: timezone offset out of range" else unsafePerformIO $ do allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do (#poke struct tm,tm_sec ) p_tm (fromIntegral sec :: CInt) (#poke struct tm,tm_min ) p_tm (fromIntegral minute :: CInt) (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt) (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt) (#poke struct tm,tm_mon ) p_tm (fromIntegral (fromEnum mon) :: CInt) (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt) (#poke struct tm,tm_isdst) p_tm isDst t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input") (mktime p_tm) -- -- mktime expects its argument to be in the local timezone, but -- toUTCTime makes UTC-encoded CalendarTime's ... -- -- Since there is no any_tz_struct_tm-to-time_t conversion -- function, we have to fake one... :-) If not in all, it works in -- most cases (before, it was the other way round...) -- -- Luckily, mktime tells us, what it *thinks* the timezone is, so, -- to compensate, we add the timezone difference to mktime's -- result. -- gmtoffset <- gmtoff p_tm let res = realToInteger t - fromIntegral tz + fromIntegral gmtoffset return (TOD res psec) #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- -- Converting time values to strings. -- | formats calendar times using local conventions. calendarTimeToString :: CalendarTime -> String calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" -- | formats calendar times using local conventions and a formatting string. -- The formatting string is that understood by the ISO C @strftime()@ -- function. formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String formatCalendarTime l fmt cal@(CalendarTime year mon day hour minute sec _ wday yday tzname' _ _) = doFmt fmt where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs doFmt "" = "" decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev. decode 'B' = fst (months l !! fromEnum mon) -- month, full name decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev decode 'h' = snd (months l !! fromEnum mon) -- ditto decode 'C' = show2 (year `quot` 100) -- century decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format. decode 'D' = doFmt "%m/%d/%y" decode 'd' = show2 day -- day of the month decode 'e' = show2' day -- ditto, padded decode 'H' = show2 hour -- hours, 24-hour clock, padded decode 'I' = show2 (to12 hour) -- hours, 12-hour clock decode 'j' = show3 (yday + 1) -- day of the year decode 'k' = show2' hour -- hours, 24-hour clock, no padding decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding decode 'M' = show2 minute -- minutes decode 'm' = show2 (fromEnum mon+1) -- numeric month decode 'n' = "\n" decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm decode 'R' = doFmt "%H:%M" decode 'r' = doFmt (time12Fmt l) decode 'T' = doFmt "%H:%M:%S" decode 't' = "\t" decode 'S' = show2 sec -- seconds decode 's' = let TOD esecs _ = toClockTime cal in show esecs -- number of secs since Epoch. decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday. decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday) if n == 0 then 7 else n) decode 'V' = -- week number (as per ISO-8601.) let (week, days) = -- [yep, I've always wanted to be able to display that too.] (yday + 7 - if fromEnum wday > 0 then fromEnum wday - 1 else 6) `divMod` 7 in show2 (if days >= 4 then week+1 else if week == 0 then 53 else week) decode 'W' = -- week number, weeks starting on monday show2 ((yday + 7 - if fromEnum wday > 0 then fromEnum wday - 1 else 6) `div` 7) decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday. decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time. decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates. decode 'Y' = show year -- year, including century. decode 'y' = show2 (year `rem` 100) -- year, within century. decode 'Z' = tzname' -- timezone name decode '%' = "%" decode c = [c] show2, show2', show3 :: Int -> String show2 x | x' < 10 = '0': show x' | otherwise = show x' where x' = x `rem` 100 show2' x | x' < 10 = ' ': show x' | otherwise = show x' where x' = x `rem` 100 show3 x = show (x `quot` 100) ++ show2 (x `rem` 100) to12 :: Int -> Int to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' -- Useful extensions for formatting TimeDiffs. -- | formats time differences using local conventions. timeDiffToString :: TimeDiff -> String timeDiffToString = formatTimeDiff defaultTimeLocale "%c" -- | formats time differences using local conventions and a formatting string. -- The formatting string is that understood by the ISO C @strftime()@ -- function. formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String formatTimeDiff l fmt (TimeDiff year month day hour minute sec _) = doFmt fmt where doFmt "" = "" doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs decode spec = case spec of 'B' -> fst (months l !! fromEnum month) 'b' -> snd (months l !! fromEnum month) 'h' -> snd (months l !! fromEnum month) 'c' -> defaultTimeDiffFmt 'C' -> show2 (year `quot` 100) 'D' -> doFmt "%m/%d/%y" 'd' -> show2 day 'e' -> show2' day 'H' -> show2 hour 'I' -> show2 (to12 hour) 'k' -> show2' hour 'l' -> show2' (to12 hour) 'M' -> show2 minute 'm' -> show2 (fromEnum month + 1) 'n' -> "\n" 'p' -> (if hour < 12 then fst else snd) (amPm l) 'R' -> doFmt "%H:%M" 'r' -> doFmt (time12Fmt l) 'T' -> doFmt "%H:%M:%S" 't' -> "\t" 'S' -> show2 sec 's' -> show2 sec -- Implementation-dependent, sez the lib doc.. 'X' -> doFmt (timeFmt l) 'x' -> doFmt (dateFmt l) 'Y' -> show year 'y' -> show2 (year `rem` 100) '%' -> "%" c -> [c] defaultTimeDiffFmt = foldr (\ (v,s) rest -> (if v /= 0 then show v ++ ' ':(addS v s) ++ if null rest then "" else ", " else "") ++ rest ) "" (zip [year, month, day, hour, minute, sec] (intervals l)) addS v s = if abs v == 1 then fst s else snd s #ifndef __HUGS__ -- ----------------------------------------------------------------------------- -- Foreign time interface (POSIX) type CTm = () -- struct tm #if HAVE_LOCALTIME_R foreign import ccall unsafe "HsTime.h __hscore_localtime_r" localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe "time.h localtime" localtime :: Ptr CTime -> IO (Ptr CTm) #endif #if HAVE_GMTIME_R foreign import ccall unsafe "HsTime.h __hscore_gmtime_r" gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe "time.h gmtime" gmtime :: Ptr CTime -> IO (Ptr CTm) #endif foreign import ccall unsafe "time.h mktime" mktime :: Ptr CTm -> IO CTime #if HAVE_GETTIMEOFDAY type CTimeVal = () type CTimeZone = () foreign import ccall unsafe "HsTime.h __hscore_gettimeofday" gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt #elif HAVE_FTIME type CTimeB = () #ifndef mingw32_HOST_OS foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt #else foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO () #endif #else foreign import ccall unsafe "time.h time" time :: Ptr CTime -> IO CTime #endif #endif /* ! __HUGS__ */