-----------------------------------------------------------------------------
-- |
-- Module : System.Time
-- Copyright : (c) The University of Glasgow 2001
-- License : BSD-style (see the file libraries/old-time/LICENSE)
--
-- Maintainer : [email protected]
-- Stability : provisional
-- Portability : portable
--
-- The standard Time library, providing standard 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 <[email protected]>:
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 <time.h>
# 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 System.IO.Unsafe
#ifdef __HUGS__
import Hugs.Time ( getClockTimePrim, toCalTimePrim, toClockTimePrim )
#else
import Foreign
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 .. 43200 [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.
getClockTime :: IO ClockTime
#ifdef __HUGS__
getClockTime = do
(sec,usec) <- getClockTimePrim
return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000))
#elif HAVE_GETTIMEOFDAY
getClockTime = do
let realToInteger = round . realToFrac :: Real a => a -> Integer
allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do
throwErrnoIfMinus1_ "getClockTime" $ 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 (TOD (realToInteger sec) ((realToInteger usec) * 1000000))
#elif HAVE_FTIME
getClockTime = do
let realToInteger = round . realToFrac :: Real a => a -> Integer
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
let realToInteger = round . realToFrac :: Real a => a -> Integer
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 min sec psec)
(TOD c_sec c_psec) =
let
sec_diff = toInteger sec +
60 * toInteger min +
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
let realToInteger = round . realToFrac :: Real a => a -> Integer
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 (fromIntegral 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
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
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 min)
(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 min 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 > 43200 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 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 (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.
--
gmtoff <- gmtoff p_tm
let realToInteger = round . realToFrac :: Real a => a -> Integer
res = realToInteger t - fromIntegral tz + fromIntegral gmtoff
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 (CalendarTime year mon day hour min 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 -- 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' = 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 td@(TimeDiff year month day hour min 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 td
'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 min
'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 (TimeDiff year month day hour min sec _) =
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, min, 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 "time.h 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 "time.h 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 "time.h 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__ */
|
