diff --git a/ghc/lib/required/Time.lhs b/ghc/lib/required/Time.lhs new file mode 100644 index 0000000000000000000000000000000000000000..881166d8c9beac8114934f20e668f0596a5649b7 --- /dev/null +++ b/ghc/lib/required/Time.lhs @@ -0,0 +1,365 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1995-97 +% +\section[Time]{Haskell 1.4 Time of Day Library} + +The {\em 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). + +\begin{code} +module Time + ( + CalendarTime(..), + Month, + Day, + CalendarTime(CalendarTime), + TimeDiff(TimeDiff), + ClockTime, + getClockTime, addToClockTime, diffClockTimes, + toCalendarTime, toUTCTime, toClockTime, + calendarToTimeString, formatCalendarTime + ) where + +import PrelBase +import ST +import IOBase ( IOError(..), constructErrorAndFail ) +import ArrBase +import STBase + +import PackedString (unpackPS, packCBytesST) +import PosixUtil (allocWords, allocChars) +\end{code} + +One way to partition and give name to chunks of a year and a week: + +\begin{code} +data Month + = January | February | March | April + | May | June | July | August + | September | October | November | December + deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) + +data Day + = Sunday | Monday | Tuesday | Wednesday + | Thursday | Friday | Saturday + deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) + +\end{code} + +@ClockTime@ is an abstract type, used for the internal clock time. +Clock times may be compared, converted to strings, or converted to an +external calendar time @CalendarTime@. + +\begin{code} +data ClockTime = TOD Integer Integer + deriving (Eq, Ord) +\end{code} + +When a @ClockTime@ is shown, it is converted to a string of the form +@"Mon Nov 28 21:45:41 GMT 1994"@. + +For now, we are restricted to roughly: +Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because +we use the C library routines based on 32 bit integers. + +\begin{code} +instance Show ClockTime where + showsPrec p (TOD sec@(J# a# s# d#) nsec) = showString $ unsafePerformPrimIO $ + allocChars 32 >>= \ buf -> + _ccall_ showTime (I# s#) (ByteArray bottom d#) buf + >>= \ str -> + _ccall_ strlen str >>= \ len -> + packCBytesST len str >>= \ ps -> + return (unpackPS ps) + + showList = showList__ (showsPrec 0) +\end{code} + + +@CalendarTime@ is a user-readable and manipulable +representation of the internal $ClockTime$ type. 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. + +\begin{code} +data CalendarTime + = CalendarTime { + ctYear :: Int, + ctMonth :: Int, + ctDay :: Int, + ctHour :: Int, + ctMin :: Int, + ctSec :: Int, + ctPicosec :: Integer, + ctWDay :: Day, + ctYDay :: Int, + ctTZName :: String, + ctTZ :: Int, + ctIsDST :: Bool + } + deriving (Eq,Ord,Read,Show) + +\end{code} + +The @TimeDiff@ type records the difference between two clock times in +a user-readable way. + +\begin{code} +data TimeDiff + = TimeDiff { + tdYear :: Int, + tdMonth :: Int, + tdDay :: Int, + tdHour :: Int, + tdMin :: Int, + tdSec :: Int, + tdPicosec :: Integer -- not standard + } + deriving (Eq,Ord,Read,Show) +\end{code} + +@getClockTime@ returns the current time in its internal representation. + +\begin{code} +getClockTime :: IO ClockTime +getClockTime = + malloc1 `thenIO_Prim` \ i1 -> + malloc1 `thenIO_Prim` \ i2 -> + _ccall_ getClockTime i1 i2 `thenIO_Prim` \ rc -> + if rc == 0 then + cvtUnsigned i1 `thenIO_Prim` \ sec -> + cvtUnsigned i2 `thenIO_Prim` \ nsec -> + return (TOD sec (nsec * 1000)) + else + constructErrorAndFail "getClockTime" + where + malloc1 = ST $ \ (S# s#) -> + case newIntArray# 1# s# of + StateAndMutableByteArray# s2# barr# -> (MutableByteArray bottom barr#, S# s2#) + + -- The C routine fills in an unsigned word. We don't have `unsigned2Integer#,' + -- so we freeze the data bits and use them for an MP_INT structure. Note that + -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably + -- acceptable to gmp. + + cvtUnsigned (MutableByteArray _ arr#) = ST $ \ (S# s#) -> + case readIntArray# arr# 0# s# of + StateAndInt# s2# r# -> + if r# ==# 0# then + (0, S# s2#) + else + case unsafeFreezeByteArray# arr# s2# of + StateAndByteArray# s3# frozen# -> (J# 1# 1# frozen#, S# s3#) + +\end{code} + +@addToClockTime@ {\em d} {\em t} adds a time difference {\em d} and a +clock time {\em t} to yield a new clock time. The difference {\em d} +may be either positive or negative. @[diffClockTimes@ {\em t1} {\em +t2} returns the difference between two clock times {\em t1} and {\em +t2} as a @TimeDiff@. + + +\begin{code} +addToClockTime :: TimeDiff -> ClockTime -> ClockTime +addToClockTime (TimeDiff year mon day hour min sec psec) + (TOD c_sec c_psec) = unsafePerformPrimIO $ + allocWords (``sizeof(time_t)'') >>= \ res -> + _ccall_ toClockSec year mon day hour min sec 1 res + >>= \ ptr@(A# ptr#) -> + if ptr /= ``NULL'' then + let + diff_sec = (int2Integer# (indexIntOffAddr# ptr# 0#)) + diff_psec = psec + in + return (TOD (c_sec + diff_sec) (c_psec + diff_psec)) + else + error "Time.addToClockTime: can't perform conversion of TimeDiff" + + +diffClockTimes :: ClockTime -> ClockTime -> TimeDiff +diffClockTimes tod_a tod_b = + let + CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toCalendarTime tod_a + CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toCalendarTime tod_b + in + TimeDiff (year_a - year_b) + (mon_a - mon_b) + (day_a - day_b) + (hour_a - hour_b) + (min_b - min_a) + (sec_a - sec_b) + (psec_a - psec_b) +\end{code} + +@toCalendarTime@ {\em t} converts {\em t} to a local time, modified by +the current timezone and daylight savings time settings. @toUTCTime@ +{\em t} converts {\em t} into UTC time. @toClockTime@ {\em l} +converts {\em l} into the corresponding internal @ClockTime@. The +{\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are +ignored. + +\begin{code} +toCalendarTime :: ClockTime -> CalendarTime +toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO $ + allocWords (``sizeof(struct tm)''::Int) >>= \ res -> + allocChars 32 >>= \ zoneNm -> + _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm >>= \ () -> + _ccall_ toLocalTime (I# s#) (ByteArray bottom d#) res + >>= \ tm -> + if tm == (``NULL''::Addr) then + error "Time.toCalendarTime: out of range" + else + _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm >>= \ sec -> + _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm >>= \ min -> + _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm >>= \ hour -> + _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm >>= \ mday -> + _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm >>= \ mon -> + _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm >>= \ year -> + _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm >>= \ wday -> + _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm >>= \ yday -> + _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm >>= \ isdst -> + _ccall_ ZONE tm >>= \ zone -> + _ccall_ GMTOFF tm >>= \ tz -> + _ccall_ strlen zone >>= \ len -> + packCBytesST len zone >>= \ tzname -> + returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec + wday yday (unpackPS tzname) tz (isdst /= 0)) + +toUTCTime :: ClockTime -> CalendarTime +toUTCTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO ( + allocWords (``sizeof(struct tm)''::Int) >>= \ res -> + allocChars 32 >>= \ zoneNm -> + _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm >>= \ () -> + _ccall_ toUTCTime (I# s#) (ByteArray bottom d#) res + >>= \ tm -> + if tm == (``NULL''::Addr) then + error "Time.toUTCTime: out of range" + else + _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm >>= \ sec -> + _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm >>= \ min -> + _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm >>= \ hour -> + _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm >>= \ mday -> + _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm >>= \ mon -> + _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm >>= \ year -> + _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm >>= \ wday -> + _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm >>= \ yday -> + returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec + wday yday "UTC" 0 False) + ) + +toClockTime :: CalendarTime -> ClockTime +toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) = + 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 + unsafePerformPrimIO ( + allocWords (``sizeof(time_t)'') >>= \ res -> + _ccall_ toClockSec year mon mday hour min sec tz res + >>= \ ptr@(A# ptr#) -> + if ptr /= ``NULL'' then + returnPrimIO (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec) + else + error "Time.toClockTime: can't perform conversion" + ) + +bottom :: (Int,Int) +bottom = error "Time.bottom" +\end{code} + +\begin{code} +calendarTimeToString :: CalendarTime -> String +calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" + +formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String +formatCalendarTime l + fmt + ct@(CalendarTime + year mon + day hour + min sec + sdec + wday yday tzname _ _) + = doFmt fmt + where + doFmt ('%':c:cs) = decode c ++ doFmt cs + doFmt (c:cs) = c : doFmt cs + doFmt "" = "" + + to12 h = let h' = h `mod` 12 in if h == 0 then 12 else h + + decode 'A' = fst (wdays l !! fromEnum wday) + decode 'a' = snd (wdays l !! fromEnum wday) + decode 'B' = fst (months l !! fromEnum mon) + decode 'b' = snd (months l !! fromEnum mon) + decode 'h' = snd (months l !! fromEnum mon) + decode 'C' = show2 (year `quot` 100) + decode 'c' = doFmt (dateTimeFmt l) + decode 'D' = doFmt "%m/%d/%y" + decode 'd' = show2 day + decode 'e' = show2' day + decode 'H' = show2 hour + decode 'I' = show2 (to12 hour) + decode 'j' = show3 yday + decode 'k' = show2' hour + decode 'l' = show2' (to12 hour) + decode 'M' = show2 min + decode 'm' = show2 (fromEnum mon+1) + decode 'n' = "\n" + decode 'p' = (if hour < 12 then fst else snd) (amPm l) + decode 'R' = doFmt "%H:%M" + decode 'r' = doFmt (time12Fmt l) + decode 'T' = doFmt "%H:%M:%S" + decode 't' = "\t" + decode 'S' = show2 sec + decode 's' = show2 sec -- Implementation-dependent, sez the lib doc.. + decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) + decode 'u' = show (let n = fromEnum wday in if n == 0 then 7 else n) + decode 'V' = + let (week, days) = + (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' = + show2 ((yday + 7 - if fromEnum wday > 0 then + fromEnum wday - 1 else 6) `div` 7) + decode 'w' = show (fromEnum wday) + decode 'X' = doFmt (timeFmt l) + decode 'x' = doFmt (dateFmt l) + decode 'Y' = show year + decode 'y' = show2 (year `rem` 100) + decode 'Z' = tzname + decode '%' = "%" + decode c = [c] + +show2, show2', show3 :: Int -> String +show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)] +show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x +show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100) + +\end{code}