1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  2023, SWI-Prolog Solutions b.v.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(prolog_versions,
   36          [ require_prolog_version/2,   % +Required, +Features:list
   37            require_version/3,          % +Component, +Available, +Required
   38            cmp_versions/3              % ?Cmp, +Version1, +Version2
   39          ]).   40:- autoload(library(apply), [maplist/2, maplist/3]).   41:- autoload(library(error), [domain_error/2, existence_error/2, type_error/2]).   42
   43/** <module> Demand specific (Prolog) versions
   44
   45This library is provided to make  it   easier  to  reason about software
   46versions, in particular require that that   hosting  Prolog system is of
   47the right version and provides the features   required by the library or
   48application.
   49
   50@tbd Not only provide a minimal version but a more version ranges,
   51     exclude certain versions, etc.
   52@tbd More features and better messages to help the user resolving
   53     problems.
   54*/
   55
   56%!  require_prolog_version(+Required, +Features:list) is det.
   57%
   58%   Claim that the running Prolog version   is at least version Required
   59%   and provides the requested Features. Required   is  an expression of
   60%   versions. At the lowest level, a version   is an atom or string that
   61%   provides the version as
   62%
   63%	Major.Minor[[.Patch][[-GitRev],-GitHash]]]
   64%
   65%   Example     strings     are     '8.5',      '8.5.0',     '8.5.0-50',
   66%   '8.5.0-69-gad38e8ad8`. The last two  require   fetching  the sources
   67%   from git or using the Windows daily builds.
   68%
   69%   Versions may be embedded in a   comparison operator (`<`, `=<`, `=`,
   70%   `>=` or `>`), e.g., `=<('9.1')`. Versions  are considered to compare
   71%   equal only on the components of  the Required version. I.e., `'9.1'`
   72%   compares equal to `'9.1.2'`.
   73%
   74%   Version expressions can be  constructed   from  the Prolog operators
   75%   ','/2, ';'/2 and '\+'/1. An example   of a complicated expression is
   76%   below, which demands major  version  9,   but  considers  9.1.2  not
   77%   suitable.
   78%
   79%       (>=('9'), \+(=('9.1.2')))
   80%
   81%   Features is a list of  required   or  preferred features. Individual
   82%   features are:
   83%
   84%     - warning(Feature)
   85%       Only print a warning instead of throwing an error.
   86%     - library(Lib)
   87%       Demand library(Lib) to be present.  The library not being
   88%       there may indicate an incomplete installation.  For example,
   89%       library(pce) to demand xpce graphics support.
   90%     - Flag
   91%       Demand current_prolog_flag(Flag, true) to be true.
   92%     - FlagValue
   93%       If FlagValue is Flag(Value), demand current_prolog_flag(Flag,
   94%       Value) to be true.
   95%
   96%    @error version_error('SWI-Prolog', PrologVersion, Cmp, Required)
   97%    @error existence_error(prolog_feature, Feature)
   98
   99require_prolog_version(Required, Features) :-
  100    require_prolog_version(Required),
  101    maplist(check_feature, Features).
  102
  103require_prolog_version(Required) :-
  104    prolog_version(Available),
  105    require_version('SWI-Prolog', Available, Required).
  106
  107prolog_version(Version) :-
  108    current_prolog_flag(version_git, Version),
  109    !.
  110prolog_version(Version) :-
  111    current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
  112    VNumbers = [Major, Minor, Patch],
  113    atomic_list_concat(VNumbers, '.', Version).
  114
  115%!  require_version(+Component, +Available, +CmpRequired) is det.
  116%
  117%   Require Component to have version   CmpRequired,  while Component is
  118%   know to have version Available.
  119%
  120%   @error version_error(Component, Required, Cmp, Available)
  121
  122require_version(Component, Available, CmpRequired) :-
  123    parse_version(Available, AvlNumbers, AvlGit),
  124    (   require_version_(AvlNumbers, AvlGit, CmpRequired)
  125    ->  true
  126    ;   throw(error(version_error(Component, Available, CmpRequired), _))
  127    ).
  128
  129require_version_(AvlNumbers, AvlGit, (V1;V2)) =>
  130    (   require_version_(AvlNumbers, AvlGit, V1)
  131    ->  true
  132    ;   require_version_(AvlNumbers, AvlGit, V2)
  133    ).
  134require_version_(AvlNumbers, AvlGit, (V1,V2)) =>
  135    (   require_version_(AvlNumbers, AvlGit, V1)
  136    ;   require_version_(AvlNumbers, AvlGit, V2)
  137    ).
  138require_version_(AvlNumbers, AvlGit, \+V1) =>
  139    \+ require_version_(AvlNumbers, AvlGit, V1).
  140require_version_(AvlNumbers, AvlGit, Required) =>
  141    parse_version(Required,  ReqNumbers, ReqGit, Cmp, _),
  142    cmp_versions(Cmp, AvlNumbers, AvlGit, ReqNumbers, ReqGit).
  143
  144%!  cmp_versions(?Cmp, +V1, +V2) is semidet.
  145%
  146%   Compare to versions. Cmp is one of `<`,   `=<`, `=`, `>=` or `>`. If
  147%   Cmp is unbound we check whether `<` or  `>` hold or else bind Cmp to
  148%   `=`.
  149%
  150%   When comparing for equality (`=`), the versions are considered equal
  151%   if they compare equal up to the detail level of the least specified.
  152%   E.g, '9.1.2' is considered equal to '9.1'.
  153
  154cmp_versions(Cmp, V1, V2) :-
  155    parse_version(V1, V1_Numbers, V1_Git),
  156    parse_version(V2, V2_Numbers, V2_Git),
  157    (   nonvar(Cmp)
  158    ->  cmp_versions(Cmp, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  159    ;   cmp_versions(<, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  160    ->  Cmp = (<)
  161    ;   cmp_versions(>, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  162    ->  Cmp = (<)
  163    ;   Cmp = (=)
  164    ).
  165
  166cmp_versions(=<, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  167    (   cmp_versions(<, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  168    ->  true
  169    ;   cmp_versions(=, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  170    ).
  171cmp_versions(>=, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  172    (   cmp_versions(>, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  173    ->  true
  174    ;   cmp_versions(=, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  175    ).
  176cmp_versions(<, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  177    (   cmp_num_version(<, V1_Numbers, V2_Numbers)
  178    ->  true
  179    ;   V1_Numbers == V2_Numbers,
  180        cmp_git_version(<, V1_Git, V2_Git)
  181    ).
  182cmp_versions(>, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  183    (   cmp_num_version(>, V1_Numbers, V2_Numbers)
  184    ->  true
  185    ;   V1_Numbers == V2_Numbers,
  186        cmp_git_version(>, V1_Git, V2_Git)
  187    ).
  188cmp_versions(=, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  189    cmp_num_version(=, V1_Numbers, V2_Numbers),
  190    cmp_git_version(=, V1_Git, V2_Git).
  191
  192cmp_num_version(Cmp, V1_Numbers, V2_Numbers) :-
  193    shortest(V1_Numbers, V2_Numbers, V1, V2),
  194    compare(Cmp, V1, V2).
  195
  196shortest([H1|T1], [H2|T2], [H1|R1], [H2|R2]) :-
  197    !,
  198    shortest(T1, T2, R1, R2).
  199shortest(_,_, [], []).
  200
  201
  202cmp_git_version(<, -, -) => fail.
  203cmp_git_version(>, -, -) => fail.
  204cmp_git_version(=, -, -) => true.
  205cmp_git_version(<, _, -) => true.
  206cmp_git_version(<, -, _) => fail.
  207cmp_git_version(>, -, _) => fail.
  208cmp_git_version(>, _, -) => true.
  209cmp_git_version(=, -, _) => true.
  210cmp_git_version(=, _, -) => true.
  211cmp_git_version(=, git(V,-), git(V,_)) => true.
  212cmp_git_version(=, git(V,_), git(V,-)) => true.
  213cmp_git_version(<, git(V1, _V1_Hash), git(V2, _V2_Hash)) =>
  214    V1 < V2.
  215cmp_git_version(>, git(V1, _V1_Hash), git(V2, _V2_Hash)) =>
  216    V1 > V2.
  217cmp_git_version(=, V1, V2) => V1 == V2.
  218
  219%!  parse_version(+Spec, -Version:list(integer), -GIT, -Cmp, -Plain) is det.
  220
  221parse_version(Spec, VNumbers, GitVersion, Cmp, VString) :-
  222    spec_cmp_version(Spec, Cmp, VString),
  223    parse_version(VString, VNumbers, GitVersion).
  224
  225spec_cmp_version(Spec, Cmp, Version),
  226    compound(Spec), compound_name_arity(Spec, Cmp, 1) =>
  227    (   is_cmp(Cmp)
  228    ->  true
  229    ;   domain_error(comparison_operator, Cmp)
  230    ),
  231    arg(1, Spec, Version).
  232spec_cmp_version(Spec, Cmp, Version), atom(Spec) =>
  233    Cmp = (>=),
  234    Version = Spec.
  235spec_cmp_version(Spec, Cmp, Version), string(Spec) =>
  236    Cmp = (>=),
  237    atom_string(Version, Spec).
  238spec_cmp_version(Spec, _Cmp, _Version) =>
  239    type_error(version, Spec).
  240
  241is_cmp(=<).
  242is_cmp(<).
  243is_cmp(>=).
  244is_cmp(>).
  245is_cmp(=).
  246is_cmp(>=).
  247
  248parse_version(String, VNumbers, VGit) :-
  249    (   parse_version_(String, VNumbers, VGit)
  250    ->  true
  251    ;   domain_error(version_string, String)
  252    ).
  253
  254parse_version_(String, VNumbers, git(GitRev, GitHash)) :-
  255    split_string(String, "-", "", [NumberS,GitRevS|Hash]),
  256    !,
  257    split_string(NumberS, ".", "", List),
  258    maplist(number_string, VNumbers, List),
  259    (   GitRevS == "DIRTY"
  260    ->  GitRev = 0,
  261        GitHash = 'DIRTY'
  262    ;   number_string(GitRev, GitRevS),
  263        (   Hash = [HashS]
  264        ->  atom_string(GitHash, HashS)
  265        ;   GitHash = '-'
  266        )
  267    ).
  268parse_version_(String, VNumbers, -) :-
  269    split_string(String, ".", "", List),
  270    maplist(number_string, VNumbers, List).
  271
  272%!  check_feature(+Feature) is det.
  273%
  274%   Verify that the running Prolog process has a certain feature.
  275
  276check_feature(warning(Flag)) :-
  277    !,
  278    (   has_feature(Flag)
  279    ->  true
  280    ;   print_message(
  281            warning,
  282            error(existence_error(prolog_feature, warning(Flag)), _))
  283    ).
  284check_feature(Flag) :-
  285    has_feature(Flag),
  286    !.
  287check_feature(Flag) :-
  288    existence_error(prolog_feature, Flag).
  289
  290has_feature(rational) =>
  291    current_prolog_flag(bounded, false).
  292has_feature(library(Lib)) =>
  293    exists_source(library(Lib)).
  294has_feature(Flag), atom(Flag) =>
  295    current_prolog_flag(Flag, true).
  296has_feature(Flag), Flag =.. [Name|Arg] =>
  297    current_prolog_flag(Name, Arg).
  298
  299		 /*******************************
  300		 *           MESSAGES		*
  301		 *******************************/
  302
  303:- multifile
  304    prolog:error_message//1.  305
  306prolog:error_message(version_error(Component, Found, Required)) -->
  307    { current_prolog_flag(executable, Exe) },
  308    [ 'Application requires ~w '-[Component] ], req_msg(Required),
  309    [ ',', nl, '   ',
  310      ansi(code, '~w', [Exe]), ' has version ',
  311      ansi(code, '~w', [Found])
  312    ].
  313prolog:error_message(existence_error(prolog_feature, Feature)) -->
  314    missing_feature(Feature).
  315
  316req_msg((A,B)) --> req_msg(A), [' and '], req_msg(B).
  317req_msg((A;B)) --> req_msg(A), [' or '], req_msg(B).
  318req_msg(\+(A)) --> ['not '], req_msg(A).
  319req_msg(V) --> { spec_cmp_version(V, Cmp, Version) }, !, cmp_msg(Cmp), [' '],
  320    [ ansi(code, '~w', [Version]) ].
  321
  322cmp_msg(<)  --> ['before'].
  323cmp_msg(=<) --> ['at most'].
  324cmp_msg(=)  --> ['exactly'].
  325cmp_msg(>=) --> ['at least'].
  326cmp_msg(>)  --> ['after'].
  327
  328missing_feature(warning(Feature)) -->
  329    [ 'This version of SWI-Prolog does not optimally support your \c
  330       application because',
  331      nl, '   '
  332    ],
  333    missing_feature_(Feature).
  334missing_feature(warning(Feature)) -->
  335    [ 'This version of SWI-Prolog cannot run your application because',
  336      nl, '   '
  337    ],
  338    missing_feature_(Feature).
  339
  340missing_feature_(threads) -->
  341    [ 'multi-threading is not available' ].
  342missing_feature_(rational) -->
  343    [ 'it has no support for rational numbers' ].
  344missing_feature_(bounded(false)) -->
  345    [ 'it has no support for unbounded arithmetic' ].
  346missing_feature_(library(Lib)) -->
  347    [ 'it does not provide library(~q)'-[Lib] ].
  348missing_feature_(Feature) -->
  349    [ 'it does not support ~p'-[Feature] ]