Commit d8f5fc44 authored by sof's avatar sof
Browse files

[project @ 1997-03-14 05:21:13 by sof]

New standard library
parent cc35bcba
%
% (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 =formatCalendarTimedefaultTimeLocale"%c"
formatCalendarTime::TimeLocale->String->CalendarTime->String
formatCalendarTimel
fmt
ct@(CalendarTime
yearmon
dayhour
minsec
sdec
wdayydaytzname__)
=doFmtfmt
where
doFmt('%':c:cs)=decodec++doFmtcs
doFmt(c:cs)=c:doFmtcs
doFmt""=""
to12h=leth'=h`mod`12inifh==0then12elseh
decode'A'=fst(wdaysl!!fromEnumwday)
decode'a'=snd(wdaysl!!fromEnumwday)
decode'B'=fst(monthsl!!fromEnummon)
decode'b'=snd(monthsl!!fromEnummon)
decode'h'=snd(monthsl!!fromEnummon)
decode'C'=show2(year`quot`100)
decode'c'=doFmt(dateTimeFmtl)
decode'D'=doFmt"%m/%d/%y"
decode'd'=show2day
decode'e'=show2'day
decode'H'=show2hour
decode'I'=show2(to12hour)
decode'j'=show3yday
decode'k'=show2'hour
decode'l'=show2'(to12hour)
decode'M'=show2min
decode'm'=show2(fromEnummon+1)
decode'n'="\n"
decode'p'=(ifhour<12thenfstelsesnd)(amPml)
decode'R'=doFmt"%H:%M"
decode'r'=doFmt(time12Fmtl)
decode'T'=doFmt"%H:%M:%S"
decode't'="\t"
decode'S'=show2sec
decode's'=show2 sec --Implementation-dependent, sez the lib doc..
decode'U'=show2((yday+7-fromEnumwday)`div`7)
decode'u'=show(letn=fromEnumwdayinifn==0then7elsen)
decode'V'=
let(week,days)=
(yday+7-iffromEnumwday>0then
fromEnumwday-1else6)`divMod`7
in
show2(if days>=4
thenweek+1
elseifweek==0then53elseweek)
decode'W'=
show2((yday+7-iffromEnumwday>0then
fromEnumwday-1else6)`div`7)
decode'w'=show(fromEnumwday)
decode'X'=doFmt(timeFmtl)
decode'x'=doFmt(dateFmtl)
decode'Y'=showyear
decode'y'=show2(year`rem`100)
decode'Z'=tzname
decode'%'="%"
decodec=[c]
show2,show2',show3::Int->String
show2x=[intToDigit(x`quot`10),intToDigit(x`rem`10)]
show2'x=ifx<10then['',intToDigitx]elseshow2x
show3x=intToDigit(x`quot`100):show2(x`rem`100)
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment