{-# OPTIONS -cpp -fglasgow-exts #-} module NewTime ( -- * ClockTime ClockTime, getClockTime, -- $clocktime -- * Timezones Timezone, utcTimezone, taiTimezone, timezoneFromUTCOffset, timezoneFromName, timezoneUTCOffset, timezoneName, getCurrentTimezone, -- * CalendarTime CalendarTime(..), clockTimeToCalendarTime, clockTimeToUTCTime, clockTimeToTAITime, clockTimeToCalendarTimeTZ, calendarTimeToClockTime, calendarTimeDayOffsets, formatCalendarTime, ) where #ifndef __HUGS__ #include "HsBase.h" #endif import Foreign import Foreign.C import System.Locale import Data.Maybe ( fromJust ) -- ------------------------------------------------------------------------- -- * ClockTime -- | A representation of absolute time, measured as picoseconds since -- the epoch, where the epoch is 1 January 1970 00:10 TAI. newtype ClockTime = ClockTime Integer deriving (Eq, Ord, Num, Enum, Real, Integral) instance Show ClockTime where show (ClockTime t) = show t instance Read ClockTime where readsPrec p s = [ (ClockTime t, s) | (t,s) <- readsPrec p s ] {- $clocktime Our ClockTime is defined in terms of TAI, because this provides an absolute time scale and can be used for accurate time calculations. However, this is not always implementable. Many systems run their system clocks on a time scale that ignores leap seconds. For example, POSIX's time_t uses a broken notion of \"seconds since the epoch\", defined by a formula in terms of UTC time ignoring leap seconds. On systems which run their clocks on time_t time, the library will do its best to convert to TAI time for a ClockTime. The effect is that the ClockTime might be incorrect by up to 1 second around the time of a leap second (it depends on how your system adjusts its clock when a leap second occurs). Regardless of what the system supports, calculations on values of type ClockTime are well-defined and deterministic. Inaccuracies only occur at the boundaries: - getClockTime might be inaccurate on Unix systems, for the reasons mentioned above. - Converting a ClockTime representing a future time into a UTC-based CalendarTime might be inaccurate because of the lack of knowledge of future leap seconds. This problem will be present in any library providing UTC operations. -} -- ----------------------------------------------------------------------------- -- getClockTime returns the current time in its internal representation. getSystemTime :: IO Integer -- picosec #ifdef __HUGS__ getSystemTime = do (sec,usec) <- getClockTimePrim return (fromIntegral sec * 10^12 + fromIntegral usec * 1000000) #elif HAVE_GETTIMEOFDAY getSystemTime = do allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do throwErrnoIfMinus1_ "getSystemTime" $ gettimeofday p_timeval nullPtr sec <- (#peek struct timeval,tv_sec) p_timeval :: IO CTime usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime return (fromIntegral sec * 10^12 + fromIntegral usec * 10^6) type CTimeVal = () foreign import ccall unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt #elif HAVE_FTIME getSystemTime = 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 (fromIntegral sec * 10^12 + fromIntegral msec * 10^9) #else /* use POSIX time() */ getSystemTime = do secs <- time nullPtr -- can't fail, according to POSIX return (fromIntegral secs * 10^12) #endif -- | Returns the current absolute time. getClockTime :: IO ClockTime getClockTime = getSystemTime >>= return . ClockTime . systemTimeToTAI systemTimeToTAI :: Integer -> Integer systemTimeToTAI ct = posixToTAI secs * 10^12 + psecs where (secs,psecs) = quotRem ct (10^12) taiToSystemTime :: Integer -> Integer taiToSystemTime tai = taiToPosix secs * 10^12 + psecs where (secs,psecs) = quotRem tai (10^12) posixToTAI :: Integer -> Integer posixToTAI time_t = time_t + toInteger (length (takeWhile ( Integer taiToPosix tai = tai - toInteger (length (takeWhile (<=tai) tai_leapsecs)) + 10 tai_leapsecs :: [Integer] tai_leapsecs = zipWith (+) posix_leapsecs [-9,-8..] -- why [-9,-8..] ? -- Our TAI epoch is 10 seconds later than the time_t epoch for a start. -- Also, we want to add one to each time_t leap second point to get the leap -- second point in the TAI scale. -- Calculated below. Right now, we're assuming that all leap seconds add -- an extra second (i.e. cause UTC to go backwards). If there are ever -- forward leap seconds, then things will get more complicated. posix_leapsecs :: [Integer] posix_leapsecs = [78796799,94694399,126230399,157766399,189302399,220924799,252460799,283996799,315532799,362793599,394329599,425865599,489023999,567993599,631151999,662687999,709948799,741484799,773020799,820454399,867715199,915148799] -- Here is how we calculate which posix time_t values are leap seconds, given -- a bunch of UTC dates: {- leapsecs = map (\(ClockTime t) -> t `quot` 10^12) (map (fromJust.calendarTimeToClockTime.f) triples) where f (yr,mo,day) = CalendarTime { ctYear = yr, ctMonth = toEnum (mo-1), ctDay = day, ctHour = 23, ctMin = 59, ctSec = 59, ctPicosec = 0, ctTZ = taiTimezone -- disable the TAI<=>UTC conversion -- so that we can get the leapsec values in -- terms of time_t values. } triples= [ -- get these from eg. leapsecs.txt that comes with libtai or -- "leapseconds" that comes with the timezone library. (1972,06,30), (1972,12,31), (1973,12,31), (1974,12,31), (1975,12,31), (1976,12,31), (1977,12,31), (1978,12,31), (1979,12,31), (1981,06,30), (1982,06,30), (1983,06,30), (1985,06,30), (1987,12,31), (1989,12,31), (1990,12,31), (1992,06,30), (1993,06,30), (1994,06,30), (1995,12,31), (1997,06,30), (1998,12,31) ] -} -- ----------------------------------------------------------------------------- -- Timezones data Timezone = TAI | UTCOffset Int -- the offset relative to UTC in seconds (Maybe String) -- the name of this timezone deriving (Eq, Read, Ord) -- TODO proper Read,Ord instances -- | The UTC timezone utcTimezone :: Timezone utcTimezone = UTCOffset 0 (Just "UTC") -- | The TAI timezone taiTimezone :: Timezone taiTimezone = TAI instance Show Timezone where showsPrec _ t = showString (timezoneName t) -- | Make a 'Timezone' from an offset, in seconds relative to UTC, -- which must be smaller in magnitude than @+\/-12*60*60@. timezoneFromUTCOffset :: Int -> Timezone timezoneFromUTCOffset secs = UTCOffset secs Nothing -- | Make a 'Timezone' from a standard timezone name (eg. GMT, PDT). -- TAI is a valid timezone name. timezoneFromName :: String -> Maybe Timezone timezoneFromName "TAI" = Just TAI timezoneFromName name = case lookup name timezoneTable of Just t -> Just (UTCOffset t (Just name)) Nothing -> Nothing hours, minutes :: Int -> Int hours n = minutes (n * 60) minutes n = n * 60 timezoneTable :: [(String,Int)] timezoneTable = [ ("A", hours 1), ("ACDT", hours 10 + minutes 30), ("ACST", hours 9 + minutes 30), ("ADT", - hours 3), ("AEDT", hours 11), ("AEST", hours 10), ("AKDT", - hours 8), ("AKST", - hours 9), ("AST", - hours 4), ("AWST", hours 8), ("B", hours 2), ("BST", hours 1), ("C", hours 3), ("CDT", - hours 5), -- North america version ("CDT", hours 10 + minutes 30), -- Australia version (use ACDT) ("CEST", hours 2), ("CET", hours 1), ("CST", - hours 6), -- North america version ("CST", hours 9 + minutes 30), -- Australia version (use ACST) ("CXT", hours 7), ("D", hours 4), ("E", hours 5), ("EDT", - hours 4), -- North america version ("EDT", hours 11), -- Australia version (use AEDT) ("EEST", hours 3), ("EET", hours 2), ("EST", - hours 5), -- North america version ("EST", hours 10), -- Australia version (use AEST) ("F", hours 6), ("G", hours 7), ("GMT", 0), ("H", hours 8), ("HAA", - hours 3), ("HAC", - hours 5), ("HADT", - hours 9), ("HAE", - hours 4), ("HAP", - hours 7), ("HAR", - hours 6), ("HAST", - hours 10), ("HAT", - hours 2 + minutes 30), ("HAY", - hours 8), ("HNA", - hours 4), ("HNC", - hours 6), ("HNE", - hours 5), ("HNP", - hours 8), ("HNR", - hours 7), ("HNT", - hours 3 + minutes 30), ("HNY", - hours 9), ("I", hours 9), ("IST", hours 1), ("K", hours 10), ("L", hours 11), ("M", hours 12), ("MDT", - hours 6), ("MESZ", hours 2), ("MEZ", hours 1), ("MST", - hours 7), ("N", - hours 1), ("NDT", - hours 2 + minutes 30), ("NFT", hours 11 + minutes 30), ("NST", - hours 3 + minutes 30), ("O", - hours 2), ("P", - hours 3), ("PDT", - hours 7), ("PST", - hours 8), ("Q", - hours 4), ("R", - hours 5), ("S", - hours 6), ("T", - hours 7), ("U", - hours 8), ("UTC", 0), ("V", - hours 9), ("W", - hours 10), ("WEST", hours 1), ("WET", 0), ("WST", hours 8), ("X", - hours 11), ("Y", - hours 12), ("Z", 0) ] -- | Return the offset in seconds of the specified timezone relative -- to UTC. If the timezone is TAI, returns 'Nothing', because TAI -- cannot be represented as a fixed offset relative to UTC. timezoneUTCOffset :: Timezone -> Maybe Int timezoneUTCOffset TAI = Nothing timezoneUTCOffset (UTCOffset n _) = Just n -- | Return the timezone name corresponding to a 'Timezone' value. -- -- Some timezones may not correspond to a name, or the name of the timezone -- may not be known (some systems cannot convert easily from UTC offsets to -- timezone names), in which case 'timezoneName' returns 'Nothing'. -- -- Some timezone names correspond to more than one actual timezone. -- These are: CST, CDT, EST, and EDT. Each of these is used for an -- Australian timezone in addition to a North American one. -- 'timezoneName' is defined to return the North American versions of -- these. If you want the Australian versions, you can use the -- non-ambiguous names ACST, ACDT, AEST and AEDT respectively. -- timezoneName :: Timezone -> String timezoneName TAI = "TAI" timezoneName (UTCOffset secs (Just name)) = name timezoneName (UTCOffset secs Nothing) = case lookup secs (map (\(a,b) -> (b,a)) timezoneTable) of Nothing -> '+' : show (secs `quot` 60) -- TODO pad with zeros Just n -> n -- | Returns the current timezone from the environment. On Unix, the -- current timezone is taken from the @TZ@ environment variable, or -- the system default if @TZ@ is not set. getCurrentTimezone :: IO Timezone getCurrentTimezone = do t <- getClockTime cal <- clockTimeToCalendarTime t return (ctTZ cal) {- TODO; we also might want to allow rfc2822 style timezones. of the form "+nnnn" where nnnn is the offset from GMT. convienince routines to convert to/from rfc2822 time strings might be handy too. this is all not as important as it could be done in an add-in library, but might get common usage. Implementation notes: the library needs the list of timezone abbreviations and their offsets relative to UTC. -} -- ------------------------------------------------------------------------- -- * CalendarTime data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Int, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone } deriving (Eq, Ord, Read) #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_TARGET_OS # define tzname _tzname # endif # ifndef mingw32_TARGET_OS foreign import ccall unsafe "&tzname" tzname :: Ptr (Ptr CChar) # else foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr (Ptr CChar) # 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 tz) # else /* ! HAVE_DECL_ALTZONE */ #if !defined(mingw32_TARGET_OS) foreign import ccall unsafe "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 (fromIntegral tz - 3600) else tz)) # endif /* ! HAVE_DECL_ALTZONE */ #endif /* ! HAVE_TM_ZONE */ #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- -- Converting ClockTimes to CalendarTimes -- | Converts a 'ClockTime' to a 'CalendarTime' in the current timezone. -- Caveats for 'clockTimeToUTCTime' also apply here. clockTimeToCalendarTime :: ClockTime -> IO CalendarTime #ifdef __HUGS__ clockTimeToCalendarTime (ClockTime ct) = toCalTime False (taiToSystemTime ct) #elif HAVE_LOCALTIME_R clockTimeToCalendarTime (ClockTime ct) = clockToCalendarTime_reentrant (throwAwayReturnPointer localtime_r) False (taiToSystemTime ct) #else clockTimeToCalendarTime (ClockTime ct) = clockToCalendarTime_static localtime False (taiToSystemTime ct) #endif -- | Converts a 'ClockTime' to a 'CalendarTime' in UTC. -- -- Note that this function may produce unpredictable results for -- times sufficiently far in the future, because it is not known -- when leap seconds will need to be added to or subtracted from -- UTC. -- clockTimeToUTCTime :: ClockTime -> CalendarTime clockTimeToUTCTime (ClockTime ct) = toUTCCalendarTime (taiToSystemTime ct) -- | Converts a 'ClockTime' to a 'CalendarTime' in TAI. Always produces -- predictable results. -- clockTimeToTAITime :: ClockTime -> CalendarTime clockTimeToTAITime (ClockTime ct) = (toUTCCalendarTime ct) { ctTZ = TAI } #ifdef __HUGS__ toUTCCalendarTime ct = unsafePerformIO $ toCalTime True ct #elif HAVE_GMTIME_R toUTCCalendarTime ct = unsafePerformIO $ clockToCalendarTime_reentrant (throwAwayReturnPointer gmtime_r) True ct #else toUTCCalendarTime (ClockTime ct) = unsafePerformIO $ clockToCalendarTime_static gmtime True ct #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 () clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> Integer -> IO CalendarTime clockToCalendarTime_static fun is_utc ct = do let (secs,psecs) = quotRem ct (10^12) withObject (fromIntegral secs :: CTime) $ \ p_timer -> do p_tm <- fun p_timer -- can't fail, according to POSIX clockToCalendarTime_aux is_utc p_tm psecs clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> Integer -> IO CalendarTime clockToCalendarTime_reentrant fun is_utc ct = do let (secs,psecs) = quotRem ct (10^12) withObject (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 psecs 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 min <- (#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 month <- (#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 return (CalendarTime { ctYear = 1900 + fromIntegral year, ctMonth = fromIntegral month, ctDay = fromIntegral mday, ctHour = fromIntegral hour, ctMin = fromIntegral min, ctSec = fromIntegral sec, ctPicosec = psec, ctTZ = if is_utc then UTCOffset 0 (Just "UTC") else case timezoneFromName tzname of Nothing -> UTCOffset 0 (Just "UTC") Just tz -> tz }) #endif /* ! __HUGS__ */ -- | Converts a 'ClockTime' to a 'CalendarTime' in the specified timezone. -- Caveats for 'clockTimeToUTCTime' also apply here. clockTimeToCalendarTimeTZ :: Timezone -> ClockTime -> CalendarTime clockTimeToCalendarTimeTZ TAI ct = clockTimeToTAITime ct clockTimeToCalendarTimeTZ tz@(UTCOffset secs _) (ClockTime ct) = (clockTimeToUTCTime (ClockTime (ct + fromIntegral secs * 10^12))) { ctTZ = tz } -- ----------------------------------------------------------------------------- -- Converting CalendarTimes to ClockTimes -- | Convert a 'CalendarTime' to a 'ClockTime'. Some values of -- 'CalendarTime' do not represent a valid 'ClockTime', hence this -- function returns a 'Maybe' type. calendarTimeToClockTime :: CalendarTime -> Maybe ClockTime #ifdef __HUGS__ calendarTimeToClockTime (CalendarTime yr mon mday hour min sec psec tz) = unsafePerformIO $ do s <- toClockTimePrim (yr-1900) (fromEnum mon) mday hour min sec tz return (TOD (fromIntegral s) psec) #else /* ! __HUGS__ */ calendarTimeToClockTime (CalendarTime year mon mday hour min sec psec tz) = -- `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 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 min :: 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 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. -- gmtoff <- gmtoff p_tm let time_t = (fromIntegral t + fromIntegral gmtoff) * 10^12 + psec case tz of -- the CalendarTime was TAI already, so no need to adjust -- for leap seconds TAI -> return (Just (ClockTime time_t)) -- it was a UTC-based time, need to adjust for leap secs UTCOffset s _ -> return (Just (ClockTime (systemTimeToTAI time_t))) #endif /* ! __HUGS__ */ -- | Return the day of the week and the day of the year for a given -- CalendarTime. calendarTimeDayOffsets :: CalendarTime -> (Int,Int) calendarTimeDayOffsets (CalendarTime year mon mday hour min sec psec tz) = 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 min :: 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 mon :: CInt) (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt) (#poke struct tm,tm_isdst) p_tm (-1 :: CInt) t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input") (mktime p_tm) wday <- (#peek struct tm, tm_wday) p_tm yday <- (#peek struct tm, tm_wday) p_tm return (fromIntegral (wday :: CInt), fromIntegral (yday :: CInt)) -- ----------------------------------------------------------------------------- -- Converting time values to strings. instance Show CalendarTime where showsPrec _ ct = showString (calendarTimeToString ct) calendarTimeToString :: CalendarTime -> String calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String formatCalendarTime l fmt ct@(CalendarTime year mon day hour min sec _ tz) = doFmt fmt where (wday, yday) = calendarTimeDayOffsets ct 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 -- 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 min -- 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' = show2 sec -- number of secs since Epoch. (ToDo.) 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' = timezoneName tz -- 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) where x' = x `rem` 1000 to12 :: Int -> Int to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' #ifndef __HUGS__ -- ----------------------------------------------------------------------------- -- Foreign time interface (POSIX) type CTm = () -- struct tm #if HAVE_LOCALTIME_R foreign import ccall unsafe localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe localtime :: Ptr CTime -> IO (Ptr CTm) #endif #if HAVE_GMTIME_R foreign import ccall unsafe gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) #endif foreign import ccall unsafe mktime :: Ptr CTm -> IO CTime foreign import ccall unsafe time :: Ptr CTime -> IO CTime #if HAVE_FTIME type CTimeB = () #ifndef mingw32_TARGET_OS foreign import ccall unsafe ftime :: Ptr CTimeB -> IO CInt #else foreign import ccall unsafe ftime :: Ptr CTimeB -> IO () #endif #endif #endif /* ! __HUGS__ */