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.  Thde 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(>, -, _) => true.
  207cmp_git_version(=, -, _) => true.
  208cmp_git_version(=, _, -) => true.
  209cmp_git_version(=, git(V,-), git(V,_)) => true.
  210cmp_git_version(=, git(V,_), git(V,-)) => true.
  211cmp_git_version(<, git(V1, _V1_Hash), git(V2, _V2_Hash)) =>
  212    V1 < V2.
  213cmp_git_version(>, git(V1, _V1_Hash), git(V2, _V2_Hash)) =>
  214    V1 > V2.
  215cmp_git_version(=, V1, V2) => V1 == V2.
  216
  217%!  parse_version(+Spec, -Version:list(integer), -GIT, -Cmp, -Plain) is det.
  218
  219parse_version(Spec, VNumbers, GitVersion, Cmp, VString) :-
  220    spec_cmp_version(Spec, Cmp, VString),
  221    parse_version(VString, VNumbers, GitVersion).
  222
  223spec_cmp_version(Spec, Cmp, Version),
  224    compound(Spec), compound_name_arity(Spec, Cmp, 1) =>
  225    (   is_cmp(Cmp)
  226    ->  true
  227    ;   domain_error(comparison_operator, Cmp)
  228    ),
  229    arg(1, Spec, Version).
  230spec_cmp_version(Spec, Cmp, Version), atom(Spec) =>
  231    Cmp = (>=),
  232    Version = Spec.
  233spec_cmp_version(Spec, Cmp, Version), string(Spec) =>
  234    Cmp = (>=),
  235    atom_string(Version, Spec).
  236spec_cmp_version(Spec, _Cmp, _Version) =>
  237    type_error(version, Spec).
  238
  239is_cmp(=<).
  240is_cmp(<).
  241is_cmp(>=).
  242is_cmp(>).
  243is_cmp(=).
  244is_cmp(>=).
  245
  246parse_version(String, VNumbers, VGit) :-
  247    (   parse_version_(String, VNumbers, VGit)
  248    ->  true
  249    ;   domain_error(version_string, String)
  250    ).
  251
  252parse_version_(String, VNumbers, git(GitRev, GitHash)) :-
  253    split_string(String, "-", "", [NumberS,GitRevS|Hash]),
  254    !,
  255    split_string(NumberS, ".", "", List),
  256    maplist(number_string, VNumbers, List),
  257    (   GitRevS == "DIRTY"
  258    ->  GitRev = 0,
  259        GitHash = 'DIRTY'
  260    ;   number_string(GitRev, GitRevS),
  261        (   Hash = [HashS]
  262        ->  atom_string(GitHash, HashS)
  263        ;   GitHash = '-'
  264        )
  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] ]