1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker and Willem Robert van Hage
    4    E-mail:        wielemak@science.uva.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2024, University of Amsterdam
    7                              SWI-Prolog Solutions b.v.
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(date,
   37          [ date_time_value/3,          % ?Field, ?DaTime, ?Value
   38            parse_time/2,               % +Date, -Stamp
   39            parse_time/3,               % +Date, ?Format, -Stamp
   40            day_of_the_week/2,          % +Date, -DayOfTheWeek
   41            day_of_the_year/2           % +Date, -DayOfTheYear
   42          ]).   43
   44/** <module> Process dates and times
   45*/
   46
   47%!  date_time_value(?Field:atom, +Struct:datime, -Value) is nondet.
   48%
   49%   Extract values from a date-time structure.  Provided fields are
   50%
   51%           | year | integer | |
   52%           | month | 1..12 | |
   53%           | day | 1..31 | |
   54%           | hour | 0..23 | |
   55%           | minute | 0..59 | |
   56%           | second | 0.0..60.0 | |
   57%           | utc_offset | integer | Offset to UTC in seconds (positive is west) |
   58%           | daylight_saving | bool | Name of timezone; fails if unknown |
   59%           | date | date(Y,M,D) | |
   60%           | time | time(H,M,S) | |
   61
   62date_time_value(year,            date(Y,_,_,_,_,_,_,_,_), Y).
   63date_time_value(month,           date(_,M,_,_,_,_,_,_,_), M).
   64date_time_value(day,             date(_,_,D,_,_,_,_,_,_), D).
   65date_time_value(hour,            date(_,_,_,H,_,_,_,_,_), H).
   66date_time_value(minute,          date(_,_,_,_,M,_,_,_,_), M).
   67date_time_value(second,          date(_,_,_,_,_,S,_,_,_), S).
   68date_time_value(utc_offset,      date(_,_,_,_,_,_,O,_,_), O).
   69date_time_value(time_zone,       date(_,_,_,_,_,_,_,Z,_), Z) :- Z \== (-).
   70date_time_value(daylight_saving, date(_,_,_,_,_,_,_,_,D), D) :- D \== (-).
   71
   72date_time_value(date,            date(Y,M,D,_,_,_,_,_,_), date(Y,M,D)).
   73date_time_value(time,            date(_,_,_,H,M,S,_,_,_), time(H,M,S)).
   74
   75%!  parse_time(+Text, -Stamp) is semidet.
   76%!  parse_time(+Text, ?Format, -Stamp) is semidet.
   77%
   78%   Stamp is a  timestamp  created  from   parsing  Text  using  the
   79%   representation Format. Currently supported formats are:
   80%
   81%       * rfc_1123
   82%       Preferred for the HTTP protocol to represent time-stamps, e.g.
   83%
   84%           Fri, 08 Dec 2006 15:29:44 GMT
   85%
   86%       All components except for the time zone are obligatory.
   87%       If the time zone is omitted, the time is interpreted as
   88%       _local time_.
   89%
   90%       * rfc_1036
   91%       (Outdated) alternative for HTTP Protocol, e.g.
   92%
   93%           Sunday, 06-Nov-94 08:49:37 GMT
   94%
   95%       * iso_8601
   96%       Commonly used in XML documents. Actually the XML RFC3339
   97%       is a _profile_ of ISO8601.  For example
   98%
   99%           2006-12-08T15:29:44Z
  100%
  101%       The ISO8601 format allows removing components from the
  102%       right, returning the lowest time stamp in the specified
  103%       internal. If a time is specified but no time zone, the
  104%	time stamp is computed for the _local time_.  If only
  105%	the date components are specified, the stamp uses UTC.
  106%	To compute the start of a day in local time, use
  107%	e.g. ``2006-12-08T00``.
  108%
  109%       * asctime
  110%       ANSI C's asctime() format, e.g.
  111%
  112%           Sun Nov  6 08:49:37 1994
  113%
  114%       This format has no time zone and is interpreted as local
  115%       time.
  116%
  117%   @arg Text is an atom, string or list of character _codes_.
  118%   @see  xsd_time_string/3  from  library(sgml)    implements   RFC3339
  119%   strictly.
  120
  121parse_time(Text, Stamp) :-
  122    parse_time(Text, _Format, Stamp).
  123
  124parse_time(Text, Format, Stamp) :-
  125    to_codes(Text, Codes),
  126    phrase(date(Format, Y,Mon,D,H,Min,S,UTCOffset), Codes),
  127    !,
  128    tz_dst(time(H,Min,S), UTCOffset, TZ, DST),
  129    date_time_stamp(date(Y,Mon,D,H,Min,S,UTCOffset,TZ,DST), Stamp).
  130
  131to_codes(In, Codes) :-
  132    (   is_list(In)
  133    ->  Codes = In
  134    ;   atom_codes(In, Codes)
  135    ).
  136
  137tz_dst(_Time, UTCOffset, TZ, DST), nonvar(UTCOffset) =>
  138    TZ = (-), DST = (-).
  139tz_dst(time(H,M,S), UTCOffset, TZ, DST), var(H), var(M), var(S) =>
  140    UTCOffset = 0, TZ = (-), DST = (-).
  141tz_dst(_, _, _, _) =>
  142    true.
  143
  144date(iso_8601, Yr, Mon, D, H, Min, S, UTCOffset) --> % BC
  145    "-", date(iso_8601, Y, Mon, D, H, Min, S, UTCOffset),
  146    { Yr is -1 * Y }.
  147date(iso_8601, Y, Mon, D, H, Min, S, UTCOffset) -->
  148    year(Y),
  149    iso_8601_rest(Y, Mon, D, H, Min, S, UTCOffset).
  150date(rfc_1123, Y, Mon, D, H, M, S, UTCOffset) -->
  151    day_name(_), ", ", ws, % RFC 1123: "Fri, 08 Dec 2006 15:29:44 GMT"
  152    day_of_the_month(D), ws,
  153    month_name(Mon), ws,
  154    year(Y), ws,
  155    iso_time3(H, M, S), ws,
  156    timezone(UTCOffset).
  157date(rfc_1036, Y, Mon, D, H, M, S, UTCOffset) -->
  158    full_day_name(_), ", ", ws, % RFC 1036: "Friday, 08-Dec-2006 15:29:44 GMT"
  159    day_of_the_month(D), "-",
  160    month_name(Mon), "-",
  161    year2d(Y), ws,
  162    iso_time3(H, M, S), ws,
  163    timezone(UTCOffset).
  164date(asctime, Y, Mon, D, H, M, S, _UTCOffset) -->
  165    day_name(_), " ",
  166    month_name(Mon), " ",
  167    asctime_day_of_the_month(D), " ",
  168    iso_time3(H, M, S), " ",
  169    year(Y).
  170
  171%!  iso_8601_rest(+Year:int, -Mon, -Day, -H, -M, -S, -UTCOffset)
  172%
  173%   Process ISO 8601 time-values after parsing the 4-digit year.
  174
  175iso_8601_rest(_, Mon, D, H, Min, S, UTCOffset) -->
  176    "-", month(Mon), "-", day(D),
  177    opt_time(H, Min, S, UTCOffset).
  178iso_8601_rest(_, Mon, _, _, _, _, _) -->
  179    "-", month(Mon).
  180iso_8601_rest(_, Mon, D, H, Min, S, UTCOffset) -->
  181    month(Mon), day(D),
  182    opt_time(H, Min, S, UTCOffset).
  183iso_8601_rest(_, 1, D, H, Min, S, UTCOffset) -->
  184    "-", ordinal(D),
  185    opt_time(H, Min, S, UTCOffset).
  186iso_8601_rest(Yr, 1, D, H, Min, S, UTCOffset) -->
  187    "-W", week(W), "-", day_of_the_week(DW),
  188    opt_time(H, Min, S, UTCOffset),
  189    { week_ordinal(Yr, W, DW, D) }.
  190iso_8601_rest(Yr, 1, D, H, Min, S, UTCOffset) -->
  191    "W", week(W), day_of_the_week(DW),
  192    opt_time(H, Min, S, UTCOffset),
  193    { week_ordinal(Yr, W, DW, D) }.
  194iso_8601_rest(Yr, 1, D, _, _, _, _) -->
  195    "W", week(W),
  196    { week_ordinal(Yr, W, 1, D) }.
  197
  198opt_time(Hr, Min, Sec, UTCOffset) -->
  199    ("T";" "), !, iso_time(Hr, Min, Sec), timezone(UTCOffset).
  200opt_time(_H, _M, _S, _UTCOffset) --> "".
  201
  202
  203% TIMEX2 ISO: "2006-12-08T15:29:44 UTC" or "20061208T"
  204iso_time(H, M, S) -->
  205    iso_time3(H, M, S).
  206iso_time(H, M, _) -->
  207    hour(H), ":", minute(M).
  208iso_time(H, M, S) -->
  209    hour(H), minute(M), second(S).
  210iso_time(H, M, _) -->
  211    hour(H), minute(M).
  212iso_time(H, _, _) -->
  213    hour(H).
  214
  215iso_time3(H, M, S) -->
  216    hour(H), ":", minute(M), ":", second(S).
  217
  218% FIXME: deal with leap seconds
  219timezone(UTCOffset) -->
  220    "+", hour(H), ":", minute(M), { UTCOffset is -(H*3600+M*60) }.
  221timezone(UTCOffset) -->
  222    "+", hour(H), minute(M), { UTCOffset is -(H*3600+M*60) }.
  223timezone(UTCOffset) -->
  224    "+", hour(H), { UTCOffset is -(H*3600) }.
  225timezone(UTCOffset) -->
  226    "-", hour(H), ":", minute(M), { UTCOffset is H*3600+M*60 }.
  227timezone(UTCOffset) -->
  228    "-", hour(H), minute(M), { UTCOffset is H*3600+M*60 }.
  229timezone(UTCOffset) -->
  230    "-", hour(H), { UTCOffset is H*3600 }.
  231timezone(0) -->
  232    "Z".
  233timezone(0) -->
  234    ws, "UTC".
  235timezone(0) -->
  236    ws, "GMT".
  237timezone(_) -->   % unknown
  238    [].
  239
  240day_name(0) --> "Sun".
  241day_name(1) --> "Mon".
  242day_name(2) --> "Tue".
  243day_name(3) --> "Wed".
  244day_name(4) --> "Thu".
  245day_name(5) --> "Fri".
  246day_name(6) --> "Sat".
  247day_name(7) --> "Sun".
  248
  249full_day_name(0) --> "Sunday".
  250full_day_name(1) --> "Monday".
  251full_day_name(2) --> "Tuesday".
  252full_day_name(3) --> "Wednesday".
  253full_day_name(4) --> "Thursday".
  254full_day_name(5) --> "Friday".
  255full_day_name(6) --> "Saturday".
  256full_day_name(7) --> "Sunday".
  257
  258month_name(1) --> "Jan".
  259month_name(2) --> "Feb".
  260month_name(3) --> "Mar".
  261month_name(4) --> "Apr".
  262month_name(5) --> "May".
  263month_name(6) --> "Jun".
  264month_name(7) --> "Jul".
  265month_name(8) --> "Aug".
  266month_name(9) --> "Sep".
  267month_name(10) --> "Oct".
  268month_name(11) --> "Nov".
  269month_name(12) --> "Dec".
  270
  271asctime_day_of_the_month(D) -->
  272    " ", !, digit(D), {D > 0}.
  273asctime_day_of_the_month(D) -->
  274    day_of_the_month(D).
  275
  276day_of_the_month(N) --> int2digit(N), { between(1, 31, N) }.
  277day_of_the_week(N)  --> digit(N),     { between(1,  7, N) }.
  278month(M)            --> int2digit(M), { between(1, 12, M) }.
  279week(W)             --> int2digit(W), { between(1, 53, W) }.
  280day(D)              --> int2digit(D), { between(1, 31, D) }.
  281hour(N)             --> int2digit(N), { between(0, 23, N) }.
  282minute(N)           --> int2digit(N), { between(0, 59, N) }.
  283second(S)           --> int2digit(N), { between(0, 60, N) }, % leap second
  284    opt_fraction(N, S).
  285
  286opt_fraction(I, F) -->
  287    ( "." ; "," ),
  288    !,
  289    digits(D),
  290    { length(D, N),
  291      N > 0,
  292      number_codes(FP, D),
  293      F is I + FP/(10^N)
  294    }.
  295opt_fraction(I, I) -->
  296    [].
  297
  298int2digit(N) -->
  299    digit(D0),
  300    digit(D1),
  301    { N is D0*10+D1 }.
  302
  303year(Y) -->
  304    digit(D0),
  305    digit(D1),
  306    digit(D2),
  307    digit(D3),
  308    { Y is D0*1000+D1*100+D2*10+D3 }.
  309
  310year2d(Y) -->
  311    digit(D0),
  312    digit(D1),
  313    { Y0 is D0*10+D1,
  314      (   Y0 >= 70, Y0 =< 99
  315      ->  Y is Y0+1900
  316      ;   Y is Y0+2000
  317      )
  318    }.
  319
  320ordinal(N) --> % Nth day of the year, jan 1 = 1, dec 31 = 365 or 366
  321    digit(D0),
  322    digit(D1),
  323    digit(D2),
  324    { N is D0*100+D1*10+D2, between(1, 366, N) }.
  325
  326digit(D) -->
  327    [C],
  328    { code_type(C, digit(D)) }.
  329
  330digits([C|T]) -->
  331    [C],
  332    { code_type(C, digit) },
  333    !,
  334    digits(T).
  335digits([]) --> [].
  336
  337ws -->
  338    " ",
  339    !,
  340    ws.
  341ws -->
  342    [].
  343
  344%!  day_of_the_week(+Date, -DayOfTheWeek) is det.
  345%
  346%   Computes the day of the week for a  given date. Days of the week
  347%   are numbered from one to seven: monday   =  1, tuesday = 2, ...,
  348%   sunday = 7.
  349%
  350%   @param Date is a term of the form date(+Year, +Month, +Day)
  351
  352day_of_the_week(date(Year, Mon, Day), DotW) :-
  353    format_time(atom(A), '%u', date(Year, Mon, Day, 0, 0, 0, 0, -, -)),
  354    atom_number(A, DotW).
  355
  356week_ordinal(Year, Week, Day, Ordinal) :-
  357    format_time(atom(A), '%w', date(Year, 1, 1, 0, 0, 0, 0, -, -)),
  358    atom_number(A, DotW0),
  359    Ordinal is ((Week-1) * 7) - DotW0 + Day + 1.
  360
  361%!  day_of_the_year(+Date, -DayOfTheYear) is det.
  362%
  363%   Computes the day of the year for a  given date. Days of the year
  364%   are numbered from 1 to 365 (366 for a leap year).
  365%
  366%   @param Date is a term of the form date(+Year, +Month, +Day)
  367
  368day_of_the_year(date(Year, Mon, Day), DotY) :-
  369    format_time(atom(A), '%j', date(Year, Mon, Day, 0, 0, 0, 0, -, -)),
  370    atom_number(A, DotY)