[m-rev.] calendar module proposal
Ian MacLarty
maclarty at csse.unimelb.edu.au
Tue Jan 27 16:02:11 AEDT 2009
Hi,
Here's a proposal for a calendar module for the standard library.
Could interested people take a look and give me some feedback?
Since this module only implements the Gregorian calendar, it might not
be suitable for working with dates prior to 1582. Perhaps it should be
renamed to gregorian_calendar or gcalendar?
Ian.
Index: library/calendar.m
===================================================================
RCS file: library/calendar.m
diff -N library/calendar.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/calendar.m 27 Jan 2009 03:51:25 -0000
@@ -0,0 +1,961 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2009 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: calendar.m.
+% Main authors: maclarty
+% Stability: low.
+%
+% Proleptic Gregorian calendar utilities.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module calendar.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+ % A point on the Proleptic Gregorian calendar, to the nearest second.
+ %
+:- type date.
+
+ % A period of time measured in years, months, days, hours, minutes and
+ % seconds.
+ %
+:- type duration.
+
+:- type month
+ ---> january
+ ; february
+ ; march
+ ; april
+ ; may
+ ; june
+ ; july
+ ; august
+ ; september
+ ; october
+ ; november
+ ; december.
+
+
+ % Date components.
+ %
+:- type year == int. % Year 0 is 1 BC, -1 is 2 BC, etc.
+:- type day_of_month == int. % 1..31 depending on the month and year
+:- type hour == int. % 0..23
+:- type minute == int. % 0..59
+:- type second == int. % 0..61 (60 and 61 are for leap seconds)
+
+:- type day_of_week
+ ---> sunday
+ ; monday
+ ; tuesday
+ ; wednesday
+ ; thursday
+ ; friday
+ ; saturday.
+
+ % Duration components.
+ %
+:- type years == int.
+:- type months == int.
+:- type days == int.
+:- type hours == int.
+:- type minutes == int.
+:- type seconds == int.
+
+ % Functions to retrieve the components of a date.
+ %
+:- func year(date) = year.
+:- func month(date) = month.
+:- func day_of_month(date) = day_of_month.
+:- func day_of_week(date) = day_of_week.
+:- func hour(date) = hour.
+:- func minute(date) = minute.
+:- func second(date) = second.
+
+ % init_date(Year, Month, Day, Hour, Minute, Second) = DT.
+ % Initialize a new date. Fails if the given date is invalid.
+ %
+:- pred init_date(year::in, month::in, day_of_month::in, hour::in,
+ minute::in, second::in, date::out) is semidet.
+
+ % Same as above, but aborts if the date is invalid.
+ %
+:- func det_init_date(year, month, day_of_month, hour, minute, second) =
+ date.
+
+ % Convert a string of the form "YYYY-MM-DD HH:MI:SS" to a date.
+ %
+:- pred date_from_string(string::in, date::out) is semidet.
+
+ % Same as above, but aborts if the string is not a valid date.
+ %
+:- func det_date_from_string(string) = date.
+
+ % Convert a date to a string of the form "YYYY-MM-DD HH:MI:SS".
+ %
+:- func date_to_string(date) = string.
+
+ % Parse a duration string conforming to the representation
+ % described at http://www.w3.org/TR/xmlschema-2/#duration.
+ %
+:- pred duration_from_string(string::in, duration::out) is semidet.
+
+ % Same as above, but aborts if the string does not represent
+ % a valid duration.
+ %
+:- func det_duration_from_string(string) = duration.
+
+ % Convert a duration to the string representation
+ % described at http://www.w3.org/TR/xmlschema-2/#duration.
+ %
+:- func duration_to_string(duration) = string.
+
+ % Get the current local time.
+ %
+:- pred current_local_time(date::out, io::di, io::uo) is det.
+
+ % Get the current UTC time.
+ %
+:- pred current_utc_time(date::out, io::di, io::uo) is det.
+
+ % Get the difference between the local time and utc time
+ % as a duration.
+ % local_time_offset(TZ, !IO) is equivalent to:
+ % current_local_time(Local, !IO),
+ % current_utc_time(UTC, !IO),
+ % TZ = duration(UTC, Local)
+ % except that it is as if the calls to current_utc_time and
+ % current_local_time occured at the same instant.
+ %
+:- pred local_time_offset(duration::out, io::di, io::uo) is det.
+
+ % Functions to retrieve duration components.
+ %
+:- func years(duration) = years.
+:- func months(duration) = months.
+:- func days(duration) = days.
+:- func hours(duration) = hours.
+:- func minutes(duration) = minutes.
+:- func seconds(duration) = seconds.
+
+ % duration(Date1, Date2) = Duration.
+ % Find the duration between two dates using a "greedy" algorithm. The
+ % algorithm is greedy in the sense that it will try to maximise each
+ % component in the returned duration in the following order: years, months,
+ % days, hours, minutes, seconds.
+ % The returned duration is positive if Date2 is after Date1 and negative
+ % if Date2 is before Date1.
+ % Any leap seconds that occured between the two dates are ignored.
+ %
+ % If the seconds components of Date1 and Date2 are < 60 then
+ % add_duration(Date1, duration(Date1, Date2), Date2) will hold, but
+ % add_duration(Date2, negate(duration(Date1, Date2)), Date1) may not
+ % hold. For example if:
+ % Date1 = 2001-01-31
+ % Date2 = 2001-02-28
+ % Duration = 1 month
+ % then the following holds:
+ % add_duration(duration(Date1, Date2), Date1, Date2)
+ % but the following does not:
+ % add_duration(negate(duration(Date1, Date2), Date2, Date1)
+ % (Adding -1 month to 2001-02-28 will yield 2001-01-28).
+ %
+:- func duration(date, date) = duration.
+
+ % Same as above, except that the year and month components of the
+ % returned duration will always be zero. The duration will be
+ % in terms of days, hours, minutes and seconds only.
+ %
+:- func day_duration(date, date) = duration.
+
+ % Add a duration to a date.
+ % First the years and months are added to the date.
+ % If this causes the day to be out of range (e.g. April 31), then it is
+ % decreased until it is in range (e.g. April 30). Next the remaining
+ % days, hours, minutes and seconds components are added. These could
+ % in turn cause the months and years values to change again.
+ % The algorithm used is described in detail at
+ % http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes.
+ %
+:- pred add_duration(duration::in, date::in, date::out) is det.
+
+ % This predicate implements a partial order relation on durations.
+ % The algorithm it uses is described at
+ % http://www.w3.org/TR/xmlschema-2/#duration.
+ % Note that if duration_leq(X, Y) fails, then this does NOT imply
+ % that duration_leq(Y, X) is true. For example a duration of 30 days
+ % is not comparable to a duration of 1 month, so duration_leq will
+ % fail if these are given as inputs in any order.
+ %
+:- pred duration_leq(duration::in, duration::in) is semidet.
+
+ % init_{positive|negative}_duration(Years, Months, Days, Hours, Minutes,
+ % Seconds)
+ % Create a new positive or negative duration. All the supplied dimensions
+ % should be non-negative. If they are not the function aborts.
+ %
+:- func init_positive_duration(years, months, days, hours, minutes, seconds) =
+ duration.
+:- func init_negative_duration(years, months, days, hours, minutes, seconds) =
+ duration.
+
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module float.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+:- import_module string.
+:- import_module time.
+
+%----------------------------------------------------------------------------%
+
+:- type date
+ ---> date(
+ dt_year :: int,
+ dt_month :: int,
+ dt_day :: int,
+ dt_hour :: int,
+ dt_minute :: int,
+ dt_second :: int
+ ).
+
+:- type duration
+ ---> duration(
+ dur_years :: int,
+ dur_months :: int,
+ dur_days :: int,
+ dur_hours :: int,
+ dur_minutes :: int,
+ dur_seconds :: int
+ ).
+
+%-----------------------------------------------------------------------------%
+% Parsing.
+%
+
+date_from_string(Str, Date) :-
+ some [!Chars] (
+ !:Chars = string.to_char_list(Str),
+ ( read_char((-), !.Chars, Rest1) ->
+ !:Chars = Rest1,
+ read_int_and_num_chars(Year0, YearChars, !Chars),
+ Year = -Year0
+ ;
+ read_int_and_num_chars(Year, YearChars, !Chars)
+ ),
+ YearChars >= 4,
+ Year \= 0,
+ read_char((-), !Chars),
+ read_int_and_num_chars(Month, 2, !Chars),
+ Month >= 1,
+ Month =< 12,
+ read_char((-), !Chars),
+ read_int_and_num_chars(Day, 2, !Chars),
+ Day >= 1,
+ Day =< max_day_in_month_for(Year, Month),
+ read_char(' ', !Chars),
+ read_int_and_num_chars(Hour, 2, !Chars),
+ Hour >= 0,
+ Hour =< 23,
+ read_char((:), !Chars),
+ read_int_and_num_chars(Minute, 2, !Chars),
+ Minute >= 0,
+ Minute =< 59,
+ read_char((:), !Chars),
+ % Make sure there are two digits for the whole number part of the
+ % second field.
+ read_int_and_num_chars(_, 2, !.Chars, _),
+ read_int(Second, !Chars),
+ Second < 62,
+ !.Chars = [],
+ Date = date(Year, Month, Day, Hour, Minute, Second)
+ ).
+
+:- pred read_int_and_num_chars(int::out, int::out,
+ list(char)::in, list(char)::out) is det.
+
+read_int_and_num_chars(Val, N, !Chars) :-
+ read_int_and_num_chars_2(0, Val, 0, N, !Chars).
+
+:- pred read_int_and_num_chars_2(int::in, int::out, int::in, int::out,
+ list(char)::in, list(char)::out) is det.
+
+read_int_and_num_chars_2(!Val, !N, !Chars) :-
+ (
+ !.Chars = [Char | Rest],
+ is_digit(Char, Digit)
+ ->
+ !:Val = !.Val * 10 + Digit,
+ read_int_and_num_chars_2(!Val, !.N + 1, !:N, Rest, !:Chars)
+ ;
+ true
+ ).
+
+duration_from_string(Str, Duration) :-
+ some [!Chars] (
+ !:Chars = string.to_char_list(Str),
+ read_sign(Sign, !Chars),
+ read_char('P', !Chars),
+ read_years(Years, !Chars),
+ read_months(Months, !Chars),
+ read_days(Days, !Chars),
+ ( read_char('T', !.Chars, TimePart) ->
+ TimePart = [_ | _],
+ read_hours(Hours, TimePart, !:Chars),
+ read_minutes(Minutes, !Chars),
+ read_seconds(Seconds, !Chars),
+ !.Chars = [],
+ Duration = make_duration_with_sign(Sign, Years, Months, Days,
+ Hours, Minutes, Seconds)
+ ;
+ !.Chars = [],
+ Duration = make_duration_with_sign(Sign, Years, Months, Days,
+ 0, 0, 0)
+ )
+ ).
+
+:- type sign
+ ---> positive
+ ; negative.
+
+:- pred read_sign(sign::out, list(char)::in, list(char)::out) is det.
+
+read_sign(Sign, !Chars) :-
+ ( !.Chars = [(-) | Rest] ->
+ !:Chars = Rest,
+ Sign = negative
+ ;
+ Sign = positive
+ ).
+
+:- pred read_char(char::out, list(char)::in, list(char)::out) is semidet.
+
+read_char(Char, [Char | Rest], Rest).
+
+:- pred read_years(int::out, list(char)::in, list(char)::out) is det.
+
+read_years(Years, !Chars) :-
+ read_int_and_char_or_zero(Years, 'Y', !Chars).
+
+:- pred read_months(int::out, list(char)::in, list(char)::out) is det.
+
+read_months(Months, !Chars) :-
+ read_int_and_char_or_zero(Months, 'M', !Chars).
+
+:- pred read_days(int::out, list(char)::in, list(char)::out) is det.
+
+read_days(Days, !Chars) :-
+ read_int_and_char_or_zero(Days, 'D', !Chars).
+
+:- pred read_hours(int::out, list(char)::in, list(char)::out) is det.
+
+read_hours(Hours, !Chars) :-
+ read_int_and_char_or_zero(Hours, 'H', !Chars).
+
+:- pred read_minutes(int::out, list(char)::in, list(char)::out) is det.
+
+read_minutes(Minutes, !Chars) :-
+ read_int_and_char_or_zero(Minutes, 'M', !Chars).
+
+:- pred read_seconds(int::out, list(char)::in, list(char)::out) is det.
+
+read_seconds(Seconds, !Chars) :-
+ read_int_and_char_or_zero(Seconds, 'S', !Chars).
+
+:- pred read_int_and_char_or_zero(int::out, char::in,
+ list(char)::in, list(char)::out) is det.
+
+read_int_and_char_or_zero(Int, Char, !Chars) :-
+ (
+ read_int(Int0, !.Chars, Chars1),
+ Chars1 = [Char | Rest]
+ ->
+ !:Chars = Rest,
+ Int = Int0
+ ;
+ Int = 0
+ ).
+
+:- pred read_int(int::out, list(char)::in, list(char)::out) is det.
+
+read_int(Val, !Chars) :-
+ read_int_2(0, Val, !Chars).
+
+:- pred read_int_2(int::in, int::out, list(char)::in, list(char)::out) is det.
+
+read_int_2(!Val, !Chars) :-
+ (
+ !.Chars = [Char | Rest],
+ is_digit(Char, Digit)
+ ->
+ !:Val = !.Val * 10 + Digit,
+ read_int_2(!Val, Rest, !:Chars)
+ ;
+ true
+ ).
+
+:- pred is_digit(char::in, int::out) is semidet.
+
+is_digit('0', 0).
+is_digit('1', 1).
+is_digit('2', 2).
+is_digit('3', 3).
+is_digit('4', 4).
+is_digit('5', 5).
+is_digit('6', 6).
+is_digit('7', 7).
+is_digit('8', 8).
+is_digit('9', 9).
+
+:- func make_duration_with_sign(sign, int, int, int, int, int, int)
+ = duration.
+
+make_duration_with_sign(positive, Years, Months, Days, Hours, Minutes,
+ Seconds) =
+ init_positive_duration(Years, Months, Days, Hours, Minutes, Seconds).
+make_duration_with_sign(negative, Years, Months, Days, Hours, Minutes,
+ Seconds) =
+ init_negative_duration(Years, Months, Days, Hours, Minutes, Seconds).
+
+det_date_from_string(Str) = Date :-
+ ( date_from_string(Str, Date0) ->
+ Date = Date0
+ ;
+ error("det_date_from_string: invalid date: " ++
+ Str)
+ ).
+
+det_duration_from_string(Str) = Duration :-
+ ( duration_from_string(Str, Duration0) ->
+ Duration = Duration0
+ ;
+ error("det_duration_from_string: invalid duration: " ++
+ Str)
+ ).
+
+%-----------------------------------------------------------------------------%
+% Serialization.
+%
+
+date_to_string(Date) = Str :-
+ Date = date(Year0, Month, Day, Hour, Minute, Second),
+ ( Year0 < 0 ->
+ SignStr = "-",
+ Year = -Year0
+ ;
+ SignStr = "",
+ Year = Year0
+ ),
+ Str = string.format("%s%04d-%02d-%02d %02d:%02d:%02d",
+ [s(SignStr), i(Year), i(Month), i(Day), i(Hour), i(Minute),
+ i(Second)]).
+
+duration_to_string(duration(Years, Months, Days, Hours, Minutes, Seconds))
+ = Str :-
+ (
+ Years = 0,
+ Months = 0,
+ Days = 0,
+ Hours = 0,
+ Minutes = 0,
+ Seconds = 0
+ ->
+ % At least one dimension must appear in the string. The choice
+ % of days is arbitrary.
+ Str = "P0D"
+ ;
+ (
+ Years >= 0,
+ Months >= 0,
+ Days >= 0,
+ Hours >= 0,
+ Minutes >= 0,
+ Seconds >= 0
+ ->
+ Sign = 1,
+ SignStr = ""
+ ;
+ Years =< 0,
+ Months =< 0,
+ Days =< 0,
+ Hours =< 0,
+ Minutes =< 0,
+ Seconds =< 0
+ ->
+ Sign = -1,
+ SignStr = "-"
+ ;
+ error("duration_to_string: " ++
+ "duration components have mixed signs")
+ ),
+ (
+ Hours = 0,
+ Minutes = 0,
+ Seconds = 0
+ ->
+ TimePart = []
+ ;
+ TimePart = ["T",
+ string_if_nonzero(Sign * Hours, "H"),
+ string_if_nonzero(Sign * Minutes, "M"),
+ string_if_nonzero(Sign * Seconds, "S")
+ ]
+ ),
+ Str = string.append_list([
+ SignStr, "P",
+ string_if_nonzero(Sign * Years, "Y"),
+ string_if_nonzero(Sign * Months, "M"),
+ string_if_nonzero(Sign * Days, "D")] ++ TimePart)
+ ).
+
+:- func string_if_nonzero(int, string) = string.
+
+string_if_nonzero(X, Suffix) =
+ ( X = 0 ->
+ ""
+ ;
+ int_to_string(X) ++ Suffix
+ ).
+
+%-----------------------------------------------------------------------------%
+
+duration_leq(Dur1, Dur2) :-
+ list.all_true(
+ ( pred(TestDate::in) is semidet :-
+ add_duration(Dur1, TestDate, Date1),
+ add_duration(Dur2, TestDate, Date2),
+ compare(CompRes, Date1, Date2),
+ ( CompRes = (<) ; CompRes = (=) )
+ ), test_dates).
+
+ % Returns dates used to compare durations.
+ %
+:- func test_dates = list(date).
+
+test_dates = [
+ date(1696, 9, 1, 0, 0, 0),
+ date(1697, 2, 1, 0, 0, 0),
+ date(1903, 3, 1, 0, 0, 0),
+ date(1903, 7, 1, 0, 0, 0)
+].
+
+%-----------------------------------------------------------------------------%
+% Adding durations to date times.
+%
+% The following is a fairly direct translation of the algorithm at
+% http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes.
+%
+
+:- func fquotient(int, int, int) = int.
+
+fquotient(A, Low, High) = int.div(A - Low, High - Low).
+
+:- func modulo(int, int) = int.
+
+modulo(A, B) = A - div(A, B) * B.
+
+:- func modulo(int, int, int) = int.
+
+modulo(A, Low, High) = modulo(A - Low, High - Low) + Low.
+
+:- func max_day_in_month_for(int, int) = int.
+
+max_day_in_month_for(YearValue, MonthValue) = Max :-
+ M = int.mod(MonthValue - 1, 12) + 1,
+ Y = YearValue + int.div(MonthValue - 1, 12),
+ (
+ ( ( M = 1 ; M = 3 ; M = 5 ; M = 7 ; M = 8 ; M = 10 ; M = 12 ),
+ Max0 = 31
+ ; ( M = 4 ; M = 6 ; M = 9 ; M = 11 ),
+ Max0 = 30
+ ; M = 2,
+ ( ( Y mod 400 = 0 ; ( Y mod 100 \= 0, Y mod 4 = 0 ) ) ->
+ Max0 = 29
+ ;
+ Max0 = 28
+ )
+ )
+ ->
+ Max = Max0
+ ;
+ % This should never happen.
+ error("max_day_in_month_for: unexpected value for M: " ++
+ string(M))
+ ).
+
+add_duration(D, S, E) :-
+ some [!Temp, !Carry, !E] (
+ !:E = date(0, 0, 0, 0, 0, 0),
+ % Months
+ !:Temp = S ^ dt_month + D ^ dur_months,
+ !E ^ dt_month := modulo(!.Temp, 1, 13),
+ !:Carry = fquotient(!.Temp, 1, 13),
+ % Years
+ !E ^ dt_year := S ^ dt_year + D ^ dur_years + !.Carry,
+ % Seconds
+ !:Temp = S ^ dt_second + D ^ dur_seconds,
+ !E ^ dt_second := modulo(!.Temp, 60),
+ !:Carry = div(!.Temp, 60),
+ % Minutes
+ !:Temp = S ^ dt_minute + D ^ dur_minutes + !.Carry,
+ !E ^ dt_minute := int.mod(!.Temp, 60),
+ !:Carry = int.div(!.Temp, 60),
+ % Hours
+ !:Temp = S ^ dt_hour + D ^ dur_hours + !.Carry,
+ !E ^ dt_hour := int.mod(!.Temp, 24),
+ !:Carry = int.div(!.Temp, 24),
+ % Days
+ MaxDaysInMonth = max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month),
+ ( S ^ dt_day > MaxDaysInMonth ->
+ TempDays = MaxDaysInMonth
+ ; S ^ dt_day < 1 ->
+ TempDays = 1
+ ;
+ TempDays = S ^ dt_day
+ ),
+ !E ^ dt_day := TempDays + D ^ dur_days + !.Carry,
+ add_duration_loop(D, S, !E),
+ E = !.E
+ ).
+
+:- pred add_duration_loop(duration::in, date::in, date::in, date::out) is det.
+
+add_duration_loop(D, S, !E) :-
+ ( !.E ^ dt_day < 1 ->
+ !E ^ dt_day := !.E ^ dt_day +
+ max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month - 1),
+ Carry = -1,
+ Temp = !.E ^ dt_month + Carry,
+ !E ^ dt_month := modulo(Temp, 1, 13),
+ !E ^ dt_year := !.E ^ dt_year + fquotient(Temp, 1, 13),
+ add_duration_loop(D, S, !E)
+ ;
+ MaxDaysInMonth = max_day_in_month_for(!.E ^ dt_year, !.E ^ dt_month),
+ !.E ^ dt_day > MaxDaysInMonth
+ ->
+ !E ^ dt_day := !.E ^ dt_day - MaxDaysInMonth,
+ Carry = 1,
+ Temp = !.E ^ dt_month + Carry,
+ !E ^ dt_month := modulo(Temp, 1, 13),
+ !E ^ dt_year := !.E ^ dt_year + fquotient(Temp, 1, 13),
+ add_duration_loop(D, S, !E)
+ ;
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+% Computing duration between dates.
+%
+
+day_duration(Date2, Date1) = Duration :-
+ builtin.compare(CompResult, Date1, Date2),
+ ( CompResult = (<),
+ Duration0 = day_duration(Date1, Date2),
+ Duration = negate(Duration0)
+ ; CompResult = (=),
+ Duration = zero_duration
+ ; CompResult = (>),
+ some [!Borrow] (
+ Second1 = Date1 ^ dt_second,
+ Second2 = Date2 ^ dt_second,
+ subtract_ints_with_borrow(60, Second1, Second2, Seconds,
+ !:Borrow),
+ Minute1 = Date1 ^ dt_minute - !.Borrow,
+ Minute2 = Date2 ^ dt_minute,
+ subtract_ints_with_borrow(60, Minute1, Minute2, Minutes,
+ !:Borrow),
+ Hour1 = Date1 ^ dt_hour - !.Borrow,
+ Hour2 = Date2 ^ dt_hour,
+ subtract_ints_with_borrow(24, Hour1, Hour2, Hours, !:Borrow),
+ JDN1 = julian_day(Date1 ^ dt_year, Date1 ^ dt_month,
+ Date1 ^ dt_day),
+ JDN2 = julian_day(Date2 ^ dt_year, Date2 ^ dt_month,
+ Date2 ^ dt_day),
+ Days = JDN1 - !.Borrow - JDN2,
+ Duration = duration(0, 0, Days, Hours, Minutes, Seconds)
+ )
+ ).
+
+duration(Date2, Date1) = Duration :-
+ compare(CompResult, Date1, Date2),
+ ( CompResult = (<),
+ greedy_subtract_descending(ascending, Date2, Date1, Duration0),
+ Duration = negate(Duration0)
+ ; CompResult = (=),
+ Duration = zero_duration
+ ; CompResult = (>),
+ greedy_subtract_descending(descending, Date1, Date2, Duration)
+ ).
+
+:- type order
+ ---> ascending
+ ; descending.
+
+:- pred greedy_subtract_descending(order::in, date::in, date::in,
+ duration::out) is det.
+
+ % This predicate has the precondition that Date1 < Date2. OriginalOrder is
+ % the original order of the date arguments (descending means that in the
+ % original call Date1 < Date2, while ascending means that in the original
+ % call Date1 > Date2). This is needed to correctly compute the days
+ % dimension of the resulting duration. The calculation is different
+ % depending on the original order, because we want the invarient:
+ % add_duration(duration(Date1, Date2), Date1, Date2)
+ % to hold, and in the case where Date1 > Date2, Duration will be negative.
+ %
+greedy_subtract_descending(OriginalOrder, Date1, Date2, Duration) :-
+ some [!Borrow] (
+ Second1 = Date1 ^ dt_second,
+ Second2 = Date2 ^ dt_second,
+ subtract_ints_with_borrow(60, Second1, Second2, Seconds,
+ !:Borrow),
+ Minute1 = Date1 ^ dt_minute - !.Borrow,
+ Minute2 = Date2 ^ dt_minute,
+ subtract_ints_with_borrow(60, Minute1, Minute2, Minutes, !:Borrow),
+ Hour1 = Date1 ^ dt_hour - !.Borrow,
+ Hour2 = Date2 ^ dt_hour,
+ subtract_ints_with_borrow(24, Hour1, Hour2, Hours, !:Borrow),
+ ( OriginalOrder = descending,
+ add_duration(duration(0, -1, 0, 0, 0, 0), Date1,
+ Date1Minus1Month),
+ DaysToBorrow = max_day_in_month_for(Date1Minus1Month ^ dt_year,
+ Date1Minus1Month ^ dt_month),
+ Date1EndOfMonth = max_day_in_month_for(Date1 ^ dt_year,
+ Date1 ^ dt_month),
+ Day1 = Date1 ^ dt_day - !.Borrow,
+ Day2 = int.min(Date2 ^ dt_day, Date1EndOfMonth)
+ ; OriginalOrder = ascending,
+ DaysToBorrow = max_day_in_month_for(Date2 ^ dt_year,
+ Date2 ^ dt_month),
+ Date2EndOfMonth = max_day_in_month_for(Date2 ^ dt_year,
+ Date2 ^ dt_month),
+ Day1 = int.min(Date1 ^ dt_day - !.Borrow, Date2EndOfMonth),
+ Day2 = Date2 ^ dt_day
+ ),
+ subtract_ints_with_borrow(DaysToBorrow, Day1, Day2, Days, !:Borrow),
+ Month1 = Date1 ^ dt_month - !.Borrow,
+ Month2 = Date2 ^ dt_month,
+ subtract_ints_with_borrow(12, Month1, Month2, Months, !:Borrow),
+ Year1 = Date1 ^ dt_year - !.Borrow,
+ Year2 = Date2 ^ dt_year,
+ ( Year1 >= Year2 ->
+ Years = Year1 - Year2
+ ;
+ % If this happens then Date1 < Date2 which violates a precondition
+ % of this predicate.
+ error("greedy_subtract_descending: " ++
+ "left over years")
+ ),
+ Duration = duration(Years, Months, Days, Hours, Minutes, Seconds)
+ ).
+
+ % subtract_ints_with_borrow(BorrowAmount, Val1, Val2, Val, Borrow)
+ % Subtract Val2 from Val1, possibly borrowing BorrowAmount if Val1 < Val2.
+ % If an amount is borrowed, then Borrow is set to 1, otherwise it is set
+ % to 0.
+ %
+:- pred subtract_ints_with_borrow(int::in, int::in, int::in, int::out,
+ int::out) is det.
+
+subtract_ints_with_borrow(BorrowVal, Val1, Val2, Diff, Borrow) :-
+ ( Val1 >= Val2 ->
+ Borrow = 0,
+ Diff = Val1 - Val2
+ ;
+ Borrow = 1,
+ Diff = BorrowVal + Val1 - Val2
+ ).
+
+%-----------------------------------------------------------------------------%
+% Misc
+%
+
+:- func julian_day(int, int, int) = int.
+
+julian_day(Year, Month, Day) = JDN :-
+ %
+ % The following calculation comes from
+ % http://en.wikipedia.org/wiki/Julian_day.
+ %
+ A = (14 - Month) // 12,
+ Y = Year + 4800 - A,
+ M = Month + 12 * A - 3,
+ JDN = Day + ( 153 * M + 2 ) // 5 + 365 * Y + Y // 4 - Y // 100 + Y // 400
+ - 32045.
+
+year(Date) = Date ^ dt_year.
+month(Date) = det_month(Date ^ dt_month).
+day_of_month(Date) = Date ^ dt_day.
+hour(Date) = Date ^ dt_hour.
+minute(Date) = Date ^ dt_minute.
+second(Date) = Date ^ dt_second.
+
+years(Dur) = Dur ^ dur_years.
+months(Dur) = Dur ^ dur_months.
+days(Dur) = Dur ^ dur_days.
+hours(Dur) = Dur ^ dur_hours.
+minutes(Dur) = Dur ^ dur_minutes.
+seconds(Dur) = Dur ^ dur_seconds.
+
+init_date(Year, Month, Day, Hour, Minute, Second, Date) :-
+ Day >= 1,
+ Day =< max_day_in_month_for(Year, month_num(Month)),
+ Hour < 24,
+ Minute < 60,
+ Second < 62,
+ Date = date(Year, month_num(Month), Day, Hour, Minute, Second).
+
+det_init_date(Year, Month, Day, Hour, Minute, Second) = Date
+ :-
+ (
+ init_date(Year, Month, Day, Hour, Minute, Second, Date0)
+ ->
+ Date = Date0
+ ;
+ error(string.format("calendar.det_init_date: invalid date: " ++
+ "%i-%i-%i %i:%i:%i", [i(Year), i(month_num(Month)), i(Day), i(Hour),
+ i(Minute), i(Second)]))
+ ).
+
+current_local_time(Now, !IO) :-
+ time.time(TimeT, !IO),
+ TM = time.localtime(TimeT),
+ Now = tm_to_date(TM).
+
+current_utc_time(Now, !IO) :-
+ time.time(TimeT, !IO),
+ TM = time.gmtime(TimeT),
+ Now = tm_to_date(TM).
+
+:- func tm_to_date(time.tm) = date.
+
+tm_to_date(TM) = Date :-
+ TM = tm(TMYear, TMMonth, TMDay, TMHour, TMMinute, TMSecond, _, _, _),
+ Year = 1900 + TMYear,
+ Month = TMMonth + 1,
+ Day = TMDay,
+ Hour = TMHour,
+ Minute = TMMinute,
+ Second = TMSecond,
+ Date = date(Year, Month, Day, Hour, Minute, Second).
+
+local_time_offset(TZ, !IO) :-
+ time.time(TimeT, !IO),
+ LocalTM = time.localtime(TimeT),
+ GMTM = time.gmtime(TimeT),
+ LocalTime = tm_to_date(LocalTM),
+ GMTime = tm_to_date(GMTM),
+ TZ = duration(GMTime, LocalTime).
+
+init_positive_duration(Years, Months, Days, Hours, Minutes, Seconds) =
+ ( all_non_negative(Years, Months, Days, Hours, Minutes, Seconds) ->
+ duration(Years, Months, Days, Hours, Minutes, Seconds)
+ ;
+ func_error(string.format("init_positive_duration: some dimensions " ++
+ "are negative: %iY%iM%iDT%iH%iM%iS", [i(Years), i(Months), i(Days),
+ i(Hours), i(Minutes), i(Seconds)]))
+ ).
+
+init_negative_duration(Years, Months, Days, Hours, Minutes, Seconds) =
+ ( all_non_negative(Years, Months, Days, Hours, Minutes, Seconds) ->
+ duration(-Years, -Months, -Days, -Hours, -Minutes, -Seconds)
+ ;
+ func_error(string.format("init_negative_duration: some dimensions " ++
+ "are negative: %iY%iM%iDT%iH%iM%fS", [i(Years), i(Months), i(Days),
+ i(Hours), i(Minutes), i(Seconds)]))
+ ).
+
+:- pred all_non_negative(years::in, months::in, days::in, hours::in,
+ minutes::in, seconds::in) is semidet.
+
+all_non_negative(Years, Months, Days, Hours, Minutes, Seconds) :-
+ Years >= 0,
+ Months >= 0,
+ Days >= 0,
+ Hours >= 0,
+ Minutes >= 0,
+ Seconds >= 0.
+
+:- func negate(duration) = duration.
+
+negate(duration(Years, Months, Days, Hours, Minutes, Seconds)) =
+ duration(-Years, -Months, -Days, -Hours, -Minutes, -Seconds).
+
+:- func zero_duration = duration.
+
+zero_duration = duration(0, 0, 0, 0, 0, 0).
+
+:- func det_month(int) = month.
+
+det_month(N) = Month :-
+ ( num_to_month(N, Month0) ->
+ Month = Month0
+ ;
+ error("det_month: invalid month: " ++ int_to_string(N))
+ ).
+
+:- func month_num(month) = int.
+
+month_num(Month) = N :- num_to_month(N, Month).
+
+:- pred num_to_month(int, month).
+:- mode num_to_month(in, out) is semidet.
+:- mode num_to_month(out, in) is det.
+
+num_to_month(1, january).
+num_to_month(2, february).
+num_to_month(3, march).
+num_to_month(4, april).
+num_to_month(5, may).
+num_to_month(6, june).
+num_to_month(7, july).
+num_to_month(8, august).
+num_to_month(9, september).
+num_to_month(10, october).
+num_to_month(11, november).
+num_to_month(12, december).
+
+day_of_week(Date) = DayOfWeek :-
+ JDN = julian_day(Date ^ dt_year, Date ^ dt_month, Date ^ dt_day),
+ Mod = JDN mod 7,
+ DayOfWeek = det_day_of_week_from_mod(Mod).
+
+:- func det_day_of_week_from_mod(int) = day_of_week.
+
+det_day_of_week_from_mod(Mod) = DayOfWeek :-
+ ( day_of_week_num(DayOfWeek0, Mod) ->
+ DayOfWeek = DayOfWeek0
+ ;
+ error("det_day_of_week_from_mod: invalid mod: " ++
+ int_to_string(Mod))
+ ).
+
+:- pred day_of_week_num(day_of_week, int).
+:- mode day_of_week_num(in, out) is det.
+:- mode day_of_week_num(out, in) is semidet.
+
+day_of_week_num(monday, 0).
+day_of_week_num(tuesday, 1).
+day_of_week_num(wednesday, 2).
+day_of_week_num(thursday, 3).
+day_of_week_num(friday, 4).
+day_of_week_num(saturday, 5).
+day_of_week_num(sunday, 6).
+
+%-----------------------------------------------------------------------------%
+:- end_module calendar.
+%-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.120
diff -u -r1.120 library.m
--- library/library.m 9 Mar 2008 09:39:24 -0000 1.120
+++ library/library.m 27 Jan 2009 00:57:06 -0000
@@ -59,6 +59,7 @@
:- import_module bool.
:- import_module bt_array.
:- import_module builtin.
+:- import_module calendar.
:- import_module char.
:- import_module construct.
:- import_module cord.
@@ -229,6 +230,7 @@
mercury_std_library_module("bool").
mercury_std_library_module("bt_array").
mercury_std_library_module("builtin").
+mercury_std_library_module("calendar").
mercury_std_library_module("char").
mercury_std_library_module("construct").
mercury_std_library_module("cord").
Index: tests/hard_coded/calendar_test.exp
===================================================================
RCS file: tests/hard_coded/calendar_test.exp
diff -N tests/hard_coded/calendar_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/calendar_test.exp 27 Jan 2009 03:38:06 -0000
@@ -0,0 +1,87 @@
+Partial order on durations:
+P1M <> P30D
+P1M =< P32D
+P3M =< P92D
+P1Y >= PT31535000S
+P11M =< P1Y
+P12M == P1Y
+P1D == PT24H
+PT1S =< PT1M1S
+
+Adding durations to date-times:
+1901-12-31 00:00:00 + P1D = 1902-01-01 00:00:00
+1901-12-31 00:00:00 + P1M = 1902-01-31 00:00:00
+1901-12-31 00:00:00 + P1Y = 1902-12-31 00:00:00
+1901-12-31 00:00:00 + PT1H = 1901-12-31 01:00:00
+1901-12-31 00:00:00 + PT1M = 1901-12-31 00:01:00
+1901-12-31 00:00:00 + PT1S = 1901-12-31 00:00:01
+2000-02-28 00:00:00 + P1D = 2000-02-29 00:00:00
+2001-01-30 00:00:00 + P1M = 2001-02-28 00:00:00
+2000-01-30 00:00:00 + P1M = 2000-02-29 00:00:00
+2007-01-01 00:00:00 + PT31536000S = 2008-01-01 00:00:00
+2008-01-01 00:00:00 + PT31536000S = 2008-12-31 00:00:00
+2008-03-31 00:00:00 + -P1M = 2008-02-29 00:00:00
+2007-03-31 00:00:00 + -P1M = 2007-02-28 00:00:00
+1000-01-01 00:00:00 + -PT1M = 0999-12-31 23:59:00
+2000-03-01 00:00:00 + -PT1H = 2000-02-29 23:00:00
+-0001-01-01 00:00:00 + -PT1S = -0002-12-31 23:59:59
+
+Computing durations:
+G: 2008-01-01 00:00:00 -> 2200-04-04 04:04:04 = P192Y3M3DT4H4M4S checked ok
+G: 2200-04-04 04:04:04 -> 2008-01-01 00:00:00 = -P192Y3M3DT4H4M4S checked ok
+D: 2008-01-01 00:00:00 -> 2200-04-04 04:04:04 = P70220DT4H4M4S checked ok
+D: 2200-04-04 04:04:04 -> 2008-01-01 00:00:00 = -P70220DT4H4M4S checked ok
+
+G: 2008-01-31 00:00:00 -> 2008-02-29 10:00:00 = P1MT10H checked ok
+G: 2008-02-29 10:00:00 -> 2008-01-31 00:00:00 = -P29DT10H checked ok
+D: 2008-01-31 00:00:00 -> 2008-02-29 10:00:00 = P29DT10H checked ok
+D: 2008-02-29 10:00:00 -> 2008-01-31 00:00:00 = -P29DT10H checked ok
+
+G: 2000-01-31 00:00:00 -> 2001-01-29 00:00:00 = P11M29D checked ok
+G: 2001-01-29 00:00:00 -> 2000-01-31 00:00:00 = -P11M29D checked ok
+D: 2000-01-31 00:00:00 -> 2001-01-29 00:00:00 = P364D checked ok
+D: 2001-01-29 00:00:00 -> 2000-01-31 00:00:00 = -P364D checked ok
+
+G: 2000-02-29 00:00:00 -> 2001-01-31 00:00:00 = P11M2D checked ok
+G: 2001-01-31 00:00:00 -> 2000-02-29 00:00:00 = -P11M checked ok
+D: 2000-02-29 00:00:00 -> 2001-01-31 00:00:00 = P337D checked ok
+D: 2001-01-31 00:00:00 -> 2000-02-29 00:00:00 = -P337D checked ok
+
+G: 2000-02-29 22:58:58 -> 2001-01-31 23:59:59 = P11M2DT1H1M1S checked ok
+G: 2001-01-31 23:59:59 -> 2000-02-29 22:58:58 = -P11MT1H1M1S checked ok
+D: 2000-02-29 22:58:58 -> 2001-01-31 23:59:59 = P337DT1H1M1S checked ok
+D: 2001-01-31 23:59:59 -> 2000-02-29 22:58:58 = -P337DT1H1M1S checked ok
+
+G: 2001-02-28 00:00:00 -> 2001-03-29 00:00:00 = P1M1D checked ok
+G: 2001-03-29 00:00:00 -> 2001-02-28 00:00:00 = -P1M checked ok
+D: 2001-02-28 00:00:00 -> 2001-03-29 00:00:00 = P29D checked ok
+D: 2001-03-29 00:00:00 -> 2001-02-28 00:00:00 = -P29D checked ok
+
+G: 2001-02-27 00:00:00 -> 2001-03-29 00:00:00 = P1M2D checked ok
+G: 2001-03-29 00:00:00 -> 2001-02-27 00:00:00 = -P1M1D checked ok
+D: 2001-02-27 00:00:00 -> 2001-03-29 00:00:00 = P30D checked ok
+D: 2001-03-29 00:00:00 -> 2001-02-27 00:00:00 = -P30D checked ok
+
+G: 1975-06-05 12:00:00 -> 1977-10-09 12:00:00 = P2Y4M4D checked ok
+G: 1977-10-09 12:00:00 -> 1975-06-05 12:00:00 = -P2Y4M4D checked ok
+D: 1975-06-05 12:00:00 -> 1977-10-09 12:00:00 = P857D checked ok
+D: 1977-10-09 12:00:00 -> 1975-06-05 12:00:00 = -P857D checked ok
+
+G: 1977-10-09 12:00:00 -> 1980-01-05 11:11:11 = P2Y2M26DT23H11M11S checked ok
+G: 1980-01-05 11:11:11 -> 1977-10-09 12:00:00 = -P2Y2M26DT23H11M11S checked ok
+D: 1977-10-09 12:00:00 -> 1980-01-05 11:11:11 = P817DT23H11M11S checked ok
+D: 1980-01-05 11:11:11 -> 1977-10-09 12:00:00 = -P817DT23H11M11S checked ok
+
+G: 1977-10-09 12:00:00 -> 1980-03-01 12:00:00 = P2Y4M21D checked ok
+G: 1980-03-01 12:00:00 -> 1977-10-09 12:00:00 = -P2Y4M23D checked ok
+D: 1977-10-09 12:00:00 -> 1980-03-01 12:00:00 = P874D checked ok
+D: 1980-03-01 12:00:00 -> 1977-10-09 12:00:00 = -P874D checked ok
+
+
+Day of the week:
+2008-01-15 23:59:00 : tuesday
+2008-01-16 19:08:00 : wednesday
+1360-04-14 00:00:00 : monday
+1865-02-27 00:00:00 : monday
+1886-02-08 00:00:00 : monday
+1929-10-28 00:00:00 : monday
Index: tests/hard_coded/calendar_test.m
===================================================================
RCS file: tests/hard_coded/calendar_test.m
diff -N tests/hard_coded/calendar_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/calendar_test.m 27 Jan 2009 03:29:06 -0000
@@ -0,0 +1,140 @@
+:- module calendar_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module calendar.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ io.write_string("Partial order on durations:\n", !IO),
+ test_dur_leq("P1M", "P30D", !IO), % <>
+ test_dur_leq("P1M", "P32D", !IO), % =<
+ test_dur_leq("P3M", "P92D", !IO), % =<
+ test_dur_leq("P1Y", "PT31535000S", !IO), % >=
+ test_dur_leq("P11M", "P1Y", !IO), % =<
+ test_dur_leq("P12M", "P1Y", !IO), % ==
+ test_dur_leq("P1D", "PT24H", !IO), % ==
+ test_dur_leq("PT1S", "PT1M1S", !IO), % =<
+ io.nl(!IO),
+ io.write_string("Adding durations to date-times:\n", !IO),
+ test_add_dur("1901-12-31 00:00:00", "P1D", !IO),
+ test_add_dur("1901-12-31 00:00:00", "P1M", !IO),
+ test_add_dur("1901-12-31 00:00:00", "P1Y", !IO),
+ test_add_dur("1901-12-31 00:00:00", "PT1H", !IO),
+ test_add_dur("1901-12-31 00:00:00", "PT1M", !IO),
+ test_add_dur("1901-12-31 00:00:00", "PT1S", !IO),
+ test_add_dur("2000-02-28 00:00:00", "P1D", !IO),
+ test_add_dur("2001-01-30 00:00:00", "P1M", !IO),
+ test_add_dur("2000-01-30 00:00:00", "P1M", !IO),
+ test_add_dur("2007-01-01 00:00:00", "PT31536000S", !IO),
+ test_add_dur("2008-01-01 00:00:00", "PT31536000S", !IO),
+ test_add_dur("2008-03-31 00:00:00", "-P1M", !IO),
+ test_add_dur("2007-03-31 00:00:00", "-P1M", !IO),
+ test_add_dur("1000-01-01 00:00:00", "-PT1M", !IO),
+ test_add_dur("2000-03-01 00:00:00", "-PT1H", !IO),
+ test_add_dur("-0001-01-01 00:00:00", "-PT1S", !IO),
+ io.nl(!IO),
+ io.write_string("Computing durations:\n", !IO),
+ test_diff("2008-01-01 00:00:00", "2200-04-04 04:04:04", !IO),
+ test_diff("2008-01-31 00:00:00", "2008-02-29 10:00:00", !IO),
+ test_diff("2000-01-31 00:00:00", "2001-01-29 00:00:00", !IO),
+ test_diff("2000-02-29 00:00:00", "2001-01-31 00:00:00", !IO),
+ test_diff("2000-02-29 22:58:58", "2001-01-31 23:59:59", !IO),
+ test_diff("2001-02-28 00:00:00", "2001-03-29 00:00:00", !IO),
+ test_diff("2001-02-27 00:00:00", "2001-03-29 00:00:00", !IO),
+ test_diff("1975-06-05 12:00:00", "1977-10-09 12:00:00", !IO),
+ test_diff("1977-10-09 12:00:00", "1980-01-05 11:11:11", !IO),
+ test_diff("1977-10-09 12:00:00", "1980-03-01 12:00:00", !IO),
+ io.nl(!IO),
+ io.write_string("Day of the week:\n", !IO),
+ test_day_of_week("2008-01-15 23:59:00", !IO),
+ test_day_of_week("2008-01-16 19:08:00", !IO),
+ test_day_of_week("1360-04-14 00:00:00", !IO),
+ test_day_of_week("1865-02-27 00:00:00", !IO),
+ test_day_of_week("1886-02-08 00:00:00", !IO),
+ test_day_of_week("1929-10-28 00:00:00", !IO).
+
+:- pred test_dur_leq(string::in, string::in, io::di, io::uo) is det.
+
+test_dur_leq(Str1, Str2, !IO) :-
+ Dur1 = det_duration_from_string(Str1),
+ Dur2 = det_duration_from_string(Str2),
+ ( duration_leq(Dur1, Dur2), duration_leq(Dur2, Dur1) ->
+ RelationStr = " == "
+ ; duration_leq(Dur1, Dur2) ->
+ RelationStr = " =< "
+ ; duration_leq(Dur2, Dur1) ->
+ RelationStr = " >= "
+ ;
+ RelationStr = " <> "
+ ),
+ io.format("%s %s %s\n", [s(Str1), s(RelationStr), s(Str2)], !IO).
+
+:- pred test_add_dur(string::in, string::in, io::di, io::uo) is det.
+
+test_add_dur(Date0Str, DurStr, !IO) :-
+ Date0 = det_date_from_string(Date0Str),
+ Dur = det_duration_from_string(DurStr),
+ add_duration(Dur, Date0, Date),
+ DateStr = date_to_string(Date),
+ io.format("%s + %s = %s\n", [s(Date0Str), s(DurStr), s(DateStr)], !IO).
+
+:- pred test_diff(string::in, string::in, io::di, io::uo) is det.
+
+test_diff(Date1, Date2, !IO) :-
+ io.write_string("G: ", !IO),
+ test_greedy_diff(Date1, Date2, !IO),
+ io.write_string("G: ", !IO),
+ test_greedy_diff(Date2, Date1, !IO),
+ io.write_string("D: ", !IO),
+ test_days_diff(Date1, Date2, !IO),
+ io.write_string("D: ", !IO),
+ test_days_diff(Date2, Date1, !IO),
+ io.nl(!IO).
+
+:- pred test_greedy_diff(string::in, string::in, io::di, io::uo) is det.
+
+test_greedy_diff(Date1Str, Date2Str, !IO) :-
+ Date1 = det_date_from_string(Date1Str),
+ Date2 = det_date_from_string(Date2Str),
+ duration(Date1, Date2) = Dur,
+ DurStr = duration_to_string(Dur),
+ io.format("%s -> %s = %s", [s(Date1Str), s(Date2Str), s(DurStr)], !IO),
+ add_duration(Dur, Date1, Date3),
+ ( Date2 = Date3 ->
+ io.write_string(" checked ok\n", !IO)
+ ;
+ io.write_string(" error: " ++ date_to_string(Date3) ++
+ "\n", !IO)
+ ).
+
+:- pred test_days_diff(string::in, string::in, io::di, io::uo) is det.
+
+test_days_diff(Date1Str, Date2Str, !IO) :-
+ Date1 = det_date_from_string(Date1Str),
+ Date2 = det_date_from_string(Date2Str),
+ Dur = day_duration(Date1, Date2),
+ DurStr = duration_to_string(Dur),
+ io.format("%s -> %s = %s", [s(Date1Str), s(Date2Str), s(DurStr)], !IO),
+ add_duration(Dur, Date1, Date3),
+ ( Date2 = Date3 ->
+ io.write_string(" checked ok\n", !IO)
+ ;
+ io.write_string(" error: " ++ date_to_string(Date3) ++
+ "\n", !IO)
+ ).
+
+:- pred test_day_of_week(string::in, io::di, io::uo) is det.
+
+test_day_of_week(DateStr, !IO) :-
+ io.write_string(DateStr ++ " : ", !IO),
+ io.write(day_of_week(det_date_from_string(DateStr)), !IO),
+ io.nl(!IO).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list