From d8f5fc44ca002e0244c4ee7a809dc61eab3c979f Mon Sep 17 00:00:00 2001 From: sof Date: Fri, 14 Mar 1997 05:21:13 +0000 Subject: [PATCH] [project @ 1997-03-14 05:21:13 by sof] New standard library --- ghc/lib/required/Time.lhs | 365 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 365 insertions(+) create mode 100644 ghc/lib/required/Time.lhs diff --git a/ghc/lib/required/Time.lhs b/ghc/lib/required/Time.lhs new file mode 100644 index 0000000..881166d --- /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} -- 1.7.10.4