1:- module(julian, [ compare_time/3
    2                  , date/1
    3                  , datetime/1
    4                  , datetime/3
    5                  , delta_time/3
    6                  , findall_dates/2
    7                  , form_time/2
    8                  , form_time/1
    9                  ]).   10:- use_module(library(julian/calendar/gregorian), [gregorian/3, month_number/2]).   11:- use_module(library(julian/util), [dow_number/2]).   12
   13:- use_module(library(clpfd)).   14:- use_module(library(error), []).   15:- use_module(library(typedef)).   16:- use_module(library(when), [when/2]).   17:- use_module(library(dcg/basics), [float//1, integer//1, string//1]).   18:- use_module(library(list_util), [xfy_list/3]).   19:- use_module(library(delay), [delay/1]).   20
   21% many clpfd constraints trigger this warning.
   22% disable it for now.
   23:- style_check(-no_effect).   24
   25% define types
   26:- multifile error:has_type/2.   27error:has_type(datetime, Dt) :-
   28    datetime(Dt).
   29:- type duration ---> days(integer)
   30                    ; s(integer)
   31                    ; ms(integer)
   32                    ; ns(integer)
   33                    .
   34
   35
   36% This module represents times, dates and sets of those using
   37% terms of the form =|datetime(MJD, Nano)|=.  =MJD= is an
   38% integer representing the modified Julian day.  =Nano= is an
   39% integer representing the number of nanoseconds since midnight
   40% on that day.
   41%
   42% We indicate a date without time by leaving =Nano= as an
   43% unbound variable.  We indicate times without a date by
   44% leaving =MJD= unbound.  Arbitrary datetime sets are represented
   45% by using library(clpfd) constraints on =MJD= and =Nano=.
   46%
   47% This representation should make it very easy to implement
   48% datetime arithmetic predicates, although I've not yet done
   49% that below.
   50
   51
   52%%	mjd(?MJD:integer) is semidet.
   53%
   54%	True if MJD is a valid modified Julian day number.
   55mjd(MJD) :-
   56    MJD in -2400328 .. 514671.
   57
   58%%	nano(?Nano:integer) is semidet.
   59%
   60%	True if Nano is a valid number of nanoseconds since midnight.
   61nano(Nano) :-
   62    Nano in 0 .. 86_399_999_999_999.
 datetime(?Datetime:datetime, ?MJD:positive_integer, ?Nano:positive_integer) is semidet
True if Datetime falls on modified Julian day MJD and occurs Nano nanoseconds after midnight.
   69datetime(datetime(MJD, Nano), MJD, Nano) :-
   70    mjd(MJD),
   71    nano(Nano).
 datetime(?Datetime) is semidet
True if Datetime is a datetime term.
   76datetime(Dt) :-
   77    datetime(Dt, _, _).
 form_time(?Form, ?Datetime:datetime)
True if Datetime can be described by Form. Form is a sugary representation of a set of datetimes. This predicate is the workhorse for converting between datetime values and other date representations. It's also the workhorse for further constraining a datetime value.

Here are some acceptable values of Form.

This predicate is multifile because other modules can support different calendars, different holiday schedules, extra sugar, etc.

  126:- multifile form_time/2.  127form_time(Var, _) :-
  128    var(Var),
  129    !,
  130    throw('form_time/2 doesn''t yet support a variable first argument').
  131form_time([], Dt) :-
  132    datetime(Dt).
  133form_time([H|T], Dt) :-
  134    form_time(H, Dt),
  135    form_time(T, Dt).
  136form_time(true, Dt) :-
  137    datetime(Dt).
  138form_time(today, Dt) :-
  139    get_time(Now),
  140    stamp_date_time(Now, date(Year, Month, Day, _,_,_,_,_,_), local),
  141    form_time(gregorian(Year,Month,Day), Dt).
  142form_time(now, Dt) :-
  143    get_time(Now),
  144    form_time(unix(Now), Dt).
  145form_time(dow(Days), Dt) :-
  146    ground(Days),
  147    maplist(dow_number, Days, DayNumbers),
  148    datetime(Dt, MJD, _),
  149    !,
  150    % compile DayNumbers into clpfd domain constraint
  151    xfy_list(\/, Domain, DayNumbers),
  152    DayNumber in Domain,
  153    (MJD+2) mod 7 #= DayNumber.
  154form_time(weekday, Dt) :-
  155    datetime(Dt,MJD,_),
  156    DayNumber in 0..4,
  157    (MJD+2) mod 7 #= DayNumber.
  158form_time(dow(DayOfWeek), datetime(MJD, _)) :-
  159    (MJD+2) mod 7 #= DayNumber,
  160    delay(dow_number(DayOfWeek, DayNumber)),
  161    !.
  162form_time(month(Months), Dt) :-
  163    ground(Months),
  164    datetime(Dt),
  165    maplist(month_number, Months, MonthNumbers),
  166    !,
  167    % compile MonthNumbers into clpfd domain constraint
  168    xfy_list(\/, Domain, MonthNumbers),
  169    MonthNumber in Domain,
  170    form_time(gregorian(_,MonthNumber,_), Dt).
  171form_time(month(Month), Dt) :-
  172    delay(month_number(Month, Number)),
  173    form_time(gregorian(_,Number,_), Dt).
  174form_time(Year-Month-Day, Dt) :-
  175    !,
  176    form_time(gregorian(Year,Month,Day), Dt).
  177form_time(gregorian(Year, Month, Day), Dt) :-
  178    gregorian(Year, Month, Day),
  179    datetime(Dt, MJD, _Nano),
  180    E #= 4 * ((194800*MJD+467785976025)//194796) + 3,
  181    H #= mod(E, 1461)//4*5 + 2,
  182    Day #= mod(H, 153)//5 + 1,
  183    Month #= mod(H//153+2, 12) + 1,
  184    Year #= E//1461 + (14 - Month)//12 - 4716,
  185
  186    % help clpfd in cases we know can be resolved better
  187    ( ground(Year), ground(Month), ground(Day), var(MJD) ->
  188        labeling([leftmost, up, bisect], [MJD])
  189    ; true ->
  190        when(ground(Year), ignore(contract_mjd(Year,Month,MJD)))
  191    ).
  192form_time(Hours:Minutes:FloatSeconds, datetime(_, Nanos)) :-
  193    Second = 1_000_000_000,
  194    seconds_nanos(FloatSeconds, N),
  195    Hours   in 0 .. 23,
  196    Minutes in 0 .. 59,
  197    N       in 0 .. 59_999_999_999,
  198    Nanos #= Hours*60*60*Second + Minutes*60*Second + N.
  199form_time(midnight, Dt) :-
  200    form_time(00:00:00, Dt).
  201form_time(noon, Dt) :-
  202    form_time(12:00:00, Dt).
  203form_time(final_moment, Dt) :-
  204    datetime(Dt, _, 86_399_999_999_999).
  205form_time(unix(UnixEpochSeconds), datetime(Days, Nanos)) :-
  206    DayInNanos = 86_400_000_000_000,
  207    seconds_nanos(UnixEpochSeconds, N),
  208    ExtraDays #= N // DayInNanos,
  209    ExtraNanos #= N rem DayInNanos,
  210
  211    % form_time([1970-01-01,00:00:00], datetime(40587,0))
  212    Days #= 40587 + ExtraDays,
  213    Nanos #= 0 + ExtraNanos.
  214form_time(mjn(Mjn), Dt) :-
  215    datetime(Dt, Mjd, Nano),
  216    DayInNanos = 86_400_000_000_000,
  217    Mjn #= Mjd*DayInNanos + Nano.
  218form_time(future, Dt) :-
  219    form_time(after(now), Dt).
  220form_time(past, Dt) :-
  221    form_time(before(now), Dt).
  222form_time(after(Form), Dt) :-
  223    form_time(Form, Threshold),
  224    compare_time(>,Dt,Threshold).
  225form_time(before(Form), Dt) :-
  226    form_time(Form, Threshold),
  227    compare_time(<,Dt,Threshold).
  228form_time(nth(Ns0,Form), Dt) :-
  229    nonvar(Form),
  230    datetime(Dt),
  231    ( Form = dow(Dow), integer(Ns0) ->
  232        nth_dow(Dt,Dow,Ns0)
  233    ; % general case ->
  234        nth_generic(Dt, Form, Ns0)
  235    ).
  236form_time(datetime(Mjd,Nano), datetime(Mjd,Nano)).
  237form_time(rfc3339(Text0), Dt) :-
  238    ( ground(Text0) ->
  239        ( is_list(Text0) -> string_codes(Text,Text0); Text=Text0 ),
  240        parse_time(Text,iso_8601,Epoch),
  241        form_time(unix(Epoch),Dt)
  242    ; ground(Dt) ->
  243        form_time(unix(Epoch),Dt),
  244        stamp_date_time(Epoch,DateTime,'UTC'),
  245        Frac is Epoch - floor(Epoch),  % are there fractional seconds
  246        ( Frac > 0 -> Format="%FT%T.%6f"; Format="%FT%T" ),
  247        format_time(codes(Text0),Format,DateTime)
  248    ; true ->
  249        when(ground(Text0);ground(Dt), form_time(rfc3339(Text0),Dt))
  250    ).
  251
  252
  253% handle general case of nth/2 form
  254nth_generic(Dt,Form,Ns0) :-
  255    form_time(Year-Month-_, Dt),
  256    form_time([Year-Month-_, Form], X),
  257    findall_dates(X, Dates),
  258    ( is_list(Ns0) -> Ns=Ns0 ; Ns=[Ns0] ),
  259    member(N0, Ns),
  260    ( N0 > 0 -> N is N0-1 ; N=N0 ),
  261    circular_nth0(N, Dates, Dt).
  262
  263% optimization of nth/2 for dow/1 second argument
  264nth_dow(Dt,Dow,N) :-
  265    % constrain to the proper day of the week
  266    form_time(dow(Dow), Dt),
  267
  268    % constrain day to the proper place within the month
  269    Day1 in 1..7,    Day - (N-1)*7 #= Day1,    form_time(_-_-Day, Dt),    % help clpfd recognize opportunities to contract    datetime(Dt, MJD, _),    clpfd:contracting([MJD]).
 form_time(+Form) is semidet
True if a date exists which satisfies Form. For example, "is May 1, 1979 a Tuesday?" would be 
form_time([1979-05-01,dow(tuesday)])
  284form_time(Form) :-
  285    form_time(Form, _).
  286
  287
  288% Gregorian date calculations use large numbers and many mod/2
  289% constraints. That combination makes it inefficient for clpfd to
  290% propagate constraints perfectly. We could call clpfd:contracting/1
  291% to contract MJD's domain, but that's relatively slow. Fortunately,
  292% these problems only seem to arise in cases like Note_compare. When the
  293% Year is known, we have a very efficient way of finding the lower and
  294% upper bound for MJD. The lower is January 1st. The upper is December
  295% 31st.
  296% Fails if this optimization doesn't apply.
  297contract_mjd(Year,Month,MJD) :-
  298    ground(Year),
  299    var(Month),  % no point in optimization if ground(Month)
  300    form_time(gregorian(Year,1,1), datetime(MinMJD,_)),
  301    form_time(gregorian(Year,12,31), datetime(MaxMJD,_)),
  302    MJD in MinMJD..MaxMJD.
  303
  304
  305% TODO factor this out to list_util and use delay:length/2 and
  306% delay:plus/3 to implement it.
  307circular_nth0(Index, List, Element) :-
  308    Index >= 0,
  309    !,
  310    nth0(Index, List, Element).
  311circular_nth0(Index0, List, Element) :-
  312    length(List, Len),
  313    plus(Index0, Len, Index),
  314    nth0(Index, List, Element).
 findall_dates(+Dt:datetime, -Dts:list)
True if Dts is all individual days in the set Dt. Dts is in order from oldest to most recent.
  320findall_dates(Dt, Dts) :-
  321    findall(Dt, date(Dt), Dts).
 date(?Dt:datetime) is nondet
Assign a single date based on the constraints of Dt. This can be used to iterate all values of Dt.
  327date(Dt) :-
  328    datetime(Dt, MJD, _),
  329    labeling([leftmost,up,bisect], [MJD]).
 seconds_nanos(?Seconds:float, ?Nanos:integer) is semidet
True if Seconds is a floating point representation of Nanos nanoseconds.
  336seconds_nanos(Seconds, Nanos) :-
  337    when( (   ground(Seconds)
  338          ;   ground(Nanos)
  339          )
  340        , seconds_nanos_(Seconds, Nanos)
  341        ).
  342seconds_nanos_(Seconds, Nanos) :-
  343    number(Seconds),
  344    !,
  345    Nanos is floor(Seconds * 1_000_000_000).
  346seconds_nanos_(Seconds, Nanos) :-
  347    integer(Nanos),
  348    Seconds is Nanos / 1_000_000_000.
 compare_time(+Order, ?A:datetime, ?B:datetime) is semidet
compare_time(-Order, ?A:datetime, ?B:datetime) is nondet
True if the chronological relation between A and B is described by Order. None of the arguments needs to be bound. When Order is not bound, compare_time/3 iterates all possible values of Order on backtracking. In other words, the relation is not stored as contraints on Order.

A and B can be given as datetime values or forms. For example, this is a legitimate goal:

compare_time(Order, now, unix(1375475330.414)).
  363compare_time(Order, A0, B0) :-
  364    ( var(A0) -> A=A0 ; form_time(A0, A) ),
  365    ( var(B0) -> B=B0 ; form_time(B0, B) ),
  366    compare_time_(Order, A, B).
  367compare_time_(Order, A, B) :-
  368    form_time(mjn(MjnA), A),
  369    form_time(mjn(MjnB), B),
  370    zcompare(Order, MjnA, MjnB),
  371
  372    % See Note_compare
  373    ( var(Order) ->
  374        findall(Order,member(Order,[<,=,>]), Orders),
  375        member(Order, Orders)
  376    ; % otherwise ->
  377        true
  378    ).
  379
  380/* Note_compare:
  381
  382Using zcompare/3 with modified Julian nanoseconds is the purest way to decribe
  383the relationship between two times and an order.  In most circumstances, it
  384works exactly as expected.  However, in some common cases like
  385
  386    form_time([2000-02-29], A),
  387    form_time([1999-_-_], B),
  388    compare(Order, A, B).
  389
  390zcompare/3 fails to notice that A must always be greater than B.  Fortunately,
  391if we ask zcompare/3 "is it less? is it equal? is it greater?" it always
  392answers correctly.  If that series of questions gets a single answer, we want
  393to pretend that zcompare/3 found it by itself without leaving any extra
  394choicepoints.  If there are multiple right answers, we want a choicepoint
  395for each one.  The `findall(...),member(...)` construct behaves like that.
  396
  397*/
 delta_time(?A:datetime, ?Delta:duration, ?B:datetime)
True if datetime A plus duration Delta equals datetime B. Delta is a compound term representing a duration in various convenient forms. Acceptable forms are: 
  410delta_time(A0, Delta, B0) :-
  411    ( var(A0) -> A=A0 ; form_time(A0, A) ),
  412    ( var(B0) -> B=B0 ; form_time(B0, B) ),
  413    delta_time_(A, Delta, B).
  414
  415delta_time_(A,days(Days),B) :-
  416    datetime(A, MjdA, _),
  417    datetime(B, MjdB, _),
  418    Days #= MjdB - MjdA,
  419    !.
  420delta_time_(A,ns(Nanos),B) :-
  421    form_time(mjn(MjnA), A),
  422    form_time(mjn(MjnB), B),
  423    Nanos #= MjnB - MjnA,
  424    !.
  425delta_time_(A,ms(Millis),B) :-
  426    Millis #= Nanos // 1_000_000,
  427    delta_time_(A,ns(Nanos),B),
  428    once(label([Nanos])),  % decide rounding ambiguity
  429    !.
  430delta_time_(A,s(Seconds),B) :-
  431    Seconds