X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTime.hsc;h=a2c6b5b2494740591f40facf2ca16c79508cd304;hb=a2a70b9bf60672c72b35654105402cf21238b6f4;hp=91b677a54fe344290468007e7c723220c9696e7c;hpb=eff5b5ab4fa292b2fd343fcdd2672a737ab0a98e;p=haskell-directory.git diff --git a/System/Time.hsc b/System/Time.hsc index 91b677a..a2c6b5b 100644 --- a/System/Time.hsc +++ b/System/Time.hsc @@ -8,19 +8,16 @@ -- 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,7 @@ module System.Time #ifdef __NHC__ #include -# ifdef __sun +# if defined(__sun) || defined(__CYGWIN32__) # define HAVE_TZNAME 1 # else # define HAVE_TM_ZONE 1 @@ -125,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 @@ -153,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 { @@ -209,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__ @@ -248,10 +258,9 @@ getClockTime = do #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) @@ -261,8 +270,8 @@ addToClockTime (TimeDiff year mon day hour min sec psec) 60 * toInteger min + 3600 * toInteger hour + 24 * 3600 * toInteger day - cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec)) - -- FIXME! ^^^^ + (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 @@ -277,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 @@ -290,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? @@ -302,12 +316,12 @@ normalizeTimeDiff :: TimeDiff -> TimeDiff -- errors normalizeTimeDiff td = let - rest0 = tdSec td - + 60 * (tdMin td - + 60 * (tdHour td - + 24 * (tdDay td - + 30 * (tdMonth td - + 365 * tdYear td)))) + 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) @@ -315,12 +329,12 @@ normalizeTimeDiff td = (diffHours, rest4) = rest3 `quotRem` 3600 (diffMins, diffSecs) = rest4 `quotRem` 60 in - td{ tdYear = diffYears - , tdMonth = diffMonths - , tdDay = diffDays - , tdHour = diffHours - , tdMin = diffMins - , tdSec = diffSecs + td{ tdYear = fromInteger diffYears + , tdMonth = fromInteger diffMonths + , tdDay = fromInteger diffDays + , tdHour = fromInteger diffHours + , tdMin = fromInteger diffMins + , tdSec = fromInteger diffSecs } #ifndef __HUGS__ @@ -339,14 +353,14 @@ 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 "time.h &tzname" tzname :: Ptr (Ptr CChar) +# 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 (Ptr CChar) +foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr CString # endif zone x = do dst <- (#peek struct tm,tm_isdst) x @@ -363,10 +377,11 @@ 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) +#if !defined(mingw32_HOST_OS) foreign import ccall "time.h &timezone" timezone :: Ptr CLong #endif @@ -386,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__ @@ -402,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 @@ -439,13 +455,16 @@ 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 @@ -453,6 +472,7 @@ clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = 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 @@ -488,6 +508,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 @@ -543,9 +567,15 @@ toClockTime (CalendarTime year mon mday hour min sec psec -- ----------------------------------------------------------------------------- -- 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 _ _) = @@ -617,16 +647,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 @@ -702,21 +737,20 @@ foreign import ccall unsafe "time.h gmtime" #endif 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 = () +type CTimeZone = () foreign import ccall unsafe "time.h gettimeofday" - gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt -#endif - -#if HAVE_FTIME + gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt +#elif HAVE_FTIME type CTimeB = () -#ifndef mingw32_TARGET_OS +#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__ */