
On Mon, Jun 16, 2003 at 04:42:53PM +0100, Graham Klyne wrote:
... I think it's quite usual for people and applications to deal with a day as a consistent time interval without concern for possible leap seconds, so dealing with days as intervals of 24*60*60 seconds is useful for a majority of applications that deal with such intervals.
What about the fact that days are not actually intervals of 24*60*60 seconds (as I'm sure you know)? Most applications don't care, but it's crucial to give correct and unsurprising results.
I'm worried that the complexity to deal with leap seconds will end up being just as complicated as the complexity to deal with more general TimeDiff's as in the current library, in which case it may be necessary to bite the bullet and specify the behaviour of TimeDiffs completely and accurately.
Agreed, this discussion tends to get rather vague at times, so I'd like to put it on a more concrete footing if I may. I've put together rough suggestion for a starting point for a replacement System.Time, appended below. Please comment! Cheers, Simon ------------------------------------------------------------------------ ---- -- * ClockTime -- | A representation of absolute time data ClockTime = ClockTime { ctSeconds :: Integer, ctPicoseconds :: Integer } deriving (Eq, Ord, Show, Read) -- | returns the current absolute time getClockTime :: IO ClockTime -- | Difference between two 'ClockTime's data TimeDiff = TimeDiff { tdSeconds :: Integer, tdPicoseconds :: Integer } deriving (Eq, Ord, Show, Read) -- | An empty 'TimeDiff' noTimeDiff :: TimeDiff -- | Returns the difference between two 'ClockTime's diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -- | Adds a 'TimeDiff' to a 'ClockTime' addToClockTime :: ClockTime -> TimeDiff -> ClockTime {- Rationale: - TimeDiff is now an absolute measure of time period. Invariants: t1 `addToClockTime` (t2 `diffClockTimes` t1) == t2 t1 `addToClockTime` noTimeDiff == t1 t1 `diffClockTimes` t1 == noTimeDiff TODO: - This representation of TimeDiff is maybe not the best. Two other possibilities: use just picoseconds, or have the type be abstract with a way to extract picoseconds. - If we keep the seconds/picoseconds representation, should we specify that the TimeDiff returned by diffClockTimes is normalised? Should we provide a way to normalise a TimeDiff? -} ------------------------------------------------------------------------ ---- -- * CalendarTime data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Month, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone } deriving (Eq, Ord, Read, Show) data Timezone -- abstract -- | Make a 'Timezone' -- TODO: do we need to specify daylight savings time too? timezoneFromOffset :: Int -> Timezone timezoneFromName :: String -> Timezone timezoneOffset :: Timezone -> Int timezoneName :: Timezone -> String -- | Convert a 'ClockTime' to a 'CalendarTime' in the current timezone clockTimeToCalendarTime :: ClockTime -> IO CalendarTime -- | Convert a 'ClockTime' to a 'CalendarTime' in UTC clockTimeToUTCTime :: ClockTime -> CalendarTime -- | Convert a 'CalendarTime' to a 'ClockTime' -- TODO: can this raise an exception if the CalendarTime does not -- represent a valid time? Or should it return Maybe ClockTime? calendarTimeToClockTime :: CalendarTime -> ClockTime -- OPTIONAL: these are hard to implement, and require -- careful specification (see rationale below): addPicoseconds :: CalendarTime -> Integer -> CalendarTime addSeconds :: CalendarTime -> Integer -> CalendarTime addMinutes :: CalendarTime -> Integer -> CalendarTime addDays :: CalendarTime -> Integer -> CalendarTime addWeeks :: CalendarTime -> Integer -> CalendarTime addMonths :: CalendarTime -> Integer -> CalendarTime addYears :: CalendarTime -> Integer -> CalendarTime {- Rationale: - Adding "irregular" time differences should be done on CalendarTimes, because these operations depend on the timezone. - Need to define the meaning when the offset doesn't exist. eg. adding a day at the end of the month clearly rolls over into the next month. But what about adding a month to January 31st? -}

On 2003-06-17 at 13:53BST "Simon Marlow" wrote:
Please comment!
Cheers, Simon
------------------------------------------------------------------------ ---- -- * ClockTime
-- | A representation of absolute time data ClockTime = ClockTime { ctSeconds :: Integer, ctPicoseconds :: Integer }
Two Integer fields seems strange. Either ClockTime { ctPicoseconds :: Integer } would seem to make more sense. I don't see that saving a divide by 10^12 is a big win. But being able to represent times shorter than a picosecond would be. or ClockTime { ctSeconds :: Integer, ctPicoseconds:: real } or, better ClockTime { ctSeconds :: Ratio Integer }
deriving (Eq, Ord, Show, Read)
-- | returns the current absolute time getClockTime :: IO ClockTime
-- | Difference between two 'ClockTime's data TimeDiff = TimeDiff { tdSeconds :: Integer, tdPicoseconds :: Integer }
ditto. Maybe abstract over intervals so that the innards of the two types are another type (after all, ClockTime is just an interval after some instant).
deriving (Eq, Ord, Show, Read)
-- | An empty 'TimeDiff' noTimeDiff :: TimeDiff
-- | Returns the difference between two 'ClockTime's
-- * CalendarTime
data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Month, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone }
again query Integer for picoseconds -- some sort of fractional value would be better.
-- | Convert a 'CalendarTime' to a 'ClockTime' -- TODO: can this raise an exception if the CalendarTime does not -- represent a valid time? Or should it return Maybe ClockTime? calendarTimeToClockTime :: CalendarTime -> ClockTime
I'd vote for Maybe since it's more "functional" than exceptions. Jón -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk 31 Chalmers Road jf@cl.cam.ac.uk Cambridge CB1 3SZ +44 1223 570179 (after 14:00 only, please!)

On Tue, Jun 17, 2003 at 09:00:15PM +0100, Jon Fairbairn wrote:
On 2003-06-17 at 13:53BST "Simon Marlow" wrote:
-- * ClockTime
-- | A representation of absolute time data ClockTime = ClockTime { ctSeconds :: Integer, ctPicoseconds :: Integer }
Two Integer fields seems strange. Either ClockTime { ctPicoseconds :: Integer }
I strongly strongly agree with this. anything other than a single Integer seems silly since we have arbitrary precision integers, we might as well use them.
would seem to make more sense. I don't see that saving a divide by 10^12 is a big win. But being able to represent times shorter than a picosecond would be.
or ClockTime { ctSeconds :: Integer, ctPicoseconds:: real } or, better ClockTime { ctSeconds :: Ratio Integer }
I would prefer not to complicate the Time type like this at the moment, an ArbitraryTime or FracDuration type thing could be a seperate library. Mainly I just want to fix the fact that the current time library is completly unusable before worrying about extensions.
deriving (Eq, Ord, Show, Read)
-- | An empty 'TimeDiff' noTimeDiff :: TimeDiff
TimeDiff might as well just be an Integer, same argument as for ClockTime.
-- | Returns the difference between two 'ClockTime's
-- * CalendarTime
data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Month, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone }
again query Integer for picoseconds -- some sort of fractional value would be better.
-- | Convert a 'CalendarTime' to a 'ClockTime' -- TODO: can this raise an exception if the CalendarTime does not -- represent a valid time? Or should it return Maybe ClockTime? calendarTimeToClockTime :: CalendarTime -> ClockTime
I'd vote for Maybe since it's more "functional" than exceptions.
me too. as for the leap second issue, I suggest a simple solution inspired by http://freebsd.ntu.edu.tw/djb/proto/utctai.html ClockTimes and TimeDiffs are ALWAYS TAI with an epoch of 1970-01-01 00:00:10 TAI (to correspond to other libraries). a second is always a second. this greatly simplified the internals as simple arithmetic on integers is always correct. the only time UTC and leap seconds should come into play is when converting to or from a CalanderTime since UTC is meant to be a human-consumable notion of time, not a precise one. We will have to assume that an oracle exists to tell us which years had leap seconds in them, but such information is required by any scheme which works with UTC, many systems provide them and it is easy enough to embed a table. John -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

John Meacham wrote:
as for the leap second issue, I suggest a simple solution inspired by http://freebsd.ntu.edu.tw/djb/proto/utctai.html
That is a mirror or a local copy. DJB's page on UTC and TAI is at http://cr.yp.to/proto/utctai.html
ClockTimes and TimeDiffs are ALWAYS TAI with an epoch of 1970-01-01 00:00:10 TAI (to correspond to other libraries). a second is always a second.
The UTC second and the TAI second are precisely the same interval, and "tick" at the same time; TAI and UTC always differ by an integral number of seconds. TAI and UT0/UT1/UT2 are different.
this greatly simplified the internals as simple arithmetic on integers is always correct. the only time UTC and leap seconds should come into play is when converting to or from a CalanderTime since UTC is meant to be a human-consumable notion of time, not a precise one.
I'm not sure if this is really a correct notion of UTC. TAI is atomic time, and ticks at a precisely defined rate. UT1 is corrected solar time (actually sidereal time converted to solar time and corrected), and due to quirks in the earth's rotation, is not constant. UTC is a comprimise between the two. UTC ticks at TAI's rate, but is corrected with leap seconds to it within +- 0.9 seconds of UT1.
We will have to assume that an oracle exists to tell us which years had leap seconds in them, but such information is required by any scheme which works with UTC, many systems provide them and it is easy enough to embed a table.
I have to dig out my files on this (they are currently MIA due to job changes), but I believe the problem with this approach has to do with updating the leap second table in deployed systems. Also, all time broadcasts are by international agreement UTC (GPS may be different, but I can't remember), so anything a computer receives is going to be UTC. TAI may be the best thing to do in an ideal world, but the world is pretty much stuck with UTC. -- Matthew Donadio (m.p.donadio@ieee.org)

John Meacham wrote:
ClockTimes and TimeDiffs are ALWAYS TAI with an epoch of 1970-01-01 00:00:10 TAI (to correspond to other libraries). a second is always a second.
The UTC second and the TAI second are precisely the same interval, and "tick" at the same time; TAI and UTC always differ by an integral number of seconds. TAI and UT0/UT1/UT2 are different. yeah, this is what I meant by the difference is only made when
On Tue, Jun 17, 2003 at 06:20:32PM -0400, Matthew Donadio wrote: translating to a calendarTime. when represented as an offset from a specific epoch, they SHOULD be the same. (but arn't in practice) when systems which work via an offset from epoch system work with UTC (even if the internal representation doesn't use offset from epoch, the same problems apply to any system which wishes to find the differences between times) time ONE of the following MUST be true: 1) a UTC second is interpreted as a generally unpredictable different duration than a TAI second. 2) past timestamps (and possibly current) are incorrectly interpreted by a generally unpredictable amount. 3) you have a table of every leap second and all is well. unixs tend to do 1 when synchronized externally (like via ntp). free-running boxen (without external synchronization) do 2. there are libraries which do 3 which is good.
this greatly simplified the internals as simple arithmetic on integers is always correct. the only time UTC and leap seconds should come into play is when converting to or from a CalanderTime since UTC is meant to be a human-consumable notion of time, not a precise one.
I'm not sure if this is really a correct notion of UTC.
TAI is atomic time, and ticks at a precisely defined rate. UT1 is corrected solar time (actually sidereal time converted to solar time and corrected), and due to quirks in the earth's rotation, is not constant. UTC is a comprimise between the two. UTC ticks at TAI's rate, but is corrected with leap seconds to it within +- 0.9 seconds of UT1.
simple arithmetic only works when option 1 above isn't chosen. however most people that say 'just use UTC and forget about leap seconds' are implicity choosing option 1 above without realizing it.
We will have to assume that an oracle exists to tell us which years had leap seconds in them, but such information is required by any scheme which works with UTC, many systems provide them and it is easy enough to embed a table.
I have to dig out my files on this (they are currently MIA due to job changes), but I believe the problem with this approach has to do with updating the leap second table in deployed systems. Also, all time broadcasts are by international agreement UTC (GPS may be different, but I can't remember), so anything a computer receives is going to be UTC. TAI may be the best thing to do in an ideal world, but the world is pretty much stuck with UTC.
* But you need those tables anyway. * There is no correct solution which involves UTC and does not require tables of leap seconds. But I recognize that such tables will not always be available or up to date, in which case the time might be a little off, but there is no way around that, such systems are just slightly non-conformant which is okay for many people, but we should not standardize on a vaugely defined incorrect semantics, rather we should choose the correct solution and let implementations do their best to conform to it on a given system. for an example why you can't do UTC without a table: convert 1000 seconds after epoch into a UTC CalendarTime. you can't without knowing how many leap seconds occured in those 1000 seconds. alternativly, assume you have UTC time nativly, convert 2000 seconds ago into a CalanderTime, you cannot without leap second tables because you don't know how many leap seconds occured in the last 2000. UNIX hacks around this by changing the length of a second around a leap second, so every timestamp when interpreted as an offset from epoch without any leap seconds (i.e. every minute is 60 seconds) is correct, but the tradeoff is that the length of a second is no longer defined and you can't do time arithmetic or time offsets correctly. the moral, saying use UTC doesn't mean anything precise unless you specify the hacky way to interpret UTC which is going to be just as complicated and less functional as saying use TAI in the first place. at least now we would have the ability to actually represent precise times when the system provides enough resources to do so. John -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

John Meacham wrote:
* But you need [leap second] tables anyway. * There is no correct solution which involves UTC and does not require tables of leap seconds.
OK, I see the problem now.
But I recognize that such tables will not always be available or up to date, in which case the time might be a little off, but there is no way around that, such systems are just slightly non-conformant which is okay for many people, but we should not standardize on a vaugely defined incorrect semantics, rather we should choose the correct solution and let implementations do their best to conform to it on a given system.
Agreed.
UNIX hacks around this by changing the length of a second around a leap second, so every timestamp when interpreted as an offset from epoch without any leap seconds (i.e. every minute is 60 seconds) is correct, but the tradeoff is that the length of a second is no longer defined and you can't do time arithmetic or time offsets correctly.
Are current libraries really this brain dead? I haven't dealt with time in almost 10 years, and always had very strict requirements (timetaging satellite telemetry). Sloppiness like that really surprises me. -- Matthew Donadio (m.p.donadio@ieee.org)

On Tue, Jun 17, 2003 at 08:58:54PM -0400, Matthew Donadio wrote:
John Meacham wrote:
UNIX hacks around this by changing the length of a second around a leap second, so every timestamp when interpreted as an offset from epoch without any leap seconds (i.e. every minute is 60 seconds) is correct, but the tradeoff is that the length of a second is no longer defined and you can't do time arithmetic or time offsets correctly.
Are current libraries really this brain dead? I haven't dealt with time in almost 10 years, and always had very strict requirements (timetaging satellite telemetry). Sloppiness like that really surprises me.
yup. unfortunatly this brokenness is mandated by POSIX: POSIX.1 defines seconds since the Epoch as a value to be interpreted as the number of seconds between a specified time and the Epoch, according to a formula for conversion from UTC equivalent to conversion on the na basis that leap seconds are ignored and all years divisible by 4 are leap years. This value is not the same as the actual number of seconds between the time and the Epoch, because of leap seconds and because clocks are not required to be synchronised to a standard reference. The intention is that the interpretation of seconds since the Epoch values be consistent; see POSIX.1 Annex B 2.2.2 for further rationale. the only way to reconcile the POSIX time with real time is by changing the speed of the clock and hence the length of a POSIX second. even worse, POSIX got the formula for leap years wrong so you have to make up for a whole day at times (!!) (if you follow the standard exactly, the leap year problem is considered a typo by many). in any case, anyone who wants accurate times uses an alternate library such as djb's libtai or rolls their own solution. Using TAI internally and only dealing with UTC when translating between CalendarTimes has a number of advantages, CalendarTime already has a timezone field, so it is not even that odd to expect it to translate the time to UTC if that "timezone" is specified. TAI is well defined for arbitrary times in the past, using an 'Integer' means we can represent times accuratly across all of history and the future. :) This makes the native Time type in haskell suitable for actual scientific work, which is good. the only source of confusion I can think of is if the Integer representing TAI relative to epoch is misinterpreted as a time_t equivalent under POSIX, providing toPosixUTC :: ClockTime -> Integer and fromPosixUTC :: Integer -> ClockTime would be useful and advisable John -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

yup. unfortunatly this brokenness is mandated by POSIX:
Here's a link to the definition in the latest POSIX standard: http://www.opengroup.org/onlinepubs/007904975/basedefs/xbd_chap04.html#tag_0... (I don't know if they fixed the leap year "typo" or not). Regarding the TAI vs. UTC debate: my intention was that ClockTime should be an absolute interval of elapsed time since a well-defined point in time. Unix time_t clearly doesn't measure up, because as already pointed out by John and others, it ignores leap seconds. John suggested using (pico)seconds since 1970-01-01 00:00:10 TAI. Isn't this equivalent to saying that ClockTime is the number of seconds since 1970-01-01 00:00:00 UTC? Either way, I think we're in agreement that ClockTime should not use the POSIX notion of "seconds since the epoch", but instead use an absolute measure of time interval. I've attached the revised proposal below. Changes so far: - ClockTime and TimeDiff are now represented as Integer picoseconds only. Hence, they also now derive Num, Enum, and Integral. - ClockTime is defined as picoseconds since the epoch, where the epoch is defined in terms of TAI. - calendarTimeToClockTime now returns a Maybe. - I've commented out addDays and friends. I assume that there isn't an immediate demand for these functions, so they can be left out until later, or moved to a separate library.
the only source of confusion I can think of is if the Integer representing TAI relative to epoch is misinterpreted as a time_t equivalent under POSIX, providing toPosixUTC :: ClockTime -> Integer and fromPosixUTC :: Integer -> ClockTime would be useful and advisable
These should be provided by System.Posix.Time, I think. clockTimeToEpochTime :: ClockTime -> EpochTime epochTimeToClockTime :: EpochTime -> ClockTime Cheers, Simon

Oops, forgot to attach the code. ---------------------------------------------------------------------------- -- * ClockTime -- | A representation of absolute time, measured as picoseconds since -- the epoch, where the epoch is 1 January 1970 00:10 TAI. newtype ClockTime = ClockTime { ctPicoseconds :: Integer } deriving (Eq, Ord, Num, Enum, Integral, Show, Read) -- | returns the current absolute time getClockTime :: IO ClockTime -- | Difference between two 'ClockTime's newtype TimeDiff = TimeDiff { tdPicoseconds :: Integer } deriving (Eq, Ord, Num, Enum, Integral, Show, Read) -- | An empty 'TimeDiff' noTimeDiff :: TimeDiff -- | Returns the difference between two 'ClockTime's diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -- | Adds a 'TimeDiff' to a 'ClockTime' addToClockTime :: ClockTime -> TimeDiff -> ClockTime {- Rationale: - POSIX's time_t uses a broken notion of "seconds since the epoch", defined by a formula in terms of UTC time ignoring leap seconds. Our ClockTime is defined so as to avoid this brokenness, but it means that a ClockTime cannot trivially be converted to a POSIX time_t. - TimeDiff is now an absolute measure of time period, as compared to the Haskell 98 TimeDiff which was underspecified in this respect. Invariants: t1 `addToClockTime` (t2 `diffClockTimes` t1) == t2 t1 `addToClockTime` noTimeDiff == t1 t1 `diffClockTimes` t1 == noTimeDiff -} ---------------------------------------------------------------------------- -- * CalendarTime data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Month, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone } deriving (Eq, Ord, Read, Show) data Timezone -- abstract -- | Make a 'Timezone' -- TODO: do we need to specify daylight savings time too? timezoneFromOffset :: Int -> Timezone timezoneFromName :: String -> Timezone timezoneOffset :: Timezone -> Int timezoneName :: Timezone -> String -- | Convert a 'ClockTime' to a 'CalendarTime' in the current timezone clockTimeToCalendarTime :: ClockTime -> IO CalendarTime -- | Convert a 'ClockTime' to a 'CalendarTime' in UTC clockTimeToUTCTime :: ClockTime -> CalendarTime -- | Convert a 'CalendarTime' to a 'ClockTime'. Some values of -- 'CalendarTime' do not represent a valid 'ClockTime', hence this -- function returns a 'Maybe' type. calendarTimeToClockTime :: CalendarTime -> Maybe ClockTime {- OPTIONAL: these are hard to implement, and require careful specification (see rationale below): addPicoseconds :: CalendarTime -> Integer -> CalendarTime addSeconds :: CalendarTime -> Integer -> CalendarTime addMinutes :: CalendarTime -> Integer -> CalendarTime addDays :: CalendarTime -> Integer -> CalendarTime addWeeks :: CalendarTime -> Integer -> CalendarTime addMonths :: CalendarTime -> Integer -> CalendarTime addYears :: CalendarTime -> Integer -> CalendarTime Rationale: - Adding "irregular" time differences should be done on CalendarTimes, because these operations depend on the timezone. - Need to define the meaning when the offset doesn't exist. eg. adding a day at the end of the month clearly rolls over into the next month. But what about adding a month to January 31st? -}

On Wed, Jun 18, 2003 at 11:22:55AM +0100, Simon Marlow wrote:
-- | Convert a 'ClockTime' to a 'CalendarTime' in the current timezone clockTimeToCalendarTime :: ClockTime -> IO CalendarTime
-- | Convert a 'ClockTime' to a 'CalendarTime' in UTC clockTimeToUTCTime :: ClockTime -> CalendarTime
clockTimeToUTCTime also needs to return IO CalendarTime, since it will certainly need to look up a table of leap seconds. Peace, Dylan

On 2003-06-18 at 19:17+0200 Dylan Thurston wrote:
On Wed, Jun 18, 2003 at 11:22:55AM +0100, Simon Marlow wrote:
-- | Convert a 'ClockTime' to a 'CalendarTime' in the current timezone clockTimeToCalendarTime :: ClockTime -> IO CalendarTime =20 -- | Convert a 'ClockTime' to a 'CalendarTime' in UTC clockTimeToUTCTime :: ClockTime -> CalendarTime
clockTimeToUTCTime also needs to return IO CalendarTime, since it will certainly need to look up a table of leap seconds.
Looking things up in tables isn't IO per se. Are you saying that the table changes sufficiently often that it can't be regarded as constant, and that as a consequence clockTimeToUTCTime c doesn't always have the same value? Now, I know from the earlier discussion that for far future dates the leap seconds will be unknown, but isn't this a case of going from _|_ to a value, rather than a change of (non-_|_) value? While I can live with the idea that a programme may be undefined if it computes dates far enough in the future, I'd be unhappy if running it one day gives one answer and on another gives something else. This particular can seems to contain the "need for a number representation that can be inspected lazily to a certain precision" worm. -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

I thought about this too, in my opinion converting to a CalendarTime is 'logically' functional in that the only reason the conversion would ever vary is with incomplete information and an approximation in the first place. if we consider the table of leap seconds to be an 'oracle' which is complete (which is the useful approximation to reality most applications can assume) then it IS a purely functional operation. what is very much needed is a: clockTimeToTZCalendarTime :: TimeZone -> ClockTime -> CalendarTime where TimeZone must contain at least 'UTC' and 'TAI' clockTimeToUTCTime is just a specialization of this function. Not sure whether TAI is currently a supported timezone, but we should make it a requirement since it is by far the easiest to convert to and guarenteed to be unambiguous no matter how complete the leap second tables are. John On Wed, Jun 18, 2003 at 07:17:32PM +0200, Dylan Thurston wrote:
On Wed, Jun 18, 2003 at 11:22:55AM +0100, Simon Marlow wrote:
-- | Convert a 'ClockTime' to a 'CalendarTime' in the current timezone clockTimeToCalendarTime :: ClockTime -> IO CalendarTime
-- | Convert a 'ClockTime' to a 'CalendarTime' in UTC clockTimeToUTCTime :: ClockTime -> CalendarTime
clockTimeToUTCTime also needs to return IO CalendarTime, since it will certainly need to look up a table of leap seconds.
Peace, Dylan
-- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

John Meacham wrote:
I thought about this too, in my opinion converting to a CalendarTime is 'logically' functional in that the only reason the conversion would ever vary is with incomplete information and an approximation in the first place. if we consider the table of leap seconds to be an 'oracle' which is complete (which is the useful approximation to reality most applications can assume) then it IS a purely functional operation.
I thought about this last night too, and I also agree. As long as everyone's installations are fully up-to-date, it is a function. When defining behaviour, we don't take into account broken compilers, so we shouldn't have to take into account broken/out-of-date installations, either. This does get a bit less clear when future dates are considered, but I still think making it IO is overkill. There is after all just one table (somewhere out there in Plato's universe...), it's just that we don't know what's in it. We could say "the behaviour of this function is undefined for future dates" or some such. --KW 8-)

On Wed, Jun 18, 2003 at 11:22:55AM +0100, Simon Marlow wrote:
-- | An empty 'TimeDiff' noTimeDiff :: TimeDiff
-- | Returns the difference between two 'ClockTime's diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
-- | Adds a 'TimeDiff' to a 'ClockTime' addToClockTime :: ClockTime -> TimeDiff -> ClockTime
do we need these now that ClockTime is an instance of Num? I am not opposed to them, they might catch some compile time bugs. A nice thing about using TAI is now everything is a 'time difference' on the same scale. (real seconds) as opposed to POSIX time where it is unclear.
{- Rationale:
- POSIX's time_t uses a broken notion of "seconds since the epoch", defined by a formula in terms of UTC time ignoring leap seconds. Our ClockTime is defined so as to avoid this brokenness, but it means that a ClockTime cannot trivially be converted to a POSIX time_t.
- TimeDiff is now an absolute measure of time period, as compared to the Haskell 98 TimeDiff which was underspecified in this respect.
Invariants:
t1 `addToClockTime` (t2 `diffClockTimes` t1) == t2 t1 `addToClockTime` noTimeDiff == t1 t1 `diffClockTimes` t1 == noTimeDiff
-}
all good. except, perhaps the last sentence of the first paragraph should read "it means that a ClockTime cannot trivially be converted to UTC based times such as the POSIX time_t." since there are other systems which have the same problems as the POSIX system.
---------------------------------------------------------------------------- -- * CalendarTime
data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Month, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone } deriving (Eq, Ord, Read, Show)
data Timezone -- abstract
-- | Make a 'Timezone' -- TODO: do we need to specify daylight savings time too? timezoneFromOffset :: Int -> Timezone timezoneFromName :: String -> Timezone
I am pretty sure the daylight savings time is specified as part of the timezone. PDT vs. PST (daylight vs. standard) we should specify that the 'Offset' is in minutes. not all timezones are integral hour offsets. plus, we should specify that timezoneFromName MUST accept at least "UTC" and "TAI".
-- | Convert a 'ClockTime' to a 'CalendarTime' in the current timezone clockTimeToCalendarTime :: ClockTime -> IO CalendarTime
-- | Convert a 'ClockTime' to a 'CalendarTime' in UTC clockTimeToUTCTime :: ClockTime -> CalendarTime
-- | Convert a 'CalendarTime' to a 'ClockTime'. Some values of -- 'CalendarTime' do not represent a valid 'ClockTime', hence this -- function returns a 'Maybe' type. calendarTimeToClockTime :: CalendarTime -> Maybe ClockTime good, good. this combined with clockTimeToTZCalendarTime is a very
it is VERY important to provide the general functions: clockTimeToTZCalendarTime :: Timezone -> ClockTime -> CalendarTime getCurrentTimezone :: IO Timezone (of which the previous two are simple derivatives) otherwise it would be impossible to get out the TAI time in a printable format for instance, or use the calendartime to do conversions between timezones. powerful combo, letting you do things like conversion to POSIX time_t easily, (fromJust . calendarTimeToClockTime . \t -> t {ctTZ = stringToTimezone "TAI"} . clockTimeToTZCalendarTime "UTC") well, maybe not easily, but possibly. which is more than before.
{- OPTIONAL: these are hard to implement, and require careful specification (see rationale below):
addPicoseconds :: CalendarTime -> Integer -> CalendarTime addSeconds :: CalendarTime -> Integer -> CalendarTime addMinutes :: CalendarTime -> Integer -> CalendarTime addDays :: CalendarTime -> Integer -> CalendarTime addWeeks :: CalendarTime -> Integer -> CalendarTime addMonths :: CalendarTime -> Integer -> CalendarTime addYears :: CalendarTime -> Integer -> CalendarTime
Rationale:
- Adding "irregular" time differences should be done on CalendarTimes, because these operations depend on the timezone.
- Need to define the meaning when the offset doesn't exist. eg. adding a day at the end of the month clearly rolls over into the next month. But what about adding a month to January 31st? -}
how about just a single function normalizeCalendarTime :: CalendarTime -> CalendarTime which turns any non-normal calendartimes into normal ones. it would be easier to specify the behavior and do what people want when they use the above functions. by normalize i mean add any seconds over 59 (or 60) to the minutes field, add any minutes over 59 to the hours field and so forth up the chain... then you can just modify your CalendarTime, then normalize it to fix up any overflow (or underflow with negative values). It may not always be exactly what you want, but at least we should be able to precisly specify it's behavior so people know what to expect. John -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

New version of the System.Time proposal attached below. I've incorporated most of the comments so far. Changes relative to the last version: - ClockTime is now abstract - TimeDiff and associated operations have gone altogether, since ClockTime is an instance of Num they aren't necessary. This is perhaps controversial, since there is less type safety now (you can mix time differences with absolute times), but the alternative is to remove the Num instance from ClockTime. - Timezone offsets are in minutes (apparently this is necessary - if someone could provide a reference I'd be grateful). It's just occurred to me that since TAI is a valid timezone name, it isn't always sensible to ask what the "timezone offset" is. - added getCurrentTimezone - added clockTimeToCalendarTimeTZ - added notes to clockTimeToCalendarTime about possible problems with times in the future. - added notes about possible normalizeCalendarTime operation. Thanks for all the input so far, I think we might be converging! Cheers, Simon -- ------------------------------------------------------------------------- -- * ClockTime -- | A representation of absolute time, measured as picoseconds since -- the epoch, where the epoch is 1 January 1970 00:10 TAI. data ClockTime -- abstract instance of (Eq, Ord, Num, Enum, Integral, Show, Read) -- | returns the current absolute time getClockTime :: IO ClockTime {- Rationale: - POSIX's time_t uses a broken notion of "seconds since the epoch", defined by a formula in terms of UTC time ignoring leap seconds. Our ClockTime is defined so as to avoid this brokenness, but it means that a ClockTime cannot trivially be converted to UTC based times such as the POSIX time_t. -} -- ------------------------------------------------------------------------- -- * Timezone data Timezone -- abstract -- | Make a 'Timezone' from an offset, in minutes relative to UTC, -- which must be less than @24*60@. timezoneFromOffset :: Int -> Timezone -- | Make a 'Timezone' from a standard timezone name (eg. GMT, PDT). -- TAI is a valid timezone name. timezoneFromName :: String -> Timezone -- | Return the offset in minutes of the specified timezone relative -- to UTC. timezoneOffset :: Timezone -> Int -- | Return the timezone name corresponding to a 'Timezone' value. timezoneName :: Timezone -> String -- | Returns the current timezone from the environment. On Unix, the -- current timezone is taken from the @TZ@ environment variable, or -- the system default if @TZ@ is not set. getCurrentTimezone :: IO Timezone ----------------------------------------------------------------------------- -- * CalendarTime data CalendarTime = CalendarTime { ctYear :: Int, ctMonth :: Month, ctDay :: Int, ctHour :: Int, ctMin :: Int, ctSec :: Int, ctPicosec :: Integer, ctTZ :: Timezone } deriving (Eq, Ord, Read, Show) -- | Converts a 'ClockTime' to a 'CalendarTime' in UTC. -- -- Note that this function may produce unpredictable results for -- times sufficiently far in the future, because it is not known -- when leap seconds will need to be added to or subtracted from -- UTC. Note that this doesn't apply if the timezone is TAI. -- clockTimeToUTCTime :: ClockTime -> CalendarTime -- | Converts a 'ClockTime' to a 'CalendarTime' in the current timezone. -- Caveats for 'clockTimeToUTCTime' also apply here. clockTimeToCalendarTime :: ClockTime -> IO CalendarTime -- | Converts a 'ClockTime' to a 'CalendarTime' in the specified timezone. -- Caveats for 'clockTimeToUTCTime' also apply here. clockTimeToCalendarTimeTZ :: Timezone -> ClockTime -> CalendarTime -- | Convert a 'CalendarTime' to a 'ClockTime'. Some values of -- 'CalendarTime' do not represent a valid 'ClockTime', hence this -- function returns a 'Maybe' type. calendarTimeToClockTime :: CalendarTime -> Maybe ClockTime {- OPTIONAL: these are hard to implement, and require careful specification (see rationale below): addPicoseconds :: CalendarTime -> Integer -> CalendarTime addSeconds :: CalendarTime -> Integer -> CalendarTime addMinutes :: CalendarTime -> Integer -> CalendarTime addDays :: CalendarTime -> Integer -> CalendarTime addWeeks :: CalendarTime -> Integer -> CalendarTime addMonths :: CalendarTime -> Integer -> CalendarTime addYears :: CalendarTime -> Integer -> CalendarTime Rationale: - Adding "irregular" time differences should be done on CalendarTimes, because these operations depend on the timezone. - Need to define the meaning when the offset doesn't exist. eg. adding a day at the end of the month clearly rolls over into the next month. But what about adding a month to January 31st? OR: we could provide normalizeCalendarTime :: CalendarTime -> CalendarTime where the following invariant holds: forall t . isJust (calendarTimeToClockTime (normalizeCalendarTime t)) that is, normalizeCalendarTime turns a possibly invalid CalendarTime into a valid one. The intention is that addDays could be implemented as: addDays t days = normalizeCalendarTime t{ ctDays = ctDays t + days } We still need to specify what exactly normalizeCalendarTime does, however. Presumably it needs to know about leap seconds, for example. -}

- Timezone offsets are in minutes (apparently this is necessary - if someone could provide a reference I'd be grateful).
Australia.
--KW 8-)
--
Keith Wansbrough

On 2003-06-20 at 17:14BST Keith Wansbrough wrote:
- Timezone offsets are in minutes (apparently this is necessary - if someone could provide a reference I'd be grateful).
Australia.
Or, more excitingly, Nepal: tzselect Please identify a location so that time zone rules can be set correctly. Please select a continent or ocean. [...] 5) Asia [...] #? 5 Please select a country. [...] #? 32 The following information has been given: Nepal Therefore TZ='Asia/Katmandu' will be used. Local time is now: Fri Jun 20 22:35:04 NPT 2003. Universal Time is now: Fri Jun 20 16:50:04 UTC 2003. Is the above information OK? -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

Home historical timezone offsets are sub-minutes -- there's mention of an example in RFC3339, at the end of section 5.8: [[ 1937-01-01T12:00:27.87+00:20 This represents the same instant of time as noon, January 1, 1937, Netherlands time. Standard time in the Netherlands was exactly 19 minutes and 32.13 seconds ahead of UTC by law from 1909-05-01 through 1937-06-30. This time zone cannot be represented exactly using the HH:MM format, and this timestamp uses the closest representable UTC offset. ]] -- http://www.ietf.org/rfc/rfc3339.txt Which leads mew to mention a slight unease about including time zone name information in the library [1]. Have you seen how many different time zone names there can be? Many with different rules for daylight savings time, etc. This is one of the things we chopped in producing RFC3339 from the earlier work. My own feeling that it may be OK to have a facility to add a time zone name (or abstract structure) to a clocktime, in addition to a timezone offset, but I'm uneasy about having a built-in method that works it out for you. Maybe, then, an external library function can be provided to do the name-to-offset mapping (hmmm... sounds like a possible semantic web application to me ;-) Doing offset-to-name mapping would be even more difficult, because of non-uniqueness. #g -- [1] From Simon's recent proposal: [[ -- | Make a 'Timezone' from an offset, in minutes relative to UTC, -- which must be less than @24*60@. timezoneFromOffset :: Int -> Timezone -- | Make a 'Timezone' from a standard timezone name (eg. GMT, PDT). -- TAI is a valid timezone name. timezoneFromName :: String -> Timezone -- | Return the offset in minutes of the specified timezone relative -- to UTC. timezoneOffset :: Timezone -> Int -- | Return the timezone name corresponding to a 'Timezone' value. timezoneName :: Timezone -> String ]] -- http://www.haskell.org/pipermail/libraries/2003-June/001207.html At 17:14 20/06/03 +0100, Keith Wansbrough wrote:
- Timezone offsets are in minutes (apparently this is necessary - if someone could provide a reference I'd be grateful).
Australia.
--KW 8-) -- Keith Wansbrough
http://www.cl.cam.ac.uk/users/kw217/ University of Cambridge Computer Laboratory. _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
-------------------
Graham Klyne

On Fri, Jun 20, 2003 at 03:20:39PM +0100, Simon Marlow wrote:
- Timezone offsets are in minutes (apparently this is necessary - if someone could provide a reference I'd be grateful). It's just occurred to me that since TAI is a valid timezone name, it isn't always sensible to ask what the "timezone offset" is.
http://www.timeanddate.com/time/abbreviations.html lists several timezones with half-hour offsets (e.g., Newfoundland). Should there also be a function to get offsets (in seconds) between UTC and TAI? Peace, Dylan

On Fri, Jun 20, 2003 at 07:36:23PM +0200, Dylan Thurston wrote:
On Fri, Jun 20, 2003 at 03:20:39PM +0100, Simon Marlow wrote:
- Timezone offsets are in minutes (apparently this is necessary - if someone could provide a reference I'd be grateful). It's just occurred to me that since TAI is a valid timezone name, it isn't always sensible to ask what the "timezone offset" is.
http://www.timeanddate.com/time/abbreviations.html lists several timezones with half-hour offsets (e.g., Newfoundland).
Should there also be a function to get offsets (in seconds) between UTC and TAI?
yes. this would solve another problem I mentioned in a different email about the user implementing their own time types and needing the raw leap second info. perhaps: leapSeconds :: ClockTime -> Int returning the number of leap seconds before the given time. or even better getLeapSeconds :: [ClockTime] just a (possibly infinite) list of known leap seconds. I say possibly infininte since some implementations might want to heuristically predict future leap seconds. John -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

On Fri, Jun 20, 2003 at 01:45:03PM -0700, John Meacham wrote:
On Fri, Jun 20, 2003 at 07:36:23PM +0200, Dylan Thurston wrote:
Should there also be a function to get offsets (in seconds) between UTC and TAI?
On reflection, I think this is too precise information to be accessible from a portable library. In particular, I'm not sure it's possible to correctly implement a TAI-based time system on most Linux distributions without modification (I was rather shocked to discover this...), and I'm sure there are some desired platforms for Haskell which make it very hard to implement that. So the standard should _allow_ for correct implementations, but not _require_ it.
yes. this would solve another problem I mentioned in a different email about the user implementing their own time types and needing the raw leap second info. perhaps:
leapSeconds :: ClockTime -> Int ...
That's probably too precise: perhaps the implementation has no access to raw leap seconds, or perhaps the standard changes and the offset is no longer an integer number of seconds. Peace, Dylan

On Fri, Jun 20, 2003 at 01:45:03PM -0700, John Meacham wrote:
On Fri, Jun 20, 2003 at 07:36:23PM +0200, Dylan Thurston wrote:
Should there also be a function to get offsets (in seconds) between UTC and TAI?
On reflection, I think this is too precise information to be accessible from a portable library. In particular, I'm not sure it's possible to correctly implement a TAI-based time system on most Linux distributions without modification (I was rather shocked to discover this...), and I'm sure there are some desired platforms for Haskell which make it very hard to implement that. So the standard should _allow_ for correct implementations, but not _require_ it.
yeah. it is expected that many systems will not be able to fully conform to this standard. but getting pretty close is good enough for most applications, however we need to actually give the standard routines defined semantics if they are to be useful. At least by defining ClockTime in terms of TAI we can actually use the value to represent real times in the future and past and perform arithmetic on it that makes sense, this is quite useful functionality in general, imagine an accounting program that reads in a bunch of times, performs some operations on them and spits the times back out into another file, the fact that the system doesn't quite conform DOESN'T matter because we are never actually using the systems time functionality. Not concretly specifying what ClockTime means because not all systems have a concrete definition of their own time would be foolish, lots of applications don't need to access the current time yet want to work with dates and times. On Sat, Jun 21, 2003 at 12:59:27AM +0200, Dylan Thurston wrote: there are lots of third party libraries which provide this functionality, they are vital for many types of scientific computing. it is quite plausable that a haskell implementation might use such a library if it finds it. This is not just for current implementations but a proposal for inclusion in Haskell proper. (I wish we could consider the current Time library a big typo and retroactivly change haskell 98..) Any explicitly undefined or implementation dependent behavior will be a source of problems, by giving a precise if not always obtainable definition we can at least guarentee that all implementations are shooting for the same goal..
yes. this would solve another problem I mentioned in a different email about the user implementing their own time types and needing the raw leap second info. perhaps:
leapSeconds :: ClockTime -> Int ...
That's probably too precise: perhaps the implementation has no access to raw leap seconds, or perhaps the standard changes and the offset is no longer an integer number of seconds.
if the implementation doesn't have access to raw leap seconds then an embedded table could be used as a heuristic. This functionality is mainly just useful for people that want to look at what Haskell is using internally as I could see situations when it would be useful. Most systems fudge this anyway, at least in Haskell we will be providing a way to see exactly how the implementation is fudging it :) Think of it as not 'what are the leap seconds' but 'what do you think the leap seconds are?' John -- --------------------------------------------------------------------------- John Meacham - California Institute of Technology, Alum. - john@foo.net ---------------------------------------------------------------------------

"Simon Marlow"
- ClockTime and TimeDiff are now represented as Integer picoseconds only. Hence, they also now derive Num, Enum, and Integral.
I think this is the most aesthetically pleasing. From a practical point of view, we should perhaps consider the possible need to represent times of higher resolution, and the practical need to use of much lower resolution. Division by 10^12, or the need to push really large integers around isn't going to end up being costly, is it?
- ClockTime is defined as picoseconds since the epoch, where the epoch is defined in terms of TAI.
- calendarTimeToClockTime now returns a Maybe.
Okay, this is perhaps more "functional", but is it really what I want? Wouldn't an illegal calendarTime often be a bug in the code, and if so, isn't it better to just crash? I don't much care for wrapping things in Maybe, could we have an 'isCalendarTimeValid' instead (in order to verify values that aren't static)? I.e., isn't this foo ct | isCalendarTimeValid ct -> ...calendarTimeToClockTime ct... | otherwise -> error ... as useful as this foo ct = case calendarTimeToClockTime ct of Just t -> .... Nothing -> error ... ? And of course cleaner in the cases where you *don't* need to check?
- I've commented out addDays and friends. I assume that there isn't an immediate demand for these functions, so they can be left out until later, or moved to a separate library.
-kzm -- If I haven't seen further, it is by standing in the footprints of giants

On 2003-06-18 at 15:19+0200 ketil@ii.uib.no (Ketil Z. Malde) wrote:
"Simon Marlow"
writes: - calendarTimeToClockTime now returns a Maybe.
Okay, this is perhaps more "functional", but is it really what I want? Wouldn't an illegal calendarTime often be a bug in the code, and if so, isn't it better to just crash? I don't much care for wrapping things in Maybe, could we have an 'isCalendarTimeValid' instead (in order to verify values that aren't static)?
I.e., isn't this
foo ct | isCalendarTimeValid ct -> ...calendarTimeToClockTime ct... | otherwise -> error ...
as useful as this
foo ct = case calendarTimeToClockTime ct of Just t -> .... Nothing -> error ...
? And of course cleaner in the cases where you *don't* need to check?
If you want to write in that style, there's nothing to stop you writing wrappers to do it. You can write crashableCalendarTimeToClockTime (which would look much like foo above. I think that standard things in Haskell should not use crashing as a solution if it can possible be avoided. Best would be if the type system could enforce validity of calendar times and restrict the possibility of errors to conversion from strings and suchlike. Given the peculiar constraints on calender times this is too much to ask, however. Jón -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk 31 Chalmers Road jf@cl.cam.ac.uk Cambridge CB1 3SZ +44 1223 570179 (after 14:00 only, please!)

"Ketil Z. Malde" wrote:
"Simon Marlow"
writes: - ClockTime and TimeDiff are now represented as Integer picoseconds only. Hence, they also now derive Num, Enum, and Integral.
I think this is the most aesthetically pleasing. From a practical point of view, we should perhaps consider the possible need to represent times of higher resolution, and the practical need to use of much lower resolution. Division by 10^12, or the need to push really large integers around isn't going to end up being costly, is it?
Representing times as `Rational` seems more elegant: * It handles widely varying needs for resolution nicely. * It avoids choosing picoseconds as the finest possible resolution. What are the downsides to `Rational`? And if those downsides are serious enough, it would seem that the next best approach would be to represent times abstractly. Dean

I'm going to offer what is probably a contrary view in this community. I find myself concerned about the direction of this discussion, but am having some trouble figuring out whether my concerns are justified or over-conservatism. My concern is that in pursuit of perfection we may sacrifice utility. (Or: "the best is the enemy of the good".) On any hardware than I'm familiar with, processing rationals, or unlimited precision numbers, is significantly more expensive than using the native machine capabilities. So, does the cost of using rational (or indefinite precisions) fopr time calculations sufficiently justify the benefits, especially when every program that uses the common library function must pay those cost? I think the answer partly depends on what kinds of application Haskell will be used to implement. If the view is that Haskell is primarily for writing programs that are provably correct in all conceivable circumstances, then the case for using rational time values is clear. But (partly inspired by Backus back in 1978, and the very practically useful work of the Haskell community in developing the language and tools) I see Haskell as something far more approaching a "mainstream" programming option. I think the evolving work on type-safety and generics gives Haskell real potential value in an "industrial" setting, where the errors of concern are usually not about losing leap-seconds, or software that will still be operationally correct millennia from now, but rather about will it help us deal with the increasing complexity of application design without leaving stupid trapdoors for accidental or malicious subversion of the code. I guess that reasonably efficient 64-bit support is pretty much universal on any machine (with a little software assist) I can imagine running Haskell, and I note that 64 bits (about 10^19) comfortably holds a second's worth of picoseconds. A rough calculation gives 2^64 picoseconds = 5000 hours, so 64 bits clearly isn't enough to hold all useful dates in picoseconds. 2^64 seconds is enough to represent many more years than I could shake a stick at (something like 5*10^11 years). Dealing with sub-picosecond intervals is something I find hard to imagine being a common requirement (I may often talk about nanoseconds in the context of computers, but I've never really had to compute with them: milliseconds has been about the smallest I've had to deal with). My point is that seconds and picoseconds, represented using 64 bit binary values, are a pretty efficient engineering choice that I think will satisfy a vast majority of the requirements of actual applications that use a common time library, and which don't hold any potential performance pitfalls. I could, of course, be wrong and short-sighted in this view, but I find it hard to lose sleep over missing leap-seconds and dates beyond the lifetime of the Universe(?) for the majority of applications built using a general-purpose programming system. And the cost of supporting all this may be trivial in practical terms -- I don't have a good handle on that, but I'll comment that time calculations might be a significant computational burden for a real-time system dealing with high event rates (and I think we'll see lots of these applications). #g -- At 13:09 18/06/03 -0400, Dean Herington wrote:
"Ketil Z. Malde" wrote:
"Simon Marlow"
writes: - ClockTime and TimeDiff are now represented as Integer picoseconds only. Hence, they also now derive Num, Enum, and Integral.
I think this is the most aesthetically pleasing. From a practical point of view, we should perhaps consider the possible need to represent times of higher resolution, and the practical need to use of much lower resolution. Division by 10^12, or the need to push really large integers around isn't going to end up being costly, is it?
Representing times as `Rational` seems more elegant: * It handles widely varying needs for resolution nicely. * It avoids choosing picoseconds as the finest possible resolution. What are the downsides to `Rational`? And if those downsides are serious enough, it would seem that the next best approach would be to represent times abstractly.
Dean
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
-------------------
Graham Klyne

Graham Klyne
On any hardware than I'm familiar with, processing rationals, or unlimited precision numbers, is significantly more expensive than using the native machine capabilities.
This was, sort of, a concern I tried to raise: using Integer with ps, makes for some large quite numbers (and Integer is of course slower with large numbers than with small ones)
If the view is that Haskell is primarily for writing programs that are provably correct in all conceivable circumstances, then the case for using rational time values is clear.
I don't think we should sacrifice correctness, it is a far greater problem for much more code, than speed is.
My point is that seconds and picoseconds, represented using 64 bit binary values,
Well, my main problem with representing time as a pair, is that a point in time isn't uniquely defined (e.g. should it be 3s + 5e-11ps, or 2s + 5e-11ps), and that, in most suggested formats, they overlap (e.g. 3s or 2s + 1e12 ps). So you need to normalize -- possibly after each operation. Are you sure this is more efficient than using bignums? Further, I'm not sure Haskell has a standard 64 bit Int. I'm fairly sure it's in GHC, and probably in the other compilers, but it'd be nice if it were in the standard. On the other hand, Integer can be implemented any way that's efficient on each architecture.
I find it hard to lose sleep over missing leap-seconds and dates beyond
Leap seconds are a completely orthogonal issue. From the discussion here, it seems plain that UTC is a kluge, and TAI is the way to go. In any case, we already agree to counting seconds, the question is how to count them :-)
And the cost of supporting all this may be trivial in practical terms -- I don't have a good handle on that, but I'll comment that time calculations might be a significant computational burden for a real-time system dealing with high event rates (and I think we'll see lots of these applications).
Could you be more concrete? I don't think I know any system that spends a significant amount of time calculating dates. Some systems that deal with time (GPS, NTP), mostly care about differences, and are happy to have the clock roll over relatively frequently. -kzm -- If I haven't seen further, it is by standing in the footprints of giants

Ketil, I've deliberately waited to respond. Other discussion on this list suggests to me that actual implementations of Integer for which the actual values are within normal integer bounds are reasonably efficient, so that should not be a concern. I'm thinking of running some tests against GHC and Hugs, to see how different implementation strategies perform. At 15:11 19/06/03 +0200, Ketil Z. Malde wrote:
If the view is that Haskell is primarily for writing programs that are provably correct in all conceivable circumstances, then the case for using rational time values is clear.
I don't think we should sacrifice correctness, it is a far greater problem for much more code, than speed is.
I entirely agree with that sentiment. But I think that "correctness" is not always an absolute (except in a formal sense of conformance to specification) and there are more aspects to resource usage that mere computation speed. For example, if a GPRS PDA is forced to connect to the Internet to check on leap second status before it can set off a wake-up alarm in the morning, I think that not using expensive connectivity is much more important that the accuracy of the alarm going off. I don't claim you advocated this; I just wanted to make the point that performance shouldn't completely be dismissed in favour of absolute correctness.
And the cost of supporting all this may be trivial in practical terms -- I don't have a good handle on that, but I'll comment that time calculations might be a significant computational burden for a real-time system dealing with high event rates (and I think we'll see lots of these applications).
Could you be more concrete? I don't think I know any system that spends a significant amount of time calculating dates. Some systems that deal with time (GPS, NTP), mostly care about differences, and are happy to have the clock roll over relatively frequently.
Well (these may or may not not spend significant time doing date/time
calculations), but, off the top of my head, the broad kinds of application
I've been thinking of might be:
- e-commerce servers (delivery scheduling, session management, payment
validity checks)
- network performance monitoring (even timing, frequency, delay measurements)
- security ticket server, e.g. Kerberos (calculating ticket diuration,
checking ticket validity)
- personal information management (personal calendar, schedule, alarms)
- group information management (meeting scheduling, resource scheduling,
alerts).
- just-in-time manufacturing scheduling (resource scheduling, production
scheduling, real-time plant control in response to incoming requirements)
- network access control (time-restricted access, resource usage monitoring)
- network intrusion detection (event frequency and temporal pattern monitoring)
There's an application that I'm interested in working toward, even if I
never get there, which is a semantic-web integrated real-time event
handling system, whose broad goal is to integrate home security/home
control features with personal and group schedules. At the heart of this
would be a database of RDF information describing a range of time-dependent
events, and other things, linked with a real-time event handler and RDF
inference meachanism (which is something I'm currently working on, in Haskell).
#g
-------------------
Graham Klyne

Simon Marlow wrote:
John suggested using (pico)seconds since 1970-01-01 00:00:10 TAI. Isn't this equivalent to saying that ClockTime is the number of seconds since 1970-01-01 00:00:00 UTC?
Yes. TAI started ticking on 1 Jan 1958. UTC started ticking on 1 Jan 1972, and started 10 seconds behind of TAI (to keep it within 0.9 sec of UT1). -- Matthew Donadio (m.p.donadio@ieee.org)
participants (9)
-
Dean Herington
-
Dylan Thurston
-
Graham Klyne
-
John Meacham
-
Jon Fairbairn
-
Keith Wansbrough
-
ketil@ii.uib.no
-
Matthew Donadio
-
Simon Marlow