1%-----------------------------------------------------------
    2% Module definition
    3%
    4
    5:- module(date_time,
    6   [
    7      date_get/2,             % get a date for today, tomorrow, etc.
    8      date_create/4,          % create a new date structure
    9      date_extract/2,         % extract date fields from a date structure
   10      date_age/2,             % compute an age from a birthday
   11      date_compare/3,         % compare two dates
   12      date_add/3,             % add years/months/weeks/days to a date
   13      date_difference/3,      % find the difference between two dates
   14      date_interval/3,        % find difference in single interval type (year, month, etc.)
   15      date_string/3,          % convert between date structures and strings
   16      date_year_day/2,        % calculate the day number for the year
   17      date_1900_days/2,       % calculate the days since the 0th day of 1900
   18      is_date_expression/1,   % succeeds if expression is a special date expression
   19      is_date_interval/1,     % succeeds if expression is a date interval
   20      is_date/1,              % succeeds if expression is a date
   21      time_get/2,             % gets the current time
   22      time_compare/3,         % compares two times
   23      time_add/3,             % add hours/mins/secs to a time
   24      time_difference/3,      % find the difference between two times
   25      time_interval/3,        % find the difference in single interval type(hour, min, sec)
   26      time_string/2,          % convert between time structures and strings
   27      datetime_get/2,         % get the current date and time
   28      datetime_compare/3,     % compare two datetime structures
   29      datetime_add/3,         % add datetime quantities to a datetime
   30      datetime_difference/3,  % find the difference between two datetimes
   31      datetime_string/3,      % convert to/from datetime strings
   32      datetime_date_time/3,   % convert datetime to/from date and time structures
   33      datetime_extract/2,     % extract years, months etc. from date time structure
   34      is_datetime_interval/1, % succeeds if expression is a date or time interval
   35      is_datetime/1,          % succeeds if expression is a datetime
   36      week_dayn/2,            % returns number for day of the week, 0 = Monday, 1 = Tuesday, ...
   37      week_day/2,             % returns the day of the week for a date or datetime
   38
   39      % Custom operator definitions
   40      op(50, xf, days),
   41      op(50, xf, months),
   42      op(50, xf, weeks),
   43      op(50, xf, years),
   44      op(50, xf, hours),
   45      op(50, xf, mins),
   46      op(50, xf, secs)
   47   ]).   48
   49
   50%-----------------------------------------------------------
   51% Native dependency requirements
   52%
   53
   54:- use_module(library(date)).   55
   56
   57%-----------------------------------------------------------
   58% Custom operator definitions
   59%
   60
   61:- op(700, xfx, <=).   62
   63
   64%-----------------------------------------------------------
   65% date_get(+DATE_TYPE, -DATE)
   66%
   67% Given one of the DATE_TYPEs, seen below, returns
   68% the DATE structure.
   69%
   70
   71date_get(today, date(Y,M,D)) :-
   72   get_time(Stamp),
   73   stamp_date_time(Stamp, DateTime, local),
   74   date_time_value(year, DateTime, Y),
   75   date_time_value(month, DateTime, M),
   76   date_time_value(day, DateTime, D).
   77date_get(yesterday, DATE) :- date_add(today, days(-1), DATE).
   78date_get(tomorrow, DATE) :- date_add(today, days(1), DATE).
   79date_get(last_week, DATE) :- date_add(today, weeks(-1), DATE).
   80date_get(next_week, DATE) :- date_add(today, weeks(1), DATE).
   81date_get(last_month, DATE) :- date_add(today, months(-1), DATE).
   82date_get(next_month, DATE) :- date_add(today, months(1), DATE).
   83date_get(last_year, DATE) :- date_add(today, years(-1), DATE).
   84date_get(next_year, DATE) :- date_add(today, years(1), DATE).
   85
   86
   87%-----------------------------------------------------------
   88% date_create(+YEAR, +MONTH, +DAY, -DATE)
   89%
   90% Creates a new DATE structure from an input
   91% YEAR, MONTH, and DAY.
   92%
   93
   94date_create(Y, M, D, date(Y,M,D)).
   95
   96
   97%-----------------------------------------------------------
   98% date_extract(+DATE, -VALUE)
   99%
  100% Gets the VALUE of the year, month or day, as
  101% specified in the TYPE argument, from an input
  102% DATE structure.
  103%
  104
  105date_extract(date(Y,_,_), years(Y)).
  106date_extract(date(_,M,_), months(M)).
  107date_extract(date(_,_,D), days(D)).
  108
  109
  110%-----------------------------------------------------------
  111% date_age(+BIRTHDAY, -AGE)
  112%
  113% Computes an AGE in years, given a birthday
  114% date structure.  But, when it gets close, the
  115% days might be negative, so need to check for
  116% that case to prevent premature aging.
  117%
  118
  119date_age(BDAY, AGE) :-
  120   date_get(today, TODAY),
  121   date_difference(TODAY, BDAY, DIFF),
  122   memberchk(A years, DIFF),
  123   memberchk(M months, DIFF),
  124   memberchk(D days, DIFF),
  125   (M == 0, D < 0 ->
  126      AGE is A - 1
  127      ;
  128      AGE is A).
  129
  130
  131%-----------------------------------------------------------
  132% date_compare(+DATE_1, ?OP, +DATE_2)
  133%
  134% Compares the two date structures, unifying
  135% the result with the comparison operator.  So,
  136% it can be used to find the relationship or
  137% test a relationship.
  138%
  139% ?- date_compare(date(2002,1,15), X, date(2002,2,24)).
  140% X = <
  141% yes
  142% ?- date_compare(date(2002,1,15), =<, date(2002,2,24)).
  143% yes
  144%
  145
  146date_compare(D1, =, D2) :- D1 = D2, !.
  147date_compare(D1, >, D2) :- D1 @> D2, !.
  148date_compare(D1, <, D2) :- D1 @< D2, !.
  149date_compare(D1, >=, D2) :- D1 @>= D2, !.
  150date_compare(D1, =<, D2) :- D1 @=< D2, !.
  151date_compare(D1, <=, D2) :- D1 @=< D2, !.
  152
  153
  154%-----------------------------------------------------------
  155% date_add(+DATE_1, +DATE_QUANTITIES, -DATE_2)
  156%
  157% Adds the DATE_QUANTITIES to DATE_1 structure,
  158% returning DATE_2 structure.  The DATE_QUANTITIES
  159% are either a single structure or list of structures
  160% of the form days(D), months(M), or weeks(W).  Each
  161% is an operator, so can be written as '3 months' for
  162% example.
  163%
  164% The arithmetic is pure date arithmetic.  That is
  165% it adds calendar months, so Feb 15th plus one
  166% month yields Mar 15th.  Adding years over leap
  167% years winds up on same days as well.  Dates are
  168% correctly fixed for the corner cases, so an intermediate
  169% result of Feb 30th will become Mar 2nd in a non leap year
  170% and Mar 1st in leap year.
  171%
  172% ?- date_add(date(2002,1,15), [1 months, 2 days], D).
  173% D = date(2002, 2, 17)
  174% yes
  175%
  176% ?- date_add(date(2002,1,15), [1 years, 1 months, 15 days], D).
  177% D = date(2003, 3, 2)
  178% yes
  179%
  180% The special case of the last day of the month is
  181% recognized as well, so adding one month to the last
  182% day of a month gets the last day of the next month.
  183%
  184% ?- date_add(date(2002,1,31), 1 months, X).
  185% X = date(2002, 2, 28)
  186% yes
  187%
  188% ?- date_add(date(2002,2,28), 1 months, X).
  189% X = date(2002, 3, 31)
  190% yes
  191%
  192
  193date_add(DATE, [], DATE) :-
  194   !.
  195date_add(D1, -(A1 + A2), DATE) :-
  196   !,
  197   convert_exp(-(A1+A2), AList),
  198   date_add(D1, AList, DATE).
  199date_add(D1, -(A1 - A2), DATE) :-
  200   !,
  201   convert_exp(-(A1-A2), AList),
  202   date_add(D1, AList, DATE).
  203date_add(D1, A1 + A2, DATE) :-
  204   !,
  205   convert_exp(A1+A2, AList),
  206   date_add(D1, AList, DATE).
  207date_add(D1, A1 - A2, DATE) :-
  208   !,
  209   convert_exp(A1-A2, AList),
  210   date_add(D1, AList, DATE).
  211date_add(D1, [DUNIT|DUNITS], DATE) :-
  212   !,
  213   date_add(D1, DUNIT, D2),
  214   date_add(D2, DUNITS, DATE).
  215date_add(D1, - [DUNIT|DUNITS], DATE) :-
  216   !,
  217   reverse_unit_signs([DUNIT|DUNITS],[RUNIT|RUNITS]),
  218   date_add(D1, [RUNIT|RUNITS], DATE).
  219date_add(today, ADD, DATE) :-
  220   !,
  221   date_get(today, D1),
  222   date_add(D1, ADD, DATE).
  223date_add(D1, -ADD, DATE) :-
  224   !,
  225   ADD =.. [UNIT, AMOUNT],
  226   MADD =.. [UNIT, -AMOUNT],
  227   date_add(D1, MADD, DATE).
  228date_add(date(Y,M,D), days(D1), date(YY,MM,DD)) :-
  229   !,
  230   D2 is D + D1,
  231   date_fix(date(Y,M,D2), date(YY,MM,DD)).
  232date_add(date(Y,M,D), weeks(D1), date(YY,MM,DD)) :-
  233   !,
  234   D2 is D + 7 * D1,
  235   date_fix(date(Y,M,D2), date(YY,MM,DD)).
  236date_add(date(Y,M,D), months(M1), date(YY,MM,DD)) :-
  237   !,
  238   M2 is M + M1,
  239   date_islast(date(Y,M,D), D2),
  240   date_fix(date(Y,M2,D2), date(YY,MM,DD)).
  241date_add(date(Y,M,D), years(Y1), date(YY,MM,DD)) :-
  242   Y2 is Y + Y1,
  243   date_islast(date(Y,M,D), D2),
  244   date_fix(date(Y2,M,D2), date(YY,MM,DD)).
  245
  246convert_exp(Exp, List) :-
  247   convert_exp(Exp, [], List).
  248
  249convert_exp(-(I1+I2), SoFar, List) :-
  250   !, convert_exp(-I1, [-I2|SoFar], List).
  251convert_exp(-(I1-I2), SoFar, List) :-
  252   !, convert_exp(-I1, [I2|SoFar], List).
  253convert_exp(I1+I2, SoFar, List) :-
  254   !, convert_exp(I1, [I2|SoFar], List).
  255convert_exp(I1-I2, SoFar, List) :-
  256   !, convert_exp(I1, [-I2|SoFar], List).
  257convert_exp(-Int, SoFar, [-Int|SoFar]) :-
  258   !.
  259convert_exp(Int, SoFar, [Int|SoFar]) :-
  260   !.
  261
  262reverse_unit_signs([], []) :- !.
  263reverse_unit_signs([- A|As], [A|Bs]) :-
  264   !, reverse_unit_signs(As, Bs).
  265reverse_unit_signs([+ A|As], [- A|Bs]) :-
  266   !, reverse_unit_signs(As, Bs).
  267reverse_unit_signs([A|As], [- A|Bs]) :-
  268   !, reverse_unit_signs(As, Bs).
  269
  270
  271%-----------------------------------------------------------
  272% date_difference(+DATE_1, +DATE_2, -DATE_QUANTITIES).
  273%
  274% Subtracts, in pure date mode, DATE_2 date structure
  275% from DATE_1 date structure, providing a result of
  276% a list of date quantities.  Note that years are
  277% rounded, but that the result in the days(D) structure
  278% might be negative.  This is to allow the correct
  279% behavior when reapplying the difference by adding it
  280% to another date.
  281%
  282% ?- date_difference(date(2002,3,2), date(2002,1,15), D).
  283% D = [0 years, 1 months, 15 days]
  284% yes
  285%
  286% The special case of both dates being end of month
  287% is recognized as being just a difference of one month.
  288%
  289% ?- date_difference(date(2002,2,28), date(2002,1,31), X).
  290% X = [0 years, 1 months, 0 days]
  291% yes
  292%
  293
  294date_difference(date(Y1,M1,D1), date(Y2,M2,D2),
  295      [years(Y), months(M), days(D)]) :-
  296   (D2 > D1 ->
  297      (date_islast(date(Y1,M1,D1), last) ->
  298         M1a is M1,
  299         D1a is D2
  300         ;
  301         M1a is M1 - 1,
  302         date_month_days(M1a,Y1,Dprev),
  303         D1a is D1 + Dprev )
  304      ;
  305      D1a = D1,
  306      M1a = M1 ),
  307   (M2 > M1a ->
  308      M1b is M1a + 12,
  309      Y1b is Y1 - 1
  310      ;
  311      M1b = M1a,
  312      Y1b = Y1 ),
  313   Y is Y1b - Y2,
  314   M is M1b - M2,
  315   D is D1a - D2.
  316
  317
  318%----------------------------------------------------------
  319% date_1900_days(Date, Days)
  320%
  321% express a date as the number of days since the
  322% 0th day of 1900, which is date(1900,1,0).
  323%
  324
  325date_1900_days(date(Y,M,D), Days) :-
  326   var(Days),
  327   !,
  328   Years is Y - 1900,
  329   (Y > 2000 ->
  330      LeapDays is ((Years-1) // 4) - 1
  331      ;
  332      LeapDays is (Years-1) // 4 ),
  333   MM is M - 1,
  334   date_add_month_days(MM, Y, 0, MonthDays),
  335   Days is Years * 365 + LeapDays + MonthDays + D.
  336date_1900_days(Date, Days) :-
  337   YearEst is 1900 + (Days // 365),
  338   date_1900_days(date(YearEst,1,1), DaysUsed),
  339   DaysLeft is Days - DaysUsed,
  340   date_add(date(YearEst,1,1), DaysLeft days, Date).
  341
  342
  343%----------------------------------------------------------
  344% date_year_day(Date, YearDay)
  345%
  346% for a date, calculate the day number in the year of
  347% the day
  348%
  349
  350date_year_day(date(Y,M,D), YearDay) :-
  351   MM is M - 1,
  352   date_add_month_days(MM, Y, 0, MonthDays),
  353   YearDay is MonthDays + D.
  354
  355
  356%-----------------------------------------------------------
  357% date_interval(Date1, Date2, Interval)
  358%
  359% The date difference where Interval is in a specific
  360% unit, such as days or weeks.
  361%
  362% ex.  date_interval(D1, D2, M months).
  363%
  364
  365date_interval(D1, D2, D days) :-
  366   !,
  367   date_1900_days(D1, Days1),
  368   date_1900_days(D2, Days2),
  369   D is Days1 - Days2.
  370date_interval(D1, D2, W weeks) :-
  371   !,
  372   date_interval(D1, D2, D days),
  373   W is D // 7.
  374date_interval(D1, D2, MM months) :-
  375   !,
  376   date_difference(D1, D2, [Y years, M months|_]),
  377   MM is 12 * Y + M.
  378date_interval(D1, D2, Y years) :-
  379   !,
  380   date_difference(D1, D2, [Y years|_]).
  381
  382
  383%-----------------------------------------------------------
  384% Internal predicates used by exported
  385% date predicates.
  386%
  387
  388% make a date correct
  389
  390date_fix(date(Y,M,D), date(YY,MM,DD)) :-
  391   M < 1,
  392   !,
  393   M2 is M + 12,
  394   Y2 is Y - 1,
  395   date_fix(date(Y2,M2,D), date(YY,MM,DD)).
  396date_fix(date(Y,M,D), date(YY,MM,DD)) :-
  397   M > 12,
  398   !,
  399   M2 is M - 12,
  400   Y2 is Y + 1,
  401   date_fix(date(Y2,M2,D), date(YY,MM,DD)).
  402date_fix(date(Y,M,last), date(Y,M,MD)) :-
  403   !,
  404   date_month_days(M,Y,MD).
  405date_fix(date(Y,M,D), date(YY,MM,DD)) :-
  406   D < 1,
  407   !,
  408   M2 is M - 1,
  409   date_month_days(M2,Y,MD),
  410   D2 is D + MD,
  411   date_fix(date(Y,M2,D2), date(YY,MM,DD)).
  412date_fix(date(Y,M,D), date(YY,MM,DD)) :-
  413   date_month_days(M,Y,MD),
  414   D > MD,
  415   !,
  416   M2 is M + 1,
  417   D2 is D - MD,
  418   date_fix(date(Y,M2,D2), date(YY,MM,DD)).
  419date_fix(date(Y,M,D), date(Y,M,D)).
  420
  421% date_islast(+DATE, -DAY)
  422%
  423% if the day is the last day of the month,
  424% mark it as 'last', instead of its number.
  425
  426date_islast(date(Y,M,MD), last) :-
  427   date_month_days(M,Y,MD), !.
  428date_islast(date(_,_,D), D).
  429
  430date_month_days(0,_,31).
  431date_month_days(1,_,31).
  432date_month_days(2,Y,29) :- date_leap_year(Y), !.
  433date_month_days(2,_,28).
  434date_month_days(3,_,31).
  435date_month_days(4,_,30).
  436date_month_days(5,_,31).
  437date_month_days(6,_,30).
  438date_month_days(7,_,31).
  439date_month_days(8,_,31).
  440date_month_days(9,_,30).
  441date_month_days(10,_,31).
  442date_month_days(11,_,30).
  443date_month_days(12,_,31).
  444date_month_days(13,_,31).
  445
  446date_leap_year(Y) :-
  447   ( ( 0 =:= Y mod 100, 0 =:= Y mod 400 ) ;
  448     ( 0 =\= Y mod 100, 0 =:= Y mod 4 ) ).
  449
  450% one y2k method
  451
  452date_year_chk(YYYY, YYYY) :- YYYY > 1000, !.
  453date_year_chk(Y, YYYY) :-
  454   Y > 50, !,
  455   YYYY is Y + 1900.
  456date_year_chk(Y, YYYY) :-
  457   YYYY is Y + 2000.
  458
  459date_add_month_days(0, _, Days, Days) :-
  460   !.
  461date_add_month_days(M, Y, Acc, Days) :-
  462   date_month_days(M, Y, D),
  463   Acc2 is Acc + D,
  464   MM is M - 1,
  465   !, date_add_month_days(MM, Y, Acc2, Days).
  466
  467
  468%-----------------------------------------------------------
  469% is_date(+DATE)
  470%
  471% Succeeds if DATE is a date
  472%
  473
  474is_date(date(_,_,_)).
  475is_date(today).
  476
  477
  478%-----------------------------------------------------------
  479% is_date_interval(+INTERVAL)
  480%
  481% Succeeds if INTERVAL is a date interval
  482%
  483
  484is_date_interval(INTERVAL) :-
  485   INTERVAL =.. [UNITS, _],
  486   memberchk(UNITS, [days, weeks, months, years]).
  487is_date_interval(I1 + I2) :-
  488   is_date_interval(I1),
  489   is_date_interval(I2).
  490is_date_interval(I1 - I2) :-
  491   is_date_interval(I1),
  492   is_date_interval(I2).
  493is_date_interval(- I2) :-
  494   is_date_interval(I2).
  495
  496
  497%-----------------------------------------------------------
  498% is_date_expression(+DATE)
  499%
  500% Returns if the expression is a special date one.
  501%
  502
  503is_date_expression(date(_,_,_)).
  504is_date_expression(EXP) :-
  505   EXP =.. [UNITS, _],
  506   memberchk(UNITS, [days, weeks, months, years]).
  507
  508
  509%-----------------------------------------------------------
  510% time_get(+WHEN, -TIME)
  511%
  512% Returns the current time.
  513%
  514
  515time_get(now, time(H,M,S)) :-
  516   get_time(Stamp),
  517   stamp_date_time(Stamp, DateTime, local),
  518   date_time_value(hour, DateTime, H),
  519   date_time_value(minute, DateTime, M),
  520   date_time_value(second, DateTime, S).
  521
  522
  523%-----------------------------------------------------------
  524% time_compare(+TIME_1, ?OP, +TIME_2)
  525%
  526% Compares the two times, unifying the
  527% result with the comparison operator.
  528%
  529
  530time_compare(T1, =, T2) :- T1 = T2, !.
  531time_compare(T1, >, T2) :- T1 @> T2, !.
  532time_compare(T1, <, T2) :- T1 @< T2, !.
  533time_compare(T1, >=, T2) :- T1 @>= T2, !.
  534time_compare(T1, =<, T2) :- T1 @=< T2, !.
  535time_compare(T1, <=, T2) :- T1 @=< T2, !.
  536
  537
  538%-----------------------------------------------------------
  539% time_add(+TIME_1, +TIME_QUANTITIES, -TIME_2)
  540%
  541% Adds the TIME_QUANTITIES to TIME_1 and
  542% returns TIME_2.  Time quantities can be
  543% hours/1, mins/1 or secs/1.
  544%
  545
  546time_add(TIME, [], TIME) :-
  547   !.
  548time_add(T1, [TUNIT|TUNITS], TIME) :-
  549   !,
  550   time_add(T1, TUNIT, T2),
  551   time_add(T2, TUNITS, TIME).
  552time_add(now, ADD, TIME) :-
  553   !,
  554   time_get(now, T1),
  555   time_add(T1, ADD, TIME).
  556time_add(T1, -ADD, TIME) :-
  557   !,
  558   ADD =.. [UNIT, AMOUNT],
  559   MADD =.. [UNIT, -AMOUNT],
  560   time_add(T1, MADD, TIME).
  561time_add(time(H,M,S), secs(S1), time(HH,MM,SS)) :-
  562   !,
  563   S2 is S + S1,
  564   time_fix(time(H,M,S2), time(HH,MM,SS)).
  565time_add(time(H,M,S), mins(M1), time(HH,MM,SS)) :-
  566   !,
  567   M2 is M + M1,
  568   time_fix(time(H,M2,S), time(HH,MM,SS)).
  569time_add(time(H,M,S), hours(H1), time(HH,MM,SS)) :-
  570   H2 is H + H1,
  571   time_fix(time(H2,M,S), time(HH,MM,SS)).
  572
  573
  574%-----------------------------------------------------------
  575% time_difference(+TIME_1, +TIME_2, -TIME_QUANTITIES
  576%
  577% Subtracts two times, returning a list of time
  578% quantities representing the difference.
  579%
  580
  581time_difference(time(H1,M1,S1), time(H2,M2,S2),
  582      [hours(H), mins(M), secs(S)] ) :-
  583   H3 is H1 - H2,
  584   M3 is M1 - M2,
  585   S3 is S1 - S2,
  586   (S3 < 0 ->
  587      M4 is M3 - 1,
  588      S is S3 + 60
  589      ;
  590      M4 = M3,
  591      S = S3),
  592   (M4 < 0 ->
  593      M is M4 + 60,
  594      H is H3 - 1
  595      ;
  596      H = H3,
  597      M = M4).
  598
  599time_interval(time(H1,M1,_), time(H2,M2,_), mins(M)) :-
  600   !, M is 60*(H1-H2) + (M1-M2).
  601time_interval(time(H1,M1,S1), time(H2,M2,S2), secs(S)) :-
  602   !, S is 3600*(H1-H2) + 60*(M1-M2) + (S1-S2).
  603time_interval(time(H1,M1,_), time(H2,M2,_), hours(H)) :-
  604   !, H is (H1-H2) + (M1-M2)/60.
  605time_interval(datetime(Y,L,D,H1,M1,_), datetime(Y,L,D,H2,M2,_), mins(M)) :-
  606   !, M is 60*(H1-H2) + (M1-M2).
  607time_interval(datetime(Y,L,D,H1,M1,S1), datetime(Y,L,D,H2,M2,S2), secs(S)) :-
  608   !, S is 3600*(H1-H2) + 60*(M1-M2) + (S1-S2).
  609time_interval(datetime(Y,L,D,H1,M1,_), datetime(Y,L,D,H2,M2,_), hours(H)) :-
  610   !, H is (H1-H2) + (M1-M2)/60.
  611time_interval(datetime(Y1,L1,D1,H1,M1,_), datetime(Y2,L2,D2,H2,M2,_), mins(M)) :-
  612   !,
  613   date_interval(date(Y1,L1,D1), date(Y2,L2,D2), days(D)),
  614   M is 24*60*D + 60*(H1-H2) + (M1-M2).
  615time_interval(datetime(Y1,L1,D1,H1,M1,S1), datetime(Y2,L2,D2,H2,M2,S2), secs(S)) :-
  616   !,
  617   date_interval(date(Y1,L1,D1), date(Y2,L2,D2), days(D)),
  618   S is 24*60*60*D + 3600*(H1-H2) + 60*(M1-M2) + (S1-S2).
  619time_interval(datetime(Y1,L1,D1,H1,M1,_), datetime(Y2,L2,D2,H2,M2,_), hours(H)) :-
  620   !,
  621   date_interval(date(Y1,L1,D1), date(Y2,L2,D2), days(D)),
  622   H is 24*D + (H1-H2) + (M1-M2)/60.
  623
  624
  625%-----------------------------------------------------------
  626% Time internal predicates
  627%
  628
  629time_fix(time(H,M,S), time(HH,MM,SS)) :-
  630   H < 0,
  631   !,
  632   H2 is H + 24,
  633   time_fix(time(H2,M,S), time(HH,MM,SS)).
  634time_fix(time(H,M,S), time(HH,MM,SS)) :-
  635   H > 23,
  636   !,
  637   H2 is H - 24,
  638   time_fix(time(H2,M,S), time(HH,MM,SS)).
  639time_fix(time(H,M,S), time(HH,MM,SS)) :-
  640   M < 0,
  641   !,
  642   M2 is M + 60,
  643   H2 is H - 1,
  644   time_fix(time(H2,M2,S), time(HH,MM,SS)).
  645time_fix(time(H,M,S), time(HH,MM,SS)) :-
  646   M > 59,
  647   !,
  648   M2 is M - 60,
  649   H2 is H + 1,
  650   time_fix(time(H2,M2,S), time(HH,MM,SS)).
  651time_fix(time(H,M,S), time(HH,MM,SS)) :-
  652   S < 0,
  653   !,
  654   S2 is S + 60,
  655   M2 is M - 1,
  656   time_fix(time(H,M2,S2), time(HH,MM,SS)).
  657time_fix(time(H,M,S), time(HH,MM,SS)) :-
  658   S >= 60,
  659   !,
  660   S2 is S - 60,
  661   M2 is M + 1,
  662   time_fix(time(H,M2,S2), time(HH,MM,SS)).
  663time_fix(time(H,M,S), time(H,M,S)).
  664
  665
  666%-----------------------------------------------------------
  667% is_datetime(+DATETIME)
  668%
  669% Succeeds if DATETIME is a datetime
  670%
  671
  672is_datetime(datetime(_,_,_,_,_,_)).
  673
  674
  675%-----------------------------------------------------------
  676% is_datetime_interval(+INTERVAL)
  677%
  678% Succeeds if INTERVAL is a date or time interval
  679%
  680
  681is_datetime_interval(INTERVAL) :-
  682   INTERVAL =.. [UNITS, _],
  683   member(UNITS, [days, weeks, months, years, hours, mins, secs]).
  684is_datetime_interval(I1 + I2) :-
  685   is_datetime_interval(I1),
  686   is_datetime_interval(I2).
  687is_datetime_interval(I1 - I2) :-
  688   is_datetime_interval(I1),
  689   is_datetime_interval(I2).
  690is_datetime_interval(- I2) :-
  691   is_datetime_interval(I2).
  692
  693
  694%--------------------------------------------------------------
  695% datetime_get(+WHEN, -DATETIME)
  696%
  697% Returns the current date and time in a datetime/6
  698% structure.
  699%
  700
  701datetime_get(now, datetime(YEAR,MON,DAY,HOUR,MIN,SEC)) :-
  702   date_get(today, date(YEAR,MON,DAY)),
  703   time_get(now, time(HOUR,MIN,SEC)).
  704datetime_get(today, datetime(YEAR,MON,DAY,0,0,0)) :-
  705   date_get(today, date(YEAR,MON,DAY)).
  706
  707
  708%--------------------------------------------------------------
  709% datetime_compare(+DT_1, ?OP, +DT_2)
  710%
  711% Compares the datetime structures, DT_1 and
  712% DT_2 and unifies with the operator OP.
  713%
  714
  715datetime_compare(T1, =, T2) :- T1 = T2, !.
  716datetime_compare(T1, >, T2) :- T1 @> T2, !.
  717datetime_compare(T1, <, T2) :- T1 @< T2, !.
  718datetime_compare(T1, >=, T2) :- T1 @>= T2, !.
  719datetime_compare(T1, =<, T2) :- T1 @=< T2, !.
  720datetime_compare(T1, <=, T2) :- T1 @=< T2, !.
  721
  722
  723%--------------------------------------------------------------
  724% datetime_add(+DT_1, +DT_QUANTITIES, -DT_2)
  725%
  726% Adds the date and time quantities to datetime
  727% structure DT_1, returning the result in DT_2.
  728%
  729
  730datetime_add(DT, [], DT) :- !.
  731datetime_add(DT1, [DTUNIT|DTUNITS], DT) :-
  732   datetime_add(DT1, DTUNIT, DT2),
  733   !, datetime_add(DT2, DTUNITS, DT).
  734datetime_add(now, ADD, TIME) :-
  735   datetime_get(now, T1),
  736   datetime_add(T1, ADD, TIME).
  737datetime_add(today, ADD, TIME) :-
  738   datetime_get(today, T1),
  739   datetime_add(T1, ADD, TIME).
  740datetime_add(T1, -ADD, TIME) :-
  741   ADD =.. [UNIT, AMOUNT],
  742   MADD =.. [UNIT, -AMOUNT],
  743   datetime_add(T1, MADD, TIME).
  744datetime_add(datetime(Y,L,D,H,M,S), years(Y1), datetime(YY,LL,DD,HH,MM,SS)) :-
  745   Y2 is Y + Y1,
  746   datetime_fix(datetime(Y2,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)).
  747datetime_add(datetime(Y,L,D,H,M,S), months(L1), datetime(YY,LL,DD,HH,MM,SS)) :-
  748   L2 is L + L1,
  749   datetime_fix(datetime(Y,L2,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)).
  750datetime_add(datetime(Y,L,D,H,M,S), days(D1), datetime(YY,LL,DD,HH,MM,SS)) :-
  751   D2 is D + D1,
  752   datetime_fix(datetime(Y,L,D2,H,M,S), datetime(YY,LL,DD,HH,MM,SS)).
  753datetime_add(datetime(Y,L,D,H,M,S), hours(H1), datetime(YY,LL,DD,HH,MM,SS)) :-
  754   H2 is H + H1,
  755   datetime_fix(datetime(Y,L,D,H2,M,S), datetime(YY,LL,DD,HH,MM,SS)).
  756datetime_add(datetime(Y,L,D,H,M,S), mins(M1), datetime(YY,LL,DD,HH,MM,SS)) :-
  757   M2 is M + M1,
  758   datetime_fix(datetime(Y,L,D,H,M2,S), datetime(YY,LL,DD,HH,MM,SS)).
  759datetime_add(datetime(Y,L,D,H,M,S), secs(S1), datetime(YY,LL,DD,HH,MM,SS)) :-
  760   S2 is S + S1,
  761   datetime_fix(datetime(Y,L,D,H,M,S2), datetime(YY,LL,DD,HH,MM,SS)).
  762
  763
  764%--------------------------------------------------------------
  765% datetime_difference(+DT_1, +DT_2, -DT_QUANTITIES)
  766%
  767% Subtracts two datetime structures, returning the
  768% datetime quantities.
  769%
  770
  771datetime_difference(datetime(Y1,L1,D1,H1,M1,S1), datetime(Y2,L2,D2,H2,M2,S2),
  772      [years(Y), months(L), days(D), hours(H), mins(M), secs(S)] ) :-
  773   date_difference(date(Y1,L1,D1), date(Y2,L2,D2), [years(Y), months(L), days(D)]),
  774   time_difference(time(H1,M1,S1), time(H2,M2,S2), [hours(H), mins(M), secs(S)]).
  775
  776
  777%--------------------------------------------------------------
  778% datetime_date_time(?DT, ?DATE, ?TIME)
  779%
  780% convert between datetime and date and time structures.
  781%
  782
  783datetime_date_time(datetime(YR,MO,DA,HR,MI,SE), date(YR,MO,DA), time(HR,MI,SE)).
  784
  785
  786%-----------------------------------------------------------
  787% datetime_extract(+DATETIME, -VALUE)
  788%
  789% Gets the VALUE of the year, month or day, as
  790% specified in the TYPE argument, from an input
  791% DATE structure.
  792%
  793
  794datetime_extract(datetime(Y,_,_,_,_,_), years(Y)).
  795datetime_extract(datetime(_,M,_,_,_,_), months(M)).
  796datetime_extract(datetime(_,_,D,_,_,_), days(D)).
  797datetime_extract(datetime(_,_,_,H,_,_), hours(H)).
  798datetime_extract(datetime(_,_,_,_,M,_), mins(M)).
  799datetime_extract(datetime(_,_,_,_,_,S), secs(S)).
  800
  801
  802%--------------------------------------------------------------
  803% Internal predicates used in datetime calculations.
  804%
  805
  806datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)) :-
  807   H < 0,
  808   !,
  809   H2 is H + 24,
  810   D2 is D - 1,
  811   datetime_fix(datetime(Y,L,D2,H2,M,S), datetime(YY,LL,DD,HH,MM,SS)).
  812datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)) :-
  813   H > 23,
  814   !,
  815   H2 is H - 24,
  816   D2 is D + 1,
  817   datetime_fix(datetime(Y,L,D2,H2,M,S), datetime(YY,LL,DD,HH,MM,SS)).
  818datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)) :-
  819   M < 0,
  820   !,
  821   M2 is M + 60,
  822   H2 is H - 1,
  823   datetime_fix(datetime(Y,L,D,H2,M2,S), datetime(YY,LL,DD,HH,MM,SS)).
  824datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)) :-
  825   M > 59,
  826   !,
  827   M2 is M - 60,
  828   H2 is H + 1,
  829   datetime_fix(datetime(Y,L,D,H2,M2,S), datetime(YY,LL,DD,HH,MM,SS)).
  830datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)) :-
  831   S < 0,
  832   !,
  833   S2 is S + 60,
  834   M2 is M - 1,
  835   datetime_fix(datetime(Y,L,D,H,M2,S2), datetime(YY,LL,DD,HH,MM,SS)).
  836datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,HH,MM,SS)) :-
  837   S > 59,
  838   !,
  839   S2 is S - 60,
  840   M2 is M + 1,
  841   datetime_fix(datetime(Y,L,D,H,M2,S2), datetime(YY,LL,DD,HH,MM,SS)).
  842datetime_fix(datetime(Y,L,D,H,M,S), datetime(YY,LL,DD,H,M,S)) :-
  843   date_fix(date(Y,L,D), date(YY,LL,DD)).
  844
  845
  846%--------------------------------------------------
  847% date_string(?DATE, ?FORMAT, ?STRING)
  848%
  849% Convert between a date structure and a string,
  850% optionally based on a specified format atom.
  851% See ds_date below for the accepted formats for
  852% dates.
  853%
  854% ?- date_string(D, F, `24 Feb 1946`).
  855% D = date(1946, 2, 24)
  856% F = 'd mon y'
  857% yes
  858%
  859% ?- date_string(D, F, `February 24, 1946`).
  860% D = date(1946, 2, 24)
  861% F = 'month d, y'
  862% yes
  863%
  864% ?- date_string(date(1946,2,24), 'month d, y', X).
  865% X = `February 24, 1946`
  866% yes
  867%
  868% ?- date_string(D, 'd/m/y', `24/2/1946`).
  869% D = date(1946, 2, 24)
  870% yes
  871%
  872% ?- date_string(date(1946,2,24), F, X).
  873% F = 'y/m/d'
  874% X = `1946/2/24`
  875% yes
  876%
  877
  878date_string(DATE, FORMAT, STRING) :-
  879   nonvar(STRING), !,
  880   string_to_list(STRING, LIST),
  881   ds_date(DATE, FORMAT, LIST, []),
  882   !.
  883date_string(DATE, FORMAT, STRING) :-
  884   ds_date(DATE, FORMAT, LIST, []),
  885   !,
  886   string_to_list(STRING, LIST).
  887
  888ds_date(date(Y,M,D), 'y/m/d') -->
  889   ds_year(Y), sp, "/", sp, ds_month(M), sp, "/", sp, ds_day(D), !.
  890ds_date(date(Y,M,D), 'm/d/y') -->
  891   ds_month(M), sp, "/", sp, ds_day(D), sp, "/", sp, ds_year(Y), !.
  892ds_date(date(Y,M,D), 'mm/dd/yyyy') -->
  893   ds_month2(M), sp, "/", sp, ds_day2(D), sp, "/", sp, ds_year(Y), !.
  894ds_date(date(Y,M,D), 'd/m/y') -->
  895   ds_day(D), sp, "/", sp, ds_month(M), sp, "/", sp, ds_year(Y), !.
  896ds_date(date(Y,M,D), 'y-m-d') -->
  897   ds_year(Y), sp, "-", sp, ds_month(M), sp, "-", sp, ds_day(D), !.
  898ds_date(date(Y,M,D), 'm-d-y') -->
  899   ds_month(M), sp, "-", sp, ds_day(D), sp, "-", sp, ds_year(Y), !.
  900ds_date(date(Y,M,D), 'd-m-y') -->
  901   ds_day(D), sp, "-", sp, ds_month(M), sp, "-", sp, ds_year(Y), !.
  902ds_date(date(Y,M,D), 'd mon y') -->
  903   ds_day(D), " ", sp, ds_short_month(M), " ", sp, ds_year(Y), !.
  904ds_date(date(Y,M,D), 'month d, y') -->
  905   ds_long_month(M), " ", sp, ds_day(D), ", ", sp, ds_year(Y), !.
  906ds_date(date(Y,M,D), 'mon d y') -->
  907   ds_short_month(M), " ", sp, ds_day(D), " ", sp, ds_year(Y), !.
  908ds_date(date(Y,M,D), 'month d y') -->
  909   ds_long_month(M), " ", sp, ds_day(D), " ", sp, ds_year(Y), !.
  910
  911
  912%--------------------------------------------------
  913% time_string(?TIME, ?STRING)
  914%
  915% Convert between time structures and strings of the
  916% form hh:mm:ss.
  917%
  918% ?- time_string(time(2,33,15), X).
  919% X = `2:33:15`
  920% yes
  921%
  922% ?- time_string(T, `2:33:22`).
  923% T = time(2, 33, 22)
  924% yes
  925%
  926
  927time_string(TIME, STRING) :-
  928   nonvar(STRING), !,
  929   string_to_list(STRING, LIST),
  930   ds_time(TIME, LIST, []),
  931   !.
  932time_string(TIME, STRING) :-
  933   ds_time(TIME, LIST, []),
  934   !,
  935   string_to_list(STRING, LIST).
  936
  937
  938%--------------------------------------------------
  939% datetime_string(?DATE, ?FORMAT, ?STRING)
  940%
  941% Convert between a date structure and a string,
  942% optionally based on a specified format atom.
  943% See date_string and time_string for details.
  944%
  945
  946datetime_string(DT, FORMAT, STRING) :-
  947   nonvar(STRING), !,
  948   string_to_list(STRING, LIST),
  949   ds_datetime(DT, FORMAT, LIST, []),
  950   !.
  951datetime_string(DT, FORMAT, STRING) :-
  952   ds_datetime(DT, FORMAT, LIST, []),
  953   !,
  954   string_to_list(STRING, LIST).
  955
  956ds_datetime(datetime(YR,DY,MO,HR,MI,SE), FORMAT) -->
  957   ds_date(date(YR,DY,MO), FORMAT),
  958   " ",
  959   sp,
  960   ds_time(time(HR,MI,SE)).
  961
  962
  963%--------------------------------------------------
  964% Supporting predicates for string conversions
  965%
  966
  967ds_time(time(H,M,S)) -->
  968   ds_hour(H), sp, ":", sp, ds_min(M), sp, ":", sp, ds_sec(S).
  969
  970ds_year(YY) --> { var(YY), ! }, ds_integer(Y), { date_year_chk(Y, YY) }.
  971ds_year(Y) --> { date_year_chk(Y, YY) }, ds_integer(YY).
  972ds_month(M) --> ds_integer(M).
  973ds_day(D) --> ds_integer(D).
  974
  975ds_hour(H) --> ds_integer(H).
  976ds_min(M) --> ds_integer(M).
  977ds_sec(S) -->
  978   { var(S) }, !,
  979   ds_float(F),
  980   { S is floor(F) }.
  981ds_sec(S) -->
  982   { D is floor(S) },
  983   ds_integer(D).
  984
  985ds_month2(MM) --> ds_integer2(MM).
  986ds_day2(DD) --> ds_integer2(DD).
  987
  988ds_integer(N) -->
  989   { var(N) }, !,
  990   ds_digits(D),
  991   { string_to_list(S, D), number_string(N, S)}.
  992ds_integer(N) -->
  993   { number_string(N, S), string_to_list(S, D) },
  994   ds_digits(D).
  995
  996ds_float(N) -->
  997   { var(N) }, !,
  998   ds_digits(D),
  999   (  [0'.],
 1000      ds_digits(F)
 1001   -> {  append(D, [0'.|F], L),
 1002         string_to_list(S, L),
 1003         number_string(N, S) }
 1004   ;  {  string_to_list(S, D),
 1005         number_string(N, S)}
 1006   ).
 1007ds_float(N) -->
 1008   { number_string(N, S), string_to_list(S, L) },
 1009   (  { append(D, [0'.|F], L) }
 1010   -> ds_digits(D),
 1011      [0'.],
 1012      ds_digits(F)
 1013   ;  ds_digits(L)
 1014   ).
 1015
 1016ds_digits([X|Y]) --> [X], {ds_digit(X)}, ds_digits(Y).
 1017ds_digits([X]) --> [X], {ds_digit(X)}.
 1018
 1019ds_integer2(N) -->
 1020   { var(N) }, !,
 1021   ds_digits(D),
 1022   { string_to_list(S, D), number_string(N, S)}.
 1023ds_integer2(N) -->
 1024   { number_string(N, S), string_to_list(S, D) },
 1025   ds_digits2(D).
 1026
 1027ds_digits2([N]) --> [0'0, N], {ds_digit(N)}.
 1028ds_digits2([A,B]) --> [A,B], {ds_digit(A), ds_digit(B)}.
 1029
 1030ds_digit(X) :- number(X), X >= 0'0, X =< 0'9.
 1031
 1032sp --> "".
 1033sp --> [W], { number(W), W =< 32 }, sp.
 1034
 1035ds_short_month(1) --> "Jan".
 1036ds_short_month(2) --> "Feb".
 1037ds_short_month(3) --> "Mar".
 1038ds_short_month(4) --> "Apr".
 1039ds_short_month(5) --> "May".
 1040ds_short_month(6) --> "Jun".
 1041ds_short_month(7) --> "Jul".
 1042ds_short_month(8) --> "Aug".
 1043ds_short_month(9) --> "Sep".
 1044ds_short_month(10) --> "Oct".
 1045ds_short_month(11) --> "Nov".
 1046ds_short_month(12) --> "Dec".
 1047
 1048ds_long_month(1) --> "January".
 1049ds_long_month(2) --> "February".
 1050ds_long_month(3) --> "March".
 1051ds_long_month(4) --> "April".
 1052ds_long_month(5) --> "May".
 1053ds_long_month(6) --> "June".
 1054ds_long_month(7) --> "July".
 1055ds_long_month(8) --> "August".
 1056ds_long_month(9) --> "September".
 1057ds_long_month(10) --> "October".
 1058ds_long_month(11) --> "November".
 1059ds_long_month(12) --> "December".
 1060
 1061
 1062%---------------------------------------------
 1063% week_day(DT, WD)
 1064%
 1065% Return the day of the week for a date or date time
 1066%
 1067
 1068week_day(date(Y,M,D), WD) :-
 1069   date_1900_days(date(Y,M,D), N),
 1070   DN is N mod 7,
 1071   day_name(DN, WD),
 1072   !.
 1073week_day(datetime(Y,M,D,_,_,_), WD) :-
 1074   date_1900_days(date(Y,M,D), N),
 1075   DN is N mod 7,
 1076   day_name(DN, WD),
 1077   !.
 1078
 1079week_dayn(date(Y,M,D), DN) :-
 1080   date_1900_days(date(Y,M,D), N),
 1081   DN is N mod 7,
 1082   !.
 1083week_dayn(datetime(Y,M,D,_,_,_), DN) :-
 1084   date_1900_days(date(Y,M,D), N),
 1085   DN is N mod 7,
 1086   !.
 1087
 1088day_name(0, 'Monday').
 1089day_name(1, 'Tuesday').
 1090day_name(2, 'Wednesday').
 1091day_name(3, 'Thursday').
 1092day_name(4, 'Friday').
 1093day_name(5, 'Saturday').
 1094day_name(6, 'Sunday')