X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTime.hsc;h=74293eeeb60a5b68315ae1a4fae9b4b8c85d64a1;hb=69b2983d1ef10fefe155db9f777b9201e4c5b447;hp=9eeed25e629b6d5f309a2aef35e763deba79fa21;hpb=b4f179ff640c0399753696faaf8f87aca4ab2418;p=ghc-base.git diff --git a/System/Time.hsc b/System/Time.hsc index 9eeed25..74293ee 100644 --- a/System/Time.hsc +++ b/System/Time.hsc @@ -2,25 +2,22 @@ -- | -- Module : System.Time -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- --- The standard Time library. --- +-- 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 ------------------------------ -The Time library provides 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). - 2000/06/17 : RESTRICTIONS: * min./max. time diff currently is restricted to @@ -69,15 +66,16 @@ TODO: module System.Time ( - Month(..) - , Day(..) + -- * Clock times - , ClockTime(..) -- non-standard, lib. report gives this as abstract + 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 @@ -87,7 +85,11 @@ module System.Time , timeDiffToString -- non-standard , formatTimeDiff -- non-standard + -- * Calendar times + , CalendarTime(..) + , Month(..) + , Day(..) , toCalendarTime , toUTCTime , toClockTime @@ -102,7 +104,11 @@ module System.Time #ifdef __NHC__ #include -#define HAVE_TM_ZONE 1 +# if defined(__sun) || defined(__CYGWIN32__) +# define HAVE_TZNAME 1 +# else +# define HAVE_TM_ZONE 1 +# endif import Ix #endif @@ -121,23 +127,31 @@ import Foreign.C -- 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) --- @ClockTime@ is an abstract type, used for the internal clock time. +-- | A representation of the internal clock time. -- Clock times may be compared, converted to strings, or converted to an --- external calendar time @CalendarTime@. - -data ClockTime = TOD Integer -- Seconds since 00:00:00 on 1 Jan 1970 - Integer -- Picoseconds with the specified second +-- 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 @@ -149,49 +163,47 @@ instance Show ClockTime where (unsafePerformIO (toCalendarTime t))) {- -@CalendarTime@ is a user-readable and manipulable -representation of the internal $ClockTime$ type. The -numeric fields have the following ranges. +The numeric fields have the following ranges. \begin{verbatim} Value Range Comments ----- ----- -------- year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] -mon 0 .. 11 [Jan = 0, Dec = 11] 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?] -wday 0 .. 6 [Sunday = 0, Saturday = 6] yday 0 .. 365 [364 in non-Leap years] tz -43200 .. 43200 [Variation from UTC in seconds] \end{verbatim} - -The {\em tzname} field is the name of the time zone. The {\em isdst} -field indicates whether Daylight Savings Time would be in effect. -} +-- | 'CalendarTime' is a user-readable and manipulable +-- representation of the internal 'ClockTime' type. + data CalendarTime = CalendarTime { - ctYear :: Int, - ctMonth :: Month, - ctDay :: Int, - ctHour :: Int, - ctMin :: Int, - ctSec :: Int, - ctPicosec :: Integer, - ctWDay :: Day, - ctYDay :: Int, - ctTZName :: String, - ctTZ :: Int, - ctIsDST :: Bool + 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) --- The @TimeDiff@ type records the difference between two clock times in --- a user-readable way. +-- | records the difference between two clock times in a user-readable way. data TimeDiff = TimeDiff { @@ -205,11 +217,13 @@ data TimeDiff } deriving (Eq,Ord,Read,Show) +-- | null time difference. + noTimeDiff :: TimeDiff noTimeDiff = TimeDiff 0 0 0 0 0 0 0 -- ----------------------------------------------------------------------------- --- getClockTime returns the current time in its internal representation. +-- | returns the current time in its internal representation. getClockTime :: IO ClockTime #ifdef __HUGS__ @@ -219,32 +233,34 @@ getClockTime = do #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 (fromIntegral sec) ((fromIntegral usec) * 1000000)) + 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 (fromIntegral sec) (fromIntegral msec * 1000000000)) + return (TOD (realToInteger sec) (fromIntegral msec * 1000000000)) #else /* use POSIX time() */ getClockTime = do secs <- time nullPtr -- can't fail, according to POSIX - return (TOD (fromIntegral secs) 0) + 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. diffClockTimes t1 t2 returns --- the difference between two clock times t1 and t2 as a TimeDiff. +-- | @'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) @@ -270,6 +286,9 @@ addToClockTime (TimeDiff year mon day hour min sec psec) 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 @@ -283,6 +302,8 @@ diffClockTimes (TOD sa pa) (TOD sb pb) = } +-- | converts a time difference to normal form. + normalizeTimeDiff :: TimeDiff -> TimeDiff -- FIXME: handle psecs properly -- FIXME: ?should be called by formatTimeDiff automagically? @@ -332,11 +353,11 @@ gmtoff x = (#peek struct tm,tm_gmtoff) x #else /* ! HAVE_TM_ZONE */ # if HAVE_TZNAME || defined(_WIN32) -# if cygwin32_TARGET_OS +# if cygwin32_HOST_OS # define tzname _tzname # endif -# ifndef mingw32_TARGET_OS -foreign import ccall unsafe "&tzname" tzname :: Ptr (Ptr CChar) +# ifndef mingw32_HOST_OS +foreign import ccall unsafe "time.h &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) @@ -356,11 +377,12 @@ 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) + let realToInteger = round . realToFrac :: Real a => a -> Integer + return (-fromIntegral (realToInteger tz)) # else /* ! HAVE_DECL_ALTZONE */ -#if !defined(mingw32_TARGET_OS) -foreign import ccall unsafe "timezone" timezone :: Ptr CLong +#if !defined(mingw32_HOST_OS) +foreign import ccall "time.h &timezone" timezone :: Ptr CLong #endif -- Assume that DST offset is 1 hour ... @@ -379,12 +401,10 @@ gmtoff x = do #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- --- toCalendarTime t converts t to a local time, modified by --- the current timezone and daylight savings time settings. toUTCTime --- t converts t into UTC time. toClockTime l converts l into the --- corresponding internal ClockTime. The wday, yday, tzname, and isdst fields --- are ignored. - +-- | 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__ @@ -395,6 +415,9 @@ toCalendarTime = clockToCalendarTime_reentrant (throwAwayReturnPointer localtim 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 @@ -481,6 +504,10 @@ clockToCalendarTime_aux is_utc p_tm psec = do (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 @@ -528,16 +555,23 @@ toClockTime (CalendarTime year mon mday hour min sec psec -- result. -- gmtoff <- gmtoff p_tm - let res = fromIntegral t - tz + fromIntegral gmtoff - return (TOD (fromIntegral res) psec) + 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 _ _) = @@ -609,16 +643,21 @@ show2' 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' -- 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 @@ -679,29 +718,36 @@ formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) type CTm = () -- struct tm #if HAVE_LOCALTIME_R -foreign import ccall unsafe localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +foreign import ccall unsafe "time.h localtime_r" + localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else -foreign import ccall unsafe localtime :: Ptr CTime -> IO (Ptr CTm) +foreign import ccall unsafe "time.h localtime" + localtime :: Ptr CTime -> IO (Ptr CTm) #endif #if HAVE_GMTIME_R -foreign import ccall unsafe gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +foreign import ccall unsafe "time.h gmtime_r" + gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else -foreign import ccall unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) +foreign import ccall unsafe "time.h gmtime" + 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 +foreign import ccall unsafe "time.h mktime" + mktime :: Ptr CTm -> IO CTime +foreign import ccall unsafe "time.h time" + time :: Ptr CTime -> IO CTime #if HAVE_GETTIMEOFDAY type CTimeVal = () -foreign import ccall unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt +foreign import ccall unsafe "time.h gettimeofday" + gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt #endif #if HAVE_FTIME type CTimeB = () -#ifndef mingw32_TARGET_OS -foreign import ccall unsafe ftime :: Ptr CTimeB -> IO CInt +#ifndef mingw32_HOST_OS +foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt #else -foreign import ccall unsafe ftime :: Ptr CTimeB -> IO () +foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO () #endif #endif #endif /* ! __HUGS__ */