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:- autoload(library(dcg/basics), [whites//0]).   43:- autoload(library(lists), [append/3]).   44
   45/** <module> Demand specific (Prolog) versions
   46
   47This library is provided to make  it   easier  to  reason about software
   48versions, in particular require that that   hosting  Prolog system is of
   49the right version and provides the features   required by the library or
   50application.
   51
   52@tbd Not only provide a minimal version but a more version ranges,
   53     exclude certain versions, etc.
   54@tbd More features and better messages to help the user resolving
   55     problems.
   56*/
   57
   58%!  require_prolog_version(+Required, +Features:list) is det.
   59%
   60%   Claim that the running Prolog version   is at least version Required
   61%   and provides the requested Features. Required   is  an expression of
   62%   versions. At the lowest level, a version   is an atom or string that
   63%   provides the version as
   64%
   65%	Major.Minor[[.Patch][[-GitRev],-GitHash]]]
   66%
   67%   Example     strings     are     '8.5',      '8.5.0',     '8.5.0-50',
   68%   '8.5.0-69-gad38e8ad8`. The last two  require   fetching  the sources
   69%   from git or using the Windows daily builds.
   70%
   71%   Versions may be embedded in a   comparison operator (`<`, `=<`, `=`,
   72%   `>=` or `>`), e.g., `=<('9.1')`. Versions  are considered to compare
   73%   equal only on the components of  the Required version. I.e., `'9.1'`
   74%   compares equal to `'9.1.2'`.
   75%
   76%   Version expressions can be  constructed   from  the Prolog operators
   77%   ','/2, ';'/2 and '\+'/1. An example   of a complicated expression is
   78%   below, which demands major  version  9,   but  considers  9.1.2  not
   79%   suitable.
   80%
   81%       (>=('9'), \+(=('9.1.2')))
   82%
   83%   Features is a list of  required   or  preferred features. Individual
   84%   features are:
   85%
   86%     - warning(Feature)
   87%       Only print a warning instead of throwing an error.
   88%     - threads
   89%       Demand support for multi-threading.  Same as or threads(true).
   90%     - rational
   91%       Demand native support for rational numbers.  Same as
   92%       bounded(false).
   93%     - library(Lib)
   94%       Demand library(Lib) to be present.  Thde library not being
   95%       there may indicate an incomplete installation.  For example
   96%       library(pce) to demand xpce graphics support.
   97%     - Flag
   98%       Demand current_prolog_flag(Flag, true) to be true.
   99%     - FlagValue
  100%       If FlagValue is Flag(Value), demand current_prolog_flag(Flag,
  101%       Value) to be true.
  102%
  103%    @error version_error('SWI-Prolog', PrologVersion, Cmp, Required)
  104%    @error existence_error(prolog_feature, Feature)
  105
  106require_prolog_version(Required, Features) :-
  107    require_prolog_version(Required),
  108    maplist(check_feature, Features).
  109
  110require_prolog_version(Required) :-
  111    prolog_version(Available),
  112    require_version('SWI-Prolog', Available, Required).
  113
  114prolog_version(Version) :-
  115    current_prolog_flag(version_git, Version),
  116    !.
  117prolog_version(Version) :-
  118    current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
  119    VNumbers = [Major, Minor, Patch],
  120    atomic_list_concat(VNumbers, '.', Version).
  121
  122%!  require_version(+Component, +Available, +CmpRequired) is det.
  123%
  124%   Require Component to have version   CmpRequired,  while Component is
  125%   know to have version Available.
  126%
  127%   @error version_error(Component, Required, Cmp, Available)
  128
  129require_version(Component, Available, CmpRequired) :-
  130    parse_version(Available, AvlNumbers, AvlGit),
  131    (   require_version_(AvlNumbers, AvlGit, CmpRequired)
  132    ->  true
  133    ;   throw(error(version_error(Component, Available, CmpRequired), _))
  134    ).
  135
  136require_version_(AvlNumbers, AvlGit, (V1;V2)) =>
  137    (   require_version_(AvlNumbers, AvlGit, V1)
  138    ->  true
  139    ;   require_version_(AvlNumbers, AvlGit, V2)
  140    ).
  141require_version_(AvlNumbers, AvlGit, (V1,V2)) =>
  142    (   require_version_(AvlNumbers, AvlGit, V1)
  143    ;   require_version_(AvlNumbers, AvlGit, V2)
  144    ).
  145require_version_(AvlNumbers, AvlGit, \+V1) =>
  146    \+ require_version_(AvlNumbers, AvlGit, V1).
  147require_version_(AvlNumbers, AvlGit, Required) =>
  148    parse_version(Required,  ReqNumbers, ReqGit, Cmp, _),
  149    cmp_versions(Cmp, AvlNumbers, AvlGit, ReqNumbers, ReqGit).
  150
  151%!  cmp_versions(?Cmp, +V1, +V2) is semidet.
  152%
  153%   Compare to versions. Cmp is one of `<`,   `=<`, `=`, `>=` or `>`. If
  154%   Cmp is unbound we check whether `<` or  `>` hold or else bind Cmp to
  155%   `=`.
  156%
  157%   When comparing for equality (`=`), the versions are considered equal
  158%   if they compare equal up to the detail level of the least specified.
  159%   E.g, '9.1.2' is considered equal to '9.1'.
  160
  161cmp_versions(Cmp, V1, V2) :-
  162    parse_version(V1, V1_Numbers, V1_Git),
  163    parse_version(V2, V2_Numbers, V2_Git),
  164    (   nonvar(Cmp)
  165    ->  cmp_versions(Cmp, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  166    ;   cmp_versions(<, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  167    ->  Cmp = (<)
  168    ;   cmp_versions(>, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  169    ->  Cmp = (<)
  170    ;   Cmp = (=)
  171    ).
  172
  173cmp_versions(=<, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  174    (   cmp_versions(<, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  175    ->  true
  176    ;   cmp_versions(=, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  177    ).
  178cmp_versions(>=, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  179    (   cmp_versions(>, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  180    ->  true
  181    ;   cmp_versions(=, V1_Numbers, V1_Git, V2_Numbers, V2_Git)
  182    ).
  183cmp_versions(<, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  184    (   cmp_num_version(<, V1_Numbers, V2_Numbers)
  185    ->  true
  186    ;   V1_Numbers == V2_Numbers,
  187        cmp_git_version(<, V1_Git, V2_Git)
  188    ).
  189cmp_versions(>, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  190    (   cmp_num_version(>, V1_Numbers, V2_Numbers)
  191    ->  true
  192    ;   V1_Numbers == V2_Numbers,
  193        cmp_git_version(>, V1_Git, V2_Git)
  194    ).
  195cmp_versions(=, V1_Numbers, V1_Git, V2_Numbers, V2_Git) =>
  196    cmp_num_version(=, V1_Numbers, V2_Numbers),
  197    cmp_git_version(=, V1_Git, V2_Git).
  198
  199cmp_num_version(Cmp, V1_Numbers, V2_Numbers) :-
  200    shortest(V1_Numbers, V2_Numbers, V1, V2),
  201    compare(Cmp, V1, V2).
  202
  203shortest([H1|T1], [H2|T2], [H1|R1], [H2|R2]) :-
  204    !,
  205    shortest(T1, T2, R1, R2).
  206shortest(_,_, [], []).
  207
  208
  209cmp_git_version(<, _, -) => true.
  210cmp_git_version(>, -, _) => true.
  211cmp_git_version(=, -, _) => true.
  212cmp_git_version(=, _, -) => true.
  213cmp_git_version(=, git(V,-), git(V,_)) => true.
  214cmp_git_version(=, git(V,_), git(V,-)) => true.
  215cmp_git_version(<, git(V1, _V1_Hash), git(V2, _V2_Hash)) =>
  216    V1 < V2.
  217cmp_git_version(>, git(V1, _V1_Hash), git(V2, _V2_Hash)) =>
  218    V1 > V2.
  219cmp_git_version(=, V1, V2) => V1 == V2.
  220
  221%!  parse_version(+Spec, -Version:list(integer), -GIT, -Cmp, -Plain) is det.
  222
  223parse_version(Spec, VNumbers, GitVersion, Cmp, VString) :-
  224    spec_cmp_version(Spec, Cmp, VString),
  225    parse_version(VString, VNumbers, GitVersion).
  226
  227spec_cmp_version(Spec, Cmp, Version),
  228    compound(Spec), compound_name_arity(Spec, Cmp, 1) =>
  229    (   is_cmp(Cmp)
  230    ->  true
  231    ;   domain_error(comparison_operator, Cmp)
  232    ),
  233    arg(1, Spec, Version).
  234spec_cmp_version(Spec, Cmp, Version), atom(Spec) =>
  235    Cmp = (>=),
  236    Version = Spec.
  237spec_cmp_version(Spec, Cmp, Version), string(Spec) =>
  238    Cmp = (>=),
  239    atom_string(Version, Spec).
  240spec_cmp_version(Spec, _Cmp, _Version) =>
  241    type_error(version, Spec).
  242
  243is_cmp(=<).
  244is_cmp(<).
  245is_cmp(>=).
  246is_cmp(>).
  247is_cmp(=).
  248is_cmp(>=).
  249
  250parse_version(String, VNumbers, VGit) :-
  251    (   parse_version_(String, VNumbers, VGit)
  252    ->  true
  253    ;   domain_error(version_string, String)
  254    ).
  255
  256parse_version_(String, VNumbers, git(GitRev, GitHash)) :-
  257    split_string(String, "-", "", [NumberS,GitRevS|Hash]),
  258    !,
  259    split_string(NumberS, ".", "", List),
  260    maplist(number_string, VNumbers, List),
  261    number_string(GitRev, GitRevS),
  262    (   Hash = [HashS]
  263    ->  atom_string(GitHash, HashS)
  264    ;   GitHash = '-'
  265    ).
  266parse_version_(String, VNumbers, -) :-
  267    split_string(String, ".", "", List),
  268    maplist(number_string, VNumbers, List).
  269
  270%!  check_feature(+Feature) is det.
  271%
  272%   Verify that the running Prolog process has a certain feature.
  273
  274check_feature(warning(Flag)) :-
  275    !,
  276    (   has_feature(Flag)
  277    ->  true
  278    ;   print_message(
  279            warning,
  280            error(existence_error(prolog_feature, warning(Flag)), _))
  281    ).
  282check_feature(Flag) :-
  283    has_feature(Flag),
  284    !.
  285check_feature(Flag) :-
  286    existence_error(prolog_feature, Flag).
  287
  288has_feature(rational) =>
  289    current_prolog_flag(bounded, false).
  290has_feature(library(Lib)) =>
  291    exists_source(library(Lib)).
  292has_feature(Flag), atom(Flag) =>
  293    current_prolog_flag(Flag, true).
  294has_feature(Flag), Flag =.. [Name|Arg] =>
  295    current_prolog_flag(Name, Arg).
  296
  297		 /*******************************
  298		 *           MESSAGES		*
  299		 *******************************/
  300
  301:- multifile
  302    prolog:error_message//1.  303
  304prolog:error_message(version_error(Component, Found, Required)) -->
  305    { current_prolog_flag(executable, Exe) },
  306    [ 'Application requires ~w '-[Component] ], req_msg(Required),
  307    [ ',', nl, '   ',
  308      ansi(code, '~w', [Exe]), ' has version ',
  309      ansi(code, '~w', [Found])
  310    ].
  311prolog:error_message(existence_error(prolog_feature, Feature)) -->
  312    missing_feature(Feature).
  313
  314req_msg((A,B)) --> req_msg(A), [' and '], req_msg(B).
  315req_msg((A;B)) --> req_msg(A), [' or '], req_msg(B).
  316req_msg(\+(A)) --> ['not '], req_msg(A).
  317req_msg(V) --> { spec_cmp_version(V, Cmp, Version) }, !, cmp_msg(Cmp), [' '],
  318    [ ansi(code, '~w', [Version]) ].
  319
  320cmp_msg(<)  --> ['before'].
  321cmp_msg(=<) --> ['at most'].
  322cmp_msg(=)  --> ['exactly'].
  323cmp_msg(>=) --> ['at least'].
  324cmp_msg(>)  --> ['after'].
  325
  326missing_feature(warning(Feature)) -->
  327    [ 'This version of SWI-Prolog does not optimally support your \c
  328       application because',
  329      nl, '   '
  330    ],
  331    missing_feature_(Feature).
  332missing_feature(warning(Feature)) -->
  333    [ 'This version of SWI-Prolog cannot run your application because',
  334      nl, '   '
  335    ],
  336    missing_feature_(Feature).
  337
  338missing_feature_(threads) -->
  339    [ 'multi-threading is not available' ].
  340missing_feature_(rational) -->
  341    [ 'it has no support for rational numbers' ].
  342missing_feature_(bounded(false)) -->
  343    [ 'it has no support for unbounded arithmetic' ].
  344missing_feature_(library(Lib)) -->
  345    [ 'it does not provide library(~q)'-[Lib] ].
  346missing_feature_(Feature) -->
  347    [ 'it does not support ~p'-[Feature] ]