View source with formatted comments or as raw
    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)  2012-2024, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_pack,
   38          [ pack_list_installed/0,
   39            pack_info/1,                % +Name
   40            pack_list/1,                % +Keyword
   41            pack_list/2,                % +Query, +Options
   42            pack_search/1,              % +Keyword
   43            pack_install/1,             % +Name
   44            pack_install/2,             % +Name, +Options
   45            pack_install_local/3,       % :Spec, +Dir, +Options
   46            pack_upgrade/1,             % +Name
   47            pack_rebuild/1,             % +Name
   48            pack_rebuild/0,             % All packages
   49            pack_remove/1,              % +Name
   50            pack_remove/2,              % +Name, +Options
   51            pack_publish/2,             % +URL, +Options
   52            pack_property/2             % ?Name, ?Property
   53          ]).   54:- use_module(library(apply)).   55:- use_module(library(error)).   56:- use_module(library(option)).   57:- use_module(library(readutil)).   58:- use_module(library(lists)).   59:- use_module(library(filesex)).   60:- use_module(library(xpath)).   61:- use_module(library(settings)).   62:- use_module(library(uri)).   63:- use_module(library(dcg/basics)).   64:- use_module(library(dcg/high_order)).   65:- use_module(library(http/http_open)).   66:- use_module(library(http/json)).   67:- use_module(library(http/http_client), []).   68:- use_module(library(debug), [assertion/1]).   69:- use_module(library(pairs),
   70              [pairs_keys/2, map_list_to_pairs/3, pairs_values/2]).   71:- autoload(library(git)).   72:- autoload(library(sgml)).   73:- autoload(library(sha)).   74:- autoload(library(build/tools)).   75:- autoload(library(ansi_term), [ansi_format/3]).   76:- autoload(library(pprint), [print_term/2]).   77:- autoload(library(prolog_versions), [require_version/3, cmp_versions/3]).   78:- autoload(library(ugraphs), [vertices_edges_to_ugraph/3, ugraph_layers/2]).   79:- autoload(library(process), [process_which/2]).   80:- autoload(library(aggregate), [aggregate_all/3]).   81
   82:- meta_predicate
   83    pack_install_local(2, +, +).   84
   85/** <module> A package manager for Prolog
   86
   87The library(prolog_pack) provides the SWI-Prolog   package manager. This
   88library lets you inspect installed   packages,  install packages, remove
   89packages, etc. This library complemented by the built-in predicates such
   90as attach_packs/2 that makes installed packages available as libraries.
   91
   92The important functionality of this library is encapsulated in the _app_
   93`pack`. For help, run
   94
   95    swipl pack help
   96*/
   97
   98                 /*******************************
   99                 *          CONSTANTS           *
  100                 *******************************/
  101
  102:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  103           'Server to exchange pack information').  104
  105
  106		 /*******************************
  107		 *       LOCAL DECLARATIONS	*
  108		 *******************************/
  109
  110:- op(900, xfx, @).                     % Token@Version
  111
  112:- meta_predicate det_if(0,0).  113
  114                 /*******************************
  115                 *         PACKAGE INFO         *
  116                 *******************************/
  117
  118%!  current_pack(?Pack) is nondet.
  119%!  current_pack(?Pack, ?Dir) is nondet.
  120%
  121%   True if Pack is a currently installed pack.
  122
  123current_pack(Pack) :-
  124    current_pack(Pack, _).
  125
  126current_pack(Pack, Dir) :-
  127    '$pack':pack(Pack, Dir).
  128
  129%!  pack_list_installed is det.
  130%
  131%   List currently installed packages  and   report  possible dependency
  132%   issues.
  133
  134pack_list_installed :-
  135    pack_list('', [installed(true)]),
  136    validate_dependencies.
  137
  138%!  pack_info(+Pack)
  139%
  140%   Print more detailed information about Pack.
  141
  142pack_info(Name) :-
  143    pack_info(info, Name).
  144
  145pack_info(Level, Name) :-
  146    must_be(atom, Name),
  147    findall(Info, pack_info(Name, Level, Info), Infos0),
  148    (   Infos0 == []
  149    ->  print_message(warning, pack(no_pack_installed(Name))),
  150        fail
  151    ;   true
  152    ),
  153    findall(Def,  pack_default(Level, Infos, Def), Defs),
  154    append(Infos0, Defs, Infos1),
  155    sort(Infos1, Infos),
  156    show_info(Name, Infos, [info(Level)]).
  157
  158
  159show_info(_Name, _Properties, Options) :-
  160    option(silent(true), Options),
  161    !.
  162show_info(_Name, _Properties, Options) :-
  163    option(show_info(false), Options),
  164    !.
  165show_info(Name, Properties, Options) :-
  166    option(info(list), Options),
  167    !,
  168    memberchk(title(Title), Properties),
  169    memberchk(version(Version), Properties),
  170    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  171show_info(Name, Properties, _) :-
  172    !,
  173    print_property_value('Package'-'~w', [Name]),
  174    findall(Term, pack_level_info(info, Term, _, _), Terms),
  175    maplist(print_property(Properties), Terms).
  176
  177print_property(_, nl) :-
  178    !,
  179    format('~n').
  180print_property(Properties, Term) :-
  181    findall(Term, member(Term, Properties), Terms),
  182    Terms \== [],
  183    !,
  184    pack_level_info(_, Term, LabelFmt, _Def),
  185    (   LabelFmt = Label-FmtElem
  186    ->  true
  187    ;   Label = LabelFmt,
  188        FmtElem = '~w'
  189    ),
  190    multi_valued(Terms, FmtElem, FmtList, Values),
  191    atomic_list_concat(FmtList, ', ', Fmt),
  192    print_property_value(Label-Fmt, Values).
  193print_property(_, _).
  194
  195multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  196    !,
  197    H =.. [_|Values].
  198multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  199    H =.. [_|VH],
  200    append(VH, MoreValues, Values),
  201    multi_valued(T, LabelFmt, LT, MoreValues).
  202
  203
  204pvalue_column(29).
  205print_property_value(Prop-Fmt, Values) :-
  206    !,
  207    pvalue_column(C),
  208    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  209    format(Format, [Prop,C|Values]).
  210
  211pack_info(Name, Level, Info) :-
  212    '$pack':pack(Name, BaseDir),
  213    pack_dir_info(BaseDir, Level, Info).
  214
  215pack_dir_info(BaseDir, Level, Info) :-
  216    (   Info = directory(BaseDir)
  217    ;   pack_info_term(BaseDir, Info)
  218    ),
  219    pack_level_info(Level, Info, _Format, _Default).
  220
  221:- public pack_level_info/4.                    % used by web-server
  222
  223pack_level_info(_,    title(_),         'Title',                   '<no title>').
  224pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  225pack_level_info(info, automatic(_),	'Automatic (dependency only)', -).
  226pack_level_info(info, directory(_),     'Installed in directory',  -).
  227pack_level_info(info, link(_),		'Installed as link to'-'~w', -).
  228pack_level_info(info, built(_,_),	'Built on'-'~w for SWI-Prolog ~w', -).
  229pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  230pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  231pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  232pack_level_info(info, home(_),          'Home page',               -).
  233pack_level_info(info, download(_),      'Download URL',            -).
  234pack_level_info(_,    provides(_),      'Provides',                -).
  235pack_level_info(_,    requires(_),      'Requires',                -).
  236pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  237pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  238pack_level_info(info, library(_),	'Provided libraries',      -).
  239
  240pack_default(Level, Infos, Def) :-
  241    pack_level_info(Level, ITerm, _Format, Def),
  242    Def \== (-),
  243    \+ memberchk(ITerm, Infos).
  244
  245%!  pack_info_term(+PackDir, ?Info) is nondet.
  246%
  247%   True when Info is meta-data for the package PackName.
  248
  249pack_info_term(BaseDir, Info) :-
  250    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  251    catch(
  252        term_in_file(valid_term(pack_info_term), InfoFile, Info),
  253        error(existence_error(source_sink, InfoFile), _),
  254        ( print_message(error, pack(no_meta_data(BaseDir))),
  255          fail
  256        )).
  257pack_info_term(BaseDir, library(Lib)) :-
  258    atom_concat(BaseDir, '/prolog/', LibDir),
  259    atom_concat(LibDir, '*.pl', Pattern),
  260    expand_file_name(Pattern, Files),
  261    maplist(atom_concat(LibDir), Plain, Files),
  262    convlist(base_name, Plain, Libs),
  263    member(Lib, Libs).
  264pack_info_term(BaseDir, automatic(Boolean)) :-
  265    once(pack_status_dir(BaseDir, automatic(Boolean))).
  266pack_info_term(BaseDir, built(Arch, Prolog)) :-
  267    pack_status_dir(BaseDir, built(Arch, Prolog, _How)).
  268pack_info_term(BaseDir, link(Dest)) :-
  269    read_link(BaseDir, _, Dest).
  270
  271base_name(File, Base) :-
  272    file_name_extension(Base, pl, File).
  273
  274%!  term_in_file(:Valid, +File, -Term) is nondet.
  275%
  276%   True when Term appears in file and call(Valid, Term) is true.
  277
  278:- meta_predicate
  279    term_in_file(1, +, -).  280
  281term_in_file(Valid, File, Term) :-
  282    exists_file(File),
  283    setup_call_cleanup(
  284        open(File, read, In, [encoding(utf8)]),
  285        term_in_stream(Valid, In, Term),
  286        close(In)).
  287
  288term_in_stream(Valid, In, Term) :-
  289    repeat,
  290        read_term(In, Term0, []),
  291        (   Term0 == end_of_file
  292        ->  !, fail
  293        ;   Term = Term0,
  294            call(Valid, Term0)
  295        ).
  296
  297:- meta_predicate
  298    valid_term(1,+).  299
  300valid_term(Type, Term) :-
  301    Term =.. [Name|Args],
  302    same_length(Args, Types),
  303    Decl =.. [Name|Types],
  304    (   call(Type, Decl)
  305    ->  maplist(valid_info_arg, Types, Args)
  306    ;   print_message(warning, pack(invalid_term(Type, Term))),
  307        fail
  308    ).
  309
  310valid_info_arg(Type, Arg) :-
  311    must_be(Type, Arg).
  312
  313%!  pack_info_term(?Term) is nondet.
  314%
  315%   True when Term describes name and   arguments of a valid package
  316%   info term.
  317
  318pack_info_term(name(atom)).                     % Synopsis
  319pack_info_term(title(atom)).
  320pack_info_term(keywords(list(atom))).
  321pack_info_term(description(list(atom))).
  322pack_info_term(version(version)).
  323pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  324pack_info_term(maintainer(atom, email_or_url)).
  325pack_info_term(packager(atom, email_or_url)).
  326pack_info_term(pack_version(nonneg)).           % Package convention version
  327pack_info_term(home(atom)).                     % Home page
  328pack_info_term(download(atom)).                 % Source
  329pack_info_term(provides(atom)).                 % Dependencies
  330pack_info_term(requires(dependency)).
  331pack_info_term(conflicts(dependency)).          % Conflicts with package
  332pack_info_term(replaces(atom)).                 % Replaces another package
  333pack_info_term(autoload(boolean)).              % Default installation options
  334
  335:- multifile
  336    error:has_type/2.  337
  338error:has_type(version, Version) :-
  339    atom(Version),
  340    is_version(Version).
  341error:has_type(email_or_url, Address) :-
  342    atom(Address),
  343    (   sub_atom(Address, _, _, _, @)
  344    ->  true
  345    ;   uri_is_global(Address)
  346    ).
  347error:has_type(email_or_url_or_empty, Address) :-
  348    (   Address == ''
  349    ->  true
  350    ;   error:has_type(email_or_url, Address)
  351    ).
  352error:has_type(dependency, Value) :-
  353    is_dependency(Value).
  354
  355is_version(Version) :-
  356    split_string(Version, ".", "", Parts),
  357    maplist(number_string, _, Parts).
  358
  359is_dependency(Var) :-
  360    var(Var),
  361    !,
  362    fail.
  363is_dependency(Token) :-
  364    atom(Token),
  365    !.
  366is_dependency(Term) :-
  367    compound(Term),
  368    compound_name_arguments(Term, Op, [Token,Version]),
  369    atom(Token),
  370    cmp(Op, _),
  371    is_version(Version),
  372    !.
  373is_dependency(PrologToken) :-
  374    is_prolog_token(PrologToken).
  375
  376cmp(<,  @<).
  377cmp(=<, @=<).
  378cmp(==, ==).
  379cmp(>=, @>=).
  380cmp(>,  @>).
  381
  382
  383                 /*******************************
  384                 *            SEARCH            *
  385                 *******************************/
  386
  387%!  pack_list(+Query) is det.
  388%!  pack_list(+Query, +Options) is det.
  389%!  pack_search(+Query) is det.
  390%
  391%   Query package server and  installed   packages  and display results.
  392%   Query is matches case-insensitively against the   name  and title of
  393%   known and installed packages. For each   matching  package, a single
  394%   line is displayed that provides:
  395%
  396%     - Installation status
  397%       - __p__: package, not installed
  398%       - __i__: installed package; up-to-date with public version
  399%       - __a__: as __i__, but installed only as dependency
  400%       - __U__: installed package; can be upgraded
  401%       - __A__: installed package; newer than publically available
  402%       - __l__: installed package; not on server
  403%     - Name@Version
  404%     - Name@Version(ServerVersion)
  405%     - Title
  406%
  407%   Options processed:
  408%
  409%     - installed(true)
  410%       Only list packages that are locally installed.  Contacts the
  411%       server to compare our local version to the latest available
  412%       version.
  413%     - outdated(true)
  414%       Only list packages that need to be updated.  This option
  415%       implies installed(true).
  416%     - server(Server|false)
  417%       If `false`, do not contact the server. This implies
  418%       installed(true).  Otherwise, use the given pack server.
  419%
  420%   Hint: ``?- pack_list('').`` lists all known packages.
  421%
  422%   The predicates pack_list/1 and  pack_search/1   are  synonyms.  Both
  423%   contact the package server  at   https://www.swi-prolog.org  to find
  424%   available packages. Contacting the server can   be avoided using the
  425%   server(false) option.
  426
  427pack_list(Query) :-
  428    pack_list(Query, []).
  429
  430pack_search(Query) :-
  431    pack_list(Query, []).
  432
  433pack_list(Query, Options) :-
  434    (   option(installed(true), Options)
  435    ;   option(outdated(true), Options)
  436    ;   option(server(false), Options)
  437    ),
  438    !,
  439    local_search(Query, Local),
  440    maplist(arg(1), Local, Packs),
  441    (   option(server(false), Options)
  442    ->  Hits = []
  443    ;   query_pack_server(info(Packs), true(Hits), Options)
  444    ),
  445    list_hits(Hits, Local, Options).
  446pack_list(Query, Options) :-
  447    query_pack_server(search(Query), Result, Options),
  448    (   Result == false
  449    ->  (   local_search(Query, Packs),
  450            Packs \== []
  451        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  452                   format('~w ~w@~w ~28|- ~w~n',
  453                          [Stat, Pack, Version, Title]))
  454        ;   print_message(warning, pack(search_no_matches(Query)))
  455        )
  456    ;   Result = true(Hits), % Hits = list(pack(Name, p, Title, Version, URL))
  457        local_search(Query, Local),
  458        list_hits(Hits, Local, [])
  459    ).
  460
  461list_hits(Hits, Local, Options) :-
  462    append(Hits, Local, All),
  463    sort(All, Sorted),
  464    join_status(Sorted, Packs0),
  465    include(filtered(Options), Packs0, Packs),
  466    maplist(list_hit(Options), Packs).
  467
  468filtered(Options, pack(_,Tag,_,_,_)) :-
  469    option(outdated(true), Options),
  470    !,
  471    Tag == 'U'.
  472filtered(_, _).
  473
  474list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) =>
  475    list_tag(Tag),
  476    ansi_format(code, '~w', [Pack]),
  477    format('@'),
  478    list_version(Tag, Version),
  479    format('~35|- ', []),
  480    ansi_format(comment, '~w~n', [Title]).
  481
  482list_tag(Tag) :-
  483    tag_color(Tag, Color),
  484    ansi_format(Color, '~w ', [Tag]).
  485
  486list_version(Tag, VersionI-VersionS) =>
  487    tag_color(Tag, Color),
  488    ansi_format(Color, '~w', [VersionI]),
  489    ansi_format(bold, '(~w)', [VersionS]).
  490list_version(_Tag, Version) =>
  491    ansi_format([], '~w', [Version]).
  492
  493tag_color('U', warning) :- !.
  494tag_color('A', comment) :- !.
  495tag_color(_, []).
  496
  497%!  join_status(+PacksIn, -PacksOut) is det.
  498%
  499%   Combine local and remote information to   assess  the status of each
  500%   package. PacksOut is a list of  pack(Name, Status, Version, URL). If
  501%   the     versions     do      not       match,      `Version`      is
  502%   `VersionInstalled-VersionRemote` and similar for thee URL.
  503
  504join_status([], []).
  505join_status([ pack(Pack, i, Title, Version, URL),
  506              pack(Pack, p, Title, Version, _)
  507            | T0
  508            ],
  509            [ pack(Pack, Tag, Title, Version, URL)
  510            | T
  511            ]) :-
  512    !,
  513    (   pack_status(Pack, automatic(true))
  514    ->  Tag = a
  515    ;   Tag = i
  516    ),
  517    join_status(T0, T).
  518join_status([ pack(Pack, i, Title, VersionI, URLI),
  519              pack(Pack, p, _,     VersionS, URLS)
  520            | T0
  521            ],
  522            [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS)
  523            | T
  524            ]) :-
  525    !,
  526    version_sort_key(VersionI, VDI),
  527    version_sort_key(VersionS, VDS),
  528    (   VDI @< VDS
  529    ->  Tag = 'U'
  530    ;   Tag = 'A'
  531    ),
  532    join_status(T0, T).
  533join_status([ pack(Pack, i, Title, VersionI, URL)
  534            | T0
  535            ],
  536            [ pack(Pack, l, Title, VersionI, URL)
  537            | T
  538            ]) :-
  539    !,
  540    join_status(T0, T).
  541join_status([H|T0], [H|T]) :-
  542    join_status(T0, T).
  543
  544%!  local_search(+Query, -Packs:list(atom)) is det.
  545%
  546%   Search locally installed packs.
  547
  548local_search(Query, Packs) :-
  549    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  550
  551matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  552    current_pack(Pack),
  553    findall(Term,
  554            ( pack_info(Pack, _, Term),
  555              search_info(Term)
  556            ), Info),
  557    (   sub_atom_icasechk(Pack, _, Query)
  558    ->  true
  559    ;   memberchk(title(Title), Info),
  560        sub_atom_icasechk(Title, _, Query)
  561    ),
  562    option(title(Title), Info, '<no title>'),
  563    option(version(Version), Info, '<no version>'),
  564    option(download(URL), Info, '<no download url>').
  565
  566search_info(title(_)).
  567search_info(version(_)).
  568search_info(download(_)).
  569
  570
  571                 /*******************************
  572                 *            INSTALL           *
  573                 *******************************/
  574
  575%!  pack_install(+Spec:atom) is det.
  576%!  pack_install(+SpecOrList, +Options) is det.
  577%
  578%   Install one or more packs from   SpecOrList.  SpecOrList is a single
  579%   specification or a list of specifications. A specification is one of
  580%
  581%     * A pack name.  This queries the pack repository
  582%       at https://www.swi-prolog.org
  583%     * Archive file name
  584%     * A http(s) URL of an archive file name.  This URL may contain a
  585%       star (*) for the version.  In this case pack_install/1 asks
  586%       for the directory content and selects the latest version.
  587%     * An https GIT URL
  588%     * A local directory name given as ``file://`` URL
  589%     * `'.'`, in which case a relative symlink is created to the
  590%       current directory (all other options for Spec make a copy
  591%       of the files).  Installation using a symlink is normally
  592%       used during development of a pack.
  593%
  594%   Processes the options below. Default  options   as  would be used by
  595%   pack_install/1 are used to complete the  provided Options. Note that
  596%   pack_install/2 can be used through the   SWI-Prolog command line app
  597%   `pack` as below. Most of the options of this predicate are available
  598%   as command line options.
  599%
  600%      swipl pack install <name>
  601%
  602%   Options:
  603%
  604%     * url(+URL)
  605%       Source for downloading the package
  606%     * pack_directory(+Dir)
  607%       Directory into which to install the package.
  608%     * global(+Boolean)
  609%       If `true`, install in the XDG common application data path,
  610%       making the pack accessible to everyone. If `false`, install in
  611%       the XDG user application data path, making the pack accessible
  612%       for the current user only. If the option is absent, use the
  613%       first existing and writable directory. If that doesn't exist
  614%       find locations where it can be created and prompt the user to do
  615%       so.
  616%     * insecure(+Boolean)
  617%       When `true` (default `false`), do not perform any checks on SSL
  618%       certificates when downloading using `https`.
  619%     * interactive(+Boolean)
  620%       Use default answer without asking the user if there
  621%       is a default action.
  622%     * silent(+Boolean)
  623%       If `true` (default false), suppress informational progress
  624%       messages.
  625%     * upgrade(+Boolean)
  626%       If `true` (default `false`), upgrade package if it is already
  627%       installed.
  628%     * rebuild(Condition)
  629%       Rebuild the foreign components.  Condition is one of
  630%       `if_absent` (default, do nothing if the directory with foreign
  631%       resources exists), `make` (run `make`) or `true` (run `make
  632%       distclean` followed by the default configure and build steps).
  633%     * test(Boolean)
  634%       If `true` (default), run the pack tests.
  635%     * git(+Boolean)
  636%       If `true` (default `false` unless `URL` ends with ``.git``),
  637%       assume the URL is a GIT repository.
  638%     * link(+Boolean)
  639%       Can be used if the installation source is a local directory
  640%       and the file system supports symbolic links.  In this case
  641%       the system adds the current directory to the pack registration
  642%       using a symbolic link and performs the local installation steps.
  643%     * version(+Version)
  644%       Demand the pack to satisfy some version requirement.  Version
  645%       is as defined by require_version/3.  For example `'1.5'` is the
  646%       same as `>=('1.5')`.
  647%     * branch(+Branch)
  648%       When installing from a git repository, clone this branch.
  649%     * commit(+Commit)
  650%       When installing from a git repository, checkout this commit.
  651%       Commit is either a hash, a tag, a branch or `'HEAD'`.
  652%     * build_type(+Type)
  653%       When building using CMake, use ``-DCMAKE_BUILD_TYPE=Type``.
  654%       Default is the build type of Prolog or ``Release``.
  655%     * register(+Boolean)
  656%       If `true` (default), register packages as downloaded after
  657%       performing the download.  This contacts the server with the
  658%       meta-data of each pack that was downloaded.  The server will
  659%       either register the location as a new version or increment
  660%       the download count.  The server stores the IP address of the
  661%       client.  Subsequent downloads of the same version from the
  662%       same IP address are ignored.
  663%     * server(+URL)
  664%       Pack server to contact. Default is the setting
  665%       `prolog_pack:server`, by default set to
  666%       ``https://www.swi-prolog.org/pack/``
  667%
  668%   Non-interactive installation can be established using the option
  669%   interactive(false). It is adviced to   install from a particular
  670%   _trusted_ URL instead of the  plain   pack  name  for unattented
  671%   operation.
  672
  673pack_install(Spec) :-
  674    pack_default_options(Spec, Pack, [], Options),
  675    pack_install(Pack, [pack(Pack)|Options]).
  676
  677pack_install(Specs, Options) :-
  678    is_list(Specs),
  679    !,
  680    maplist(pack_options(Options), Specs, Pairs),
  681    pack_install_dir(PackTopDir, Options),
  682    pack_install_set(Pairs, PackTopDir, Options).
  683pack_install(Spec, Options) :-
  684    pack_default_options(Spec, Pack, Options, DefOptions),
  685    (   option(already_installed(Installed), DefOptions)
  686    ->  print_message(informational, pack(already_installed(Installed)))
  687    ;   merge_options(Options, DefOptions, PackOptions),
  688        pack_install_dir(PackTopDir, PackOptions),
  689        pack_install_set([Pack-PackOptions], PackTopDir, Options)
  690    ).
  691
  692pack_options(Options, Spec, Pack-PackOptions) :-
  693    pack_default_options(Spec, Pack, Options, DefOptions),
  694    merge_options(Options, DefOptions, PackOptions).
  695
  696%!  pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det.
  697%
  698%   Establish  the  pack  name  (Pack)  and    install  options  from  a
  699%   specification and options (OptionsIn) provided by the user.  Cases:
  700%
  701%     1. Already installed.  We must pass that as pack_default_options/4
  702%        is called twice from pack_install/2.
  703%     2. Install from a URL due to a url(URL) option. Determine whether
  704%        the URL is a GIT repository, get the version and pack from the
  705%        URL.
  706%     3. Install a local archive file. Extract the pack and version from
  707%        the archive name.
  708%     4. Install from a git URL.  Determines the pack, sets git(true)
  709%        and adds the URL as option.
  710%     5. Install from a directory. Get the info from the `packs.pl`
  711%        file.
  712%     6. Install from `'.'`.  Create a symlink to make the current dir
  713%        accessible as a pack.
  714%     7. Install from a non-git URL
  715%        Determine pack and version.
  716%     8. Pack name.  Query the server to find candidate packs and
  717%        select an adequate pack.
  718
  719
  720pack_default_options(_Spec, Pack, OptsIn, Options) :-   % (1)
  721    option(already_installed(pack(Pack,_Version)), OptsIn),
  722    !,
  723    Options = OptsIn.
  724pack_default_options(_Spec, Pack, OptsIn, Options) :-   % (2)
  725    option(url(URL), OptsIn),
  726    !,
  727    (   option(git(_), OptsIn)
  728    ->  Options = OptsIn
  729    ;   git_url(URL, Pack)
  730    ->  Options = [git(true)|OptsIn]
  731    ;   Options = OptsIn
  732    ),
  733    (   nonvar(Pack)
  734    ->  true
  735    ;   option(pack(Pack), Options)
  736    ->  true
  737    ;   pack_version_file(Pack, _Version, URL)
  738    ).
  739pack_default_options(Archive, Pack, OptsIn, Options) :- % (3)
  740    must_be(atom, Archive),
  741    \+ uri_is_global(Archive),
  742    expand_file_name(Archive, [File]),
  743    exists_file(File),
  744    !,
  745    (   pack_version_file(Pack, Version, File)
  746    ->  uri_file_name(FileURL, File),
  747        merge_options([url(FileURL), version(Version)], OptsIn, Options)
  748    ;   domain_error(pack_file_name, Archive)
  749    ).
  750pack_default_options(URL, Pack, OptsIn, Options) :-     % (4)
  751    git_url(URL, Pack),
  752    !,
  753    merge_options([git(true), url(URL)], OptsIn, Options).
  754pack_default_options(FileURL, Pack, _, Options) :-      % (5)
  755    uri_file_name(FileURL, Dir),
  756    exists_directory(Dir),
  757    pack_info_term(Dir, name(Pack)),
  758    !,
  759    (   pack_info_term(Dir, version(Version))
  760    ->  uri_file_name(DirURL, Dir),
  761        Options = [url(DirURL), version(Version)]
  762    ;   throw(error(existence_error(key, version, Dir),_))
  763    ).
  764pack_default_options('.', Pack, OptsIn, Options) :-     % (6)
  765    pack_info_term('.', name(Pack)),
  766    !,
  767    working_directory(Dir, Dir),
  768    (   pack_info_term(Dir, version(Version))
  769    ->  uri_file_name(DirURL, Dir),
  770        NewOptions = [url(DirURL), version(Version) | Options1],
  771        (   current_prolog_flag(windows, true)
  772        ->  Options1 = []
  773        ;   Options1 = [link(true), rebuild(make)]
  774        ),
  775        merge_options(NewOptions, OptsIn, Options)
  776    ;   throw(error(existence_error(key, version, Dir),_))
  777    ).
  778pack_default_options(URL, Pack, OptsIn, Options) :-      % (7)
  779    pack_version_file(Pack, Version, URL),
  780    download_url(URL),
  781    !,
  782    available_download_versions(URL, Available, Options),
  783    Available = [URLVersion-LatestURL|_],
  784    NewOptions = [url(LatestURL)|VersionOptions],
  785    version_options(Version, URLVersion, Available, VersionOptions),
  786    merge_options(NewOptions, OptsIn, Options).
  787pack_default_options(Pack, Pack, Options, Options) :-    % (8)
  788    \+ uri_is_global(Pack).
  789
  790version_options(Version, Version, _, [version(Version)]) :- !.
  791version_options(Version, _, Available, [versions(Available)]) :-
  792    sub_atom(Version, _, _, _, *),
  793    !.
  794version_options(_, _, _, []).
  795
  796%!  pack_install_dir(-PackDir, +Options) is det.
  797%
  798%   Determine the directory below which to  install new packs. This find
  799%   or creates a writeable directory.  Options:
  800%
  801%     - pack_directory(+PackDir)
  802%       Use PackDir. PackDir is created if it does not exist.
  803%     - global(+Boolean)
  804%       If `true`, find a writeable global directory based on the
  805%       file search path `common_app_data`.  If `false`, find a
  806%       user-specific writeable directory based on `user_app_data`
  807%     - If neither of the above is given, use the search path
  808%       `pack`.
  809%
  810%   If no writeable directory is found, generate possible location where
  811%   this directory can be created and  ask   the  user  to create one of
  812%   them.
  813
  814pack_install_dir(PackDir, Options) :-
  815    option(pack_directory(PackDir), Options),
  816    ensure_directory(PackDir),
  817    !.
  818pack_install_dir(PackDir, Options) :-
  819    base_alias(Alias, Options),
  820    absolute_file_name(Alias, PackDir,
  821                       [ file_type(directory),
  822                         access(write),
  823                         file_errors(fail)
  824                       ]),
  825    !.
  826pack_install_dir(PackDir, Options) :-
  827    pack_create_install_dir(PackDir, Options).
  828
  829base_alias(Alias, Options) :-
  830    option(global(true), Options),
  831    !,
  832    Alias = common_app_data(pack).
  833base_alias(Alias, Options) :-
  834    option(global(false), Options),
  835    !,
  836    Alias = user_app_data(pack).
  837base_alias(Alias, _Options) :-
  838    Alias = pack('.').
  839
  840pack_create_install_dir(PackDir, Options) :-
  841    base_alias(Alias, Options),
  842    findall(Candidate = create_dir(Candidate),
  843            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  844              \+ exists_file(Candidate),
  845              \+ exists_directory(Candidate),
  846              file_directory_name(Candidate, Super),
  847              (   exists_directory(Super)
  848              ->  access_file(Super, write)
  849              ;   true
  850              )
  851            ),
  852            Candidates0),
  853    list_to_set(Candidates0, Candidates),   % keep order
  854    pack_create_install_dir(Candidates, PackDir, Options).
  855
  856pack_create_install_dir(Candidates, PackDir, Options) :-
  857    Candidates = [Default=_|_],
  858    !,
  859    append(Candidates, [cancel=cancel], Menu),
  860    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  861    Selected \== cancel,
  862    (   catch(make_directory_path(Selected), E,
  863              (print_message(warning, E), fail))
  864    ->  PackDir = Selected
  865    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  866        pack_create_install_dir(Remaining, PackDir, Options)
  867    ).
  868pack_create_install_dir(_, _, _) :-
  869    print_message(error, pack(cannot_create_dir(pack(.)))),
  870    fail.
  871
  872%!  pack_unpack_from_local(+Source, +PackTopDir, +Name, -PackDir, +Options)
  873%
  874%   Unpack a package from a  local  media.   If  Source  is a directory,
  875%   either copy or link the directory. Else,   Source must be an archive
  876%   file. Options:
  877%
  878%      - link(+Boolean)
  879%        If the source is a directory, link or copy the directory?
  880%      - upgrade(true)
  881%        If the target is already there, wipe it and make a clean
  882%        install.
  883
  884pack_unpack_from_local(Source0, PackTopDir, Name, PackDir, Options) :-
  885    exists_directory(Source0),
  886    remove_slash(Source0, Source),
  887    !,
  888    directory_file_path(PackTopDir, Name, PackDir),
  889    (   option(link(true), Options)
  890    ->  (   same_file(Source, PackDir)
  891        ->  true
  892        ;   remove_existing_pack(PackDir, Options),
  893            atom_concat(PackTopDir, '/', PackTopDirS),
  894            relative_file_name(Source, PackTopDirS, RelPath),
  895            link_file(RelPath, PackDir, symbolic),
  896            assertion(same_file(Source, PackDir))
  897        )
  898    ;   \+ option(git(false), Options),
  899        is_git_directory(Source)
  900    ->  remove_existing_pack(PackDir, Options),
  901        run_process(path(git), [clone, Source, PackDir], [])
  902    ;   prepare_pack_dir(PackDir, Options),
  903        copy_directory(Source, PackDir)
  904    ).
  905pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :-
  906    exists_file(Source),
  907    directory_file_path(PackTopDir, Name, PackDir),
  908    prepare_pack_dir(PackDir, Options),
  909    pack_unpack(Source, PackDir, Name, Options).
  910
  911%!  pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
  912%
  913%   Unpack an archive to the given package dir.
  914%
  915%   @tbd If library(archive) is  not  provided   we  could  check  for a
  916%   suitable external program such as `tar` or `unzip`.
  917
  918:- if(exists_source(library(archive))).  919pack_unpack(Source, PackDir, Pack, Options) :-
  920    ensure_loaded_archive,
  921    pack_archive_info(Source, Pack, _Info, StripOptions),
  922    prepare_pack_dir(PackDir, Options),
  923    archive_extract(Source, PackDir,
  924                    [ exclude(['._*'])          % MacOS resource forks
  925                    | StripOptions
  926                    ]).
  927:- else.  928pack_unpack(_,_,_,_) :-
  929    existence_error(library, archive).
  930:- endif.  931
  932%!  pack_install_local(:Spec, +Dir, +Options) is det.
  933%
  934%   Install a number of packages in   a  local directory. This predicate
  935%   supports installing packages local  to   an  application rather than
  936%   globally.
  937
  938pack_install_local(M:Gen, Dir, Options) :-
  939    findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs),
  940    pack_install_set(Pairs, Dir, Options).
  941
  942pack_install_set(Pairs, Dir, Options) :-
  943    must_be(list(pair), Pairs),
  944    ensure_directory(Dir),
  945    partition(known_media, Pairs, Local, Remote),
  946    maplist(pack_options_to_versions, Local, LocalVersions),
  947    (   Remote == []
  948    ->  AllVersions = LocalVersions
  949    ;   pairs_keys(Remote, Packs),
  950        prolog_description(Properties),
  951        query_pack_server(versions(Packs, Properties), Result, Options),
  952        (   Result = true(RemoteVersions)
  953        ->  append(LocalVersions, RemoteVersions, AllVersions)
  954        ;   print_message(error, pack(query_failed(Result))),
  955            fail
  956        )
  957    ),
  958    local_packs(Dir, Existing),
  959    pack_resolve(Pairs, Existing, AllVersions, Plan0, Options),
  960    !,                                      % for now, only first plan
  961    maplist(hsts_info(Options), Plan0, Plan),
  962    Options1 = [pack_directory(Dir)|Options],
  963    download_plan(Pairs, Plan, PlanB, Options1),
  964    register_downloads(PlanB, Options),
  965    maplist(update_automatic, PlanB),
  966    build_plan(PlanB, Built, Options1),
  967    publish_download(PlanB, Options),
  968    work_done(Pairs, Plan, PlanB, Built, Options).
  969
  970hsts_info(Options, Info0, Info) :-
  971    hsts(Info0.get(url), URL, Options),
  972    !,
  973    Info = Info0.put(url, URL).
  974hsts_info(_Options, Info, Info).
  975
  976%!  known_media(+Pair) is semidet.
  977%
  978%   True when the options specify installation   from  a known media. If
  979%   that applies to all packs, there is no  need to query the server. We
  980%   first  download  and  unpack  the  known  media,  then  examine  the
  981%   requirements and, if necessary, go to the server to resolve these.
  982
  983known_media(_-Options) :-
  984    option(url(_), Options).
  985
  986%!  pack_resolve(+Pairs, +Existing, +Versions, -Plan, +Options) is det.
  987%
  988%   Generate an installation plan. Pairs is a list of Pack-Options pairs
  989%   that  specifies  the  desired  packages.  Existing   is  a  list  of
  990%   pack(Pack, i, Title, Version, URL) terms that represents the already
  991%   installed packages. Versions  is  obtained   from  the  server.  See
  992%   `pack.pl` from the web server for  details. On success, this results
  993%   in a Plan to satisfies  the  requirements.   The  plan  is a list of
  994%   packages to install with  their  location.   The  steps  satisfy the
  995%   partial  ordering  of  dependencies,  such   that  dependencies  are
  996%   installed before the dependents.  Options:
  997%
  998%     - upgrade(true)
  999%       When specified, we try to install the latest version of all
 1000%       the packages.  Otherwise, we try to minimise the installation.
 1001
 1002pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
 1003    insert_existing(Existing, Versions, AllVersions, Options),
 1004    phrase(select_version(Pairs, AllVersions,
 1005                          [ plan(PlanA),           % access to plan
 1006                            dependency_for([])     % dependencies
 1007                          | Options
 1008                          ]),
 1009           PlanA),
 1010    mark_installed(PlanA, Existing, Plan).
 1011
 1012%!  insert_existing(+Existing, +Available, -Candidates, +Options) is det.
 1013%
 1014%   Combine the already existing packages  with   the  ones  reported as
 1015%   available by the server to a list of Candidates, where the candidate
 1016%   of  each  package  is   ordered    according   by  preference.  When
 1017%   upgrade(true) is specified, the existing is   merged into the set of
 1018%   Available versions. Otherwise Existing is prepended to Available, so
 1019%   it is selected as first.
 1020
 1021:- det(insert_existing/4). 1022insert_existing(Existing, [], Versions, _Options) =>
 1023    maplist(existing_to_versions, Existing, Versions).
 1024insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options),
 1025    select(Installed, Existing, Existing2),
 1026    Installed.pack == Pack =>
 1027    can_upgrade(Installed, Versions, Installed2),
 1028    insert_existing_(Installed2, Versions, AllVersions, Options),
 1029    AllPackVersions = [Pack-AllVersions|T],
 1030    insert_existing(Existing2, T0, T, Options).
 1031insert_existing(Existing, [H|T0], AllVersions, Options) =>
 1032    AllVersions = [H|T],
 1033    insert_existing(Existing, T0, T, Options).
 1034
 1035existing_to_versions(Installed, Pack-[Version-[Installed]]) :-
 1036    Pack = Installed.pack,
 1037    Version = Installed.version.
 1038
 1039insert_existing_(Installed, Versions, AllVersions, Options) :-
 1040    option(upgrade(true), Options),
 1041    !,
 1042    insert_existing_(Installed, Versions, AllVersions).
 1043insert_existing_(Installed, Versions, AllVersions, _) :-
 1044    AllVersions = [Installed.version-[Installed]|Versions].
 1045
 1046insert_existing_(Installed, [H|T0], [H|T]) :-
 1047    H = V0-_Infos,
 1048    cmp_versions(>, V0, Installed.version),
 1049    !,
 1050    insert_existing_(Installed, T0, T).
 1051insert_existing_(Installed, [H0|T], [H|T]) :-
 1052    H0 = V0-Infos,
 1053    V0 == Installed.version,
 1054    !,
 1055    H = V0-[Installed|Infos].
 1056insert_existing_(Installed, Versions, All) :-
 1057    All =  [Installed.version-[Installed]|Versions].
 1058
 1059%!  can_upgrade(+Installed, +Versions, -Installed2) is det.
 1060%
 1061%   Add a `latest_version` key to Installed if its version is older than
 1062%   the latest available version.
 1063
 1064can_upgrade(Info, [Version-_|_], Info2) :-
 1065    cmp_versions(>, Version, Info.version),
 1066    !,
 1067    Info2 = Info.put(latest_version, Version).
 1068can_upgrade(Info, _, Info).
 1069
 1070%!  mark_installed(+PlanA, +Existing, -Plan) is det.
 1071%
 1072%   Mark  already  up-to-date  packs  from  the   plan  and  add  a  key
 1073%   `upgrade:true` to elements of PlanA  in   Existing  that are not the
 1074%   same.
 1075
 1076mark_installed([], _, []).
 1077mark_installed([Info|T], Existing, Plan) :-
 1078    (   member(Installed, Existing),
 1079        Installed.pack == Info.pack
 1080    ->  (   (   Installed.git == true
 1081            ->  Info.git == true,
 1082                Installed.hash == Info.hash
 1083            ;   Version = Info.get(version)
 1084            ->  Installed.version == Version
 1085            )
 1086        ->  Plan = [Info.put(keep, true)|PlanT]    % up-to-date
 1087        ;   Plan = [Info.put(upgrade, Installed)|PlanT] % needs upgrade
 1088        )
 1089    ;   Plan = [Info|PlanT]                        % new install
 1090    ),
 1091    mark_installed(T, Existing, PlanT).
 1092
 1093%!  select_version(+PackAndOptions, +Available, +Options)// is nondet.
 1094%
 1095%   True when the output is a list of   pack info dicts that satisfy the
 1096%   installation requirements of PackAndOptions from  the packs known to
 1097%   be Available.
 1098
 1099select_version([], _, _) -->
 1100    [].
 1101select_version([Pack-PackOptions|More], Versions, Options) -->
 1102    { memberchk(Pack-PackVersions, Versions),
 1103      member(Version-Infos, PackVersions),
 1104      compatible_version(Pack, Version, PackOptions),
 1105      member(Info, Infos),
 1106      pack_options_compatible_with_info(Info, PackOptions),
 1107      pack_satisfies(Pack, Version, Info, Info2, PackOptions),
 1108      all_downloads(PackVersions, Downloads)
 1109    },
 1110    add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}),
 1111                Versions, Options),
 1112    select_version(More, Versions, Options).
 1113select_version([Pack-_PackOptions|_More], _Versions, _Options) -->
 1114    { existence_error(pack, Pack) }.               % or warn and continue?
 1115
 1116all_downloads(PackVersions, AllDownloads) :-
 1117    aggregate_all(sum(Downloads),
 1118                  ( member(_Version-Infos, PackVersions),
 1119                    member(Info, Infos),
 1120                    get_dict(downloads, Info, Downloads)
 1121                  ),
 1122                  AllDownloads).
 1123
 1124add_requirements([], _, _) -->
 1125    [].
 1126add_requirements([H|T], Versions, Options) -->
 1127    { is_prolog_token(H),
 1128      !,
 1129      prolog_satisfies(H)
 1130    },
 1131    add_requirements(T, Versions, Options).
 1132add_requirements([H|T], Versions, Options) -->
 1133    { member(Pack-PackVersions, Versions),
 1134      member(Version-Infos, PackVersions),
 1135      member(Info, Infos),
 1136      (   Provides = @(Pack,Version)
 1137      ;   member(Provides, Info.get(provides))
 1138      ),
 1139      satisfies_req(Provides, H),
 1140      all_downloads(PackVersions, Downloads)
 1141    },
 1142    add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}),
 1143                Versions, Options),
 1144    add_requirements(T, Versions, Options).
 1145
 1146%!  add_to_plan(+Info, +Versions, +Options) is semidet.
 1147%
 1148%   Add Info to the plan. If an Info   about the same pack is already in
 1149%   the plan, but this is a different version  of the pack, we must fail
 1150%   as we cannot install two different versions of a pack.
 1151
 1152add_to_plan(Info, _Versions, Options) -->
 1153    { option(plan(Plan), Options),
 1154      member_nonvar(Planned, Plan),
 1155      Planned.pack == Info.pack,
 1156      !,
 1157      same_version(Planned, Info)                  % same pack, different version
 1158    }.
 1159add_to_plan(Info, _Versions, _Options) -->
 1160    { member(Conflict, Info.get(conflicts)),
 1161      is_prolog_token(Conflict),
 1162      prolog_satisfies(Conflict),
 1163      !,
 1164      fail                                         % incompatible with this Prolog
 1165    }.
 1166add_to_plan(Info, _Versions, Options) -->
 1167    { option(plan(Plan), Options),
 1168      member_nonvar(Planned, Plan),
 1169      info_conflicts(Info, Planned),               % Conflicts with a planned pack
 1170      !,
 1171      fail
 1172    }.
 1173add_to_plan(Info, Versions, Options) -->
 1174    { select_option(dependency_for(Dep0), Options, Options1),
 1175      Options2 = [dependency_for([Info.pack|Dep0])|Options1],
 1176      (   Dep0 = [DepFor|_]
 1177      ->  add_dependency_for(DepFor, Info, Info1)
 1178      ;   Info1 = Info
 1179      )
 1180    },
 1181    [Info1],
 1182    add_requirements(Info.get(requires,[]), Versions, Options2).
 1183
 1184add_dependency_for(Pack, Info, Info) :-
 1185    Old = Info.get(dependency_for),
 1186    !,
 1187    b_set_dict(dependency_for, Info, [Pack|Old]).
 1188add_dependency_for(Pack, Info0, Info) :-
 1189    Info = Info0.put(dependency_for, [Pack]).
 1190
 1191same_version(Info, Info) :-
 1192    !.
 1193same_version(Planned, Info) :-
 1194    Hash = Planned.get(hash),
 1195    Hash \== (-),
 1196    !,
 1197    Hash == Info.get(hash).
 1198same_version(Planned, Info) :-
 1199    Planned.get(version) == Info.get(version).
 1200
 1201%!  info_conflicts(+Info1, +Info2) is semidet.
 1202%
 1203%   True if Info2 is in conflict with Info2. The relation is symetric.
 1204
 1205info_conflicts(Info, Planned) :-
 1206    info_conflicts_(Info, Planned),
 1207    !.
 1208info_conflicts(Info, Planned) :-
 1209    info_conflicts_(Planned, Info),
 1210    !.
 1211
 1212info_conflicts_(Info, Planned) :-
 1213    member(Conflict, Info.get(conflicts)),
 1214    \+ is_prolog_token(Conflict),
 1215    info_provides(Planned, Provides),
 1216    satisfies_req(Provides, Conflict),
 1217    !.
 1218
 1219info_provides(Info, Provides) :-
 1220    (   Provides = Info.pack@Info.version
 1221    ;   member(Provides, Info.get(provides))
 1222    ).
 1223
 1224%!  pack_satisfies(+Pack, +Version, +Info0, -Info, +Options) is semidet.
 1225%
 1226%   True if Pack@Version  with  Info   satisfies  the  pack installation
 1227%   options provided by Options.
 1228
 1229pack_satisfies(_Pack, _Version, Info0, Info, Options) :-
 1230    option(commit('HEAD'), Options),
 1231    !,
 1232    Info0.get(git) == true,
 1233    Info = Info0.put(commit, 'HEAD').
 1234pack_satisfies(_Pack, _Version, Info, Info, Options) :-
 1235    option(commit(Commit), Options),
 1236    !,
 1237    Commit == Info.get(hash).
 1238pack_satisfies(Pack, Version, Info, Info, Options) :-
 1239    option(version(ReqVersion), Options),
 1240    !,
 1241    satisfies_version(Pack, Version, ReqVersion).
 1242pack_satisfies(_Pack, _Version, Info, Info, _Options).
 1243
 1244%!  satisfies_version(+Pack, +PackVersion, +RequiredVersion) is semidet.
 1245
 1246satisfies_version(Pack, Version, ReqVersion) :-
 1247    catch(require_version(pack(Pack), Version, ReqVersion),
 1248          error(version_error(pack(Pack), Version, ReqVersion),_),
 1249          fail).
 1250
 1251%!  satisfies_req(+Provides, +Required) is semidet.
 1252%
 1253%   Check a token requirements.
 1254
 1255satisfies_req(Token, Token) => true.
 1256satisfies_req(@(Token,_), Token) => true.
 1257satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
 1258	cmp_versions(Cmp, PrvVersion, ReqVersion).
 1259satisfies_req(_,_) => fail.
 1260
 1261cmp(Token  < Version, Token, <,	 Version).
 1262cmp(Token =< Version, Token, =<, Version).
 1263cmp(Token =  Version, Token, =,	 Version).
 1264cmp(Token == Version, Token, ==, Version).
 1265cmp(Token >= Version, Token, >=, Version).
 1266cmp(Token >  Version, Token, >,	 Version).
 1267
 1268%!  pack_options_to_versions(+PackOptionsPair, -Versions) is det.
 1269%
 1270%   Create an available  package  term  from   Pack  and  Options  if it
 1271%   contains a url(URL) option. This allows installing packages that are
 1272%   not known to the server. In most cases, the URL will be a git URL or
 1273%   the URL to download an archive. It can  also be a ``file://`` url to
 1274%   install from a local archive.
 1275%
 1276%   The   first   clause   deals    with     a    wildcard    URL.   See
 1277%   pack_default_options/4, case (7).
 1278
 1279:- det(pack_options_to_versions/2). 1280pack_options_to_versions(Pack-PackOptions, Pack-Versions) :-
 1281    option(versions(Available), PackOptions), !,
 1282    maplist(version_url_info(Pack, PackOptions), Available, Versions).
 1283pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :-
 1284    option(url(URL), PackOptions),
 1285    findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
 1286    dict_create(Info, #,
 1287                [ pack-Pack,
 1288                  url-URL
 1289                | Pairs
 1290                ]),
 1291    Version = Info.get(version, '0.0.0').
 1292
 1293version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :-
 1294    findall(Prop,
 1295            ( option_info_prop(PackOptions, Prop),
 1296              Prop \= version-_
 1297            ),
 1298            Pairs),
 1299    dict_create(Info, #,
 1300                [ pack-Pack,
 1301                  url-URL,
 1302                  version-Version
 1303                | Pairs
 1304                ]).
 1305
 1306option_info_prop(PackOptions, Prop-Value) :-
 1307    option_info(Prop),
 1308    Opt =.. [Prop,Value],
 1309    option(Opt, PackOptions).
 1310
 1311option_info(git).
 1312option_info(hash).
 1313option_info(version).
 1314option_info(branch).
 1315option_info(link).
 1316
 1317%!  compatible_version(+Pack, +Version, +Options) is semidet.
 1318%
 1319%   Fails if Options demands a  version   and  Version is not compatible
 1320%   with Version.
 1321
 1322compatible_version(Pack, Version, PackOptions) :-
 1323    option(version(ReqVersion), PackOptions),
 1324    !,
 1325    satisfies_version(Pack, Version, ReqVersion).
 1326compatible_version(_, _, _).
 1327
 1328%!  pack_options_compatible_with_info(+Info, +PackOptions) is semidet.
 1329%
 1330%   Ignore information from the server  that   is  incompatible with the
 1331%   request.
 1332
 1333pack_options_compatible_with_info(Info, PackOptions) :-
 1334    findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
 1335    dict_create(Dict, _, Pairs),
 1336    Dict >:< Info.
 1337
 1338%!  download_plan(+Targets, +Plan, +Options) is semidet.
 1339%
 1340%   Download or update all packages from Plan. We   need to do this as a
 1341%   first  step  because  we  may    not  have  (up-to-date)  dependency
 1342%   information about all packs. For example, a pack may be installed at
 1343%   the git HEAD revision that is not yet   know to the server or it may
 1344%   be installed from a url that is not known at all at the server.
 1345
 1346download_plan(_Targets, Plan, Plan, _Options) :-
 1347    exclude(installed, Plan, []),
 1348    !.
 1349download_plan(Targets, Plan0, Plan, Options) :-
 1350    confirm(download_plan(Plan0), yes, Options),
 1351    maplist(download_from_info(Options), Plan0, Plan1),
 1352    plan_unsatisfied_dependencies(Plan1, Deps),
 1353    (   Deps == []
 1354    ->  Plan = Plan1
 1355    ;   print_message(informational, pack(new_dependencies(Deps))),
 1356        prolog_description(Properties),
 1357        query_pack_server(versions(Deps, Properties), Result, []),
 1358        (   Result = true(Versions)
 1359        ->  pack_resolve(Targets, Plan1, Versions, Plan2, Options),
 1360            !,
 1361            download_plan(Targets, Plan2, Plan, Options)
 1362        ;   print_message(error, pack(query_failed(Result))),
 1363            fail
 1364        )
 1365    ).
 1366
 1367%!  plan_unsatisfied_dependencies(+Plan, -Deps) is det.
 1368%
 1369%   True when Deps is a list of dependency   tokens  in Plan that is not
 1370%   satisfied.
 1371
 1372plan_unsatisfied_dependencies(Plan, Deps) :-
 1373    phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps).
 1374
 1375plan_unsatisfied_dependencies([], _) -->
 1376    [].
 1377plan_unsatisfied_dependencies([Info|Infos], Plan) -->
 1378    { Deps = Info.get(requires) },
 1379    plan_unsatisfied_requirements(Deps, Plan),
 1380    plan_unsatisfied_dependencies(Infos, Plan).
 1381
 1382plan_unsatisfied_requirements([], _) -->
 1383    [].
 1384plan_unsatisfied_requirements([H|T], Plan) -->
 1385    { is_prolog_token(H),           % Can this fail?
 1386      prolog_satisfies(H)
 1387    },
 1388    !,
 1389    plan_unsatisfied_requirements(T, Plan).
 1390plan_unsatisfied_requirements([H|T], Plan) -->
 1391    { member(Info, Plan),
 1392      (   (   Version = Info.get(version)
 1393          ->  Provides = @(Info.get(pack), Version)
 1394          ;   Provides = Info.get(pack)
 1395          )
 1396      ;   member(Provides, Info.get(provides))
 1397      ),
 1398      satisfies_req(Provides, H)
 1399    }, !,
 1400    plan_unsatisfied_requirements(T, Plan).
 1401plan_unsatisfied_requirements([H|T], Plan) -->
 1402    [H],
 1403    plan_unsatisfied_requirements(T, Plan).
 1404
 1405
 1406%!  build_plan(+Plan, -Built, +Options) is det.
 1407%
 1408%    Run post installation steps.  We   build  dependencies before their
 1409%    dependents, so we first do a topological sort on the packs based on
 1410%    the pack dependencies.
 1411
 1412build_plan(Plan, Ordered, Options) :-
 1413    partition(needs_rebuild_from_info(Options), Plan, ToBuild, NoBuild),
 1414    maplist(attach_from_info(Options), NoBuild),
 1415    (   ToBuild == []
 1416    ->  Ordered = []
 1417    ;   order_builds(ToBuild, Ordered),
 1418        confirm(build_plan(Ordered), yes, Options),
 1419        maplist(exec_plan_rebuild_step(Options), Ordered)
 1420    ).
 1421
 1422needs_rebuild_from_info(Options, Info) :-
 1423    needs_rebuild(Info.installed, Options).
 1424
 1425%!  needs_rebuild(+PackDir, +Options) is semidet.
 1426%
 1427%   True when we need to rebuilt the pack in PackDir.
 1428
 1429needs_rebuild(PackDir, Options) :-
 1430    (   is_foreign_pack(PackDir, _),
 1431        \+ is_built(PackDir, Options)
 1432    ->  true
 1433    ;   is_autoload_pack(PackDir, Options),
 1434        post_install_autoload(PackDir, Options),
 1435        fail
 1436    ).
 1437
 1438%!  is_built(+PackDir, +Options) is semidet.
 1439%
 1440%   True if the pack in PackDir has been built.
 1441%
 1442%   @tbd We now verify it was built by   the exact same version. That is
 1443%   normally an overkill.
 1444
 1445is_built(PackDir, _Options) :-
 1446    current_prolog_flag(arch, Arch),
 1447    prolog_version_dotted(Version), % Major.Minor.Patch
 1448    pack_status_dir(PackDir, built(Arch, Version, _)).
 1449
 1450%!  order_builds(+ToBuild, -Ordered) is det.
 1451%
 1452%   Order the build  processes  by   building  dependencies  before  the
 1453%   packages that rely on them as they may need them during the build.
 1454
 1455order_builds(ToBuild, Ordered) :-
 1456    findall(Pack-Dep, dep_edge(ToBuild, Pack, Dep), Edges),
 1457    maplist(get_dict(pack), ToBuild, Packs),
 1458    vertices_edges_to_ugraph(Packs, Edges, Graph),
 1459    ugraph_layers(Graph, Layers),
 1460    append(Layers, PackNames),
 1461    maplist(pack_info_from_name(ToBuild), PackNames, Ordered).
 1462
 1463dep_edge(Infos, Pack, Dep) :-
 1464    member(Info, Infos),
 1465    Pack = Info.pack,
 1466    member(Dep, Info.get(dependency_for)),
 1467    (   member(DepInfo, Infos),
 1468        DepInfo.pack == Dep
 1469    ->  true
 1470    ).
 1471
 1472:- det(pack_info_from_name/3). 1473pack_info_from_name(Infos, Pack, Info) :-
 1474    member(Info, Infos),
 1475    Info.pack == Pack,
 1476    !.
 1477
 1478%!  exec_plan_rebuild_step(+Options, +Info) is det.
 1479%
 1480%   Execute the rebuild steps for the given Info.
 1481
 1482exec_plan_rebuild_step(Options, Info) :-
 1483    print_message(informational, pack(build(Info.pack, Info.installed))),
 1484    pack_post_install(Info.pack, Info.installed, Options),
 1485    attach_from_info(Options, Info).
 1486
 1487%!  attach_from_info(+Options, +Info) is det.
 1488%
 1489%   Make the package visible.  Similar to pack_make_available/3.
 1490
 1491attach_from_info(_Options, Info) :-
 1492    Info.get(keep) == true,
 1493    !.
 1494attach_from_info(Options, Info) :-
 1495    (   option(pack_directory(_Parent), Options)
 1496    ->  pack_attach(Info.installed, [duplicate(replace)])
 1497    ;   pack_attach(Info.installed, [])
 1498    ).
 1499
 1500%!  download_from_info(+Options, +Info0, -Info) is det.
 1501%
 1502%   Download a package guided by Info. Note   that this does __not__ run
 1503%   any scripts. This implies that dependencies do not matter and we can
 1504%   proceed in any order. This is important  because we may use packages
 1505%   at their git HEAD, which implies  that requirements may be different
 1506%   from what is in the Info terms.
 1507
 1508download_from_info(Options, Info0, Info), option(dryrun(true), Options) =>
 1509    print_term(Info0, [nl(true)]),
 1510    Info = Info0.
 1511download_from_info(_Options, Info0, Info), installed(Info0) =>
 1512    Info = Info0.
 1513download_from_info(_Options, Info0, Info),
 1514    _{upgrade:OldInfo, git:true} :< Info0,
 1515    is_git_directory(OldInfo.installed) =>
 1516    PackDir = OldInfo.installed,
 1517    git_checkout_version(PackDir, [commit(Info0.hash)]),
 1518    reload_info(PackDir, Info0, Info).
 1519download_from_info(Options, Info0, Info),
 1520    _{upgrade:OldInfo} :< Info0 =>
 1521    PackDir = OldInfo.installed,
 1522    detach_pack(OldInfo.pack, PackDir),
 1523    delete_directory_and_contents(PackDir),
 1524    del_dict(upgrade, Info0, _, Info1),
 1525    download_from_info(Options, Info1, Info).
 1526download_from_info(Options, Info0, Info),
 1527    _{url:URL, git:true} :< Info0, \+ have_git =>
 1528    git_archive_url(URL, Archive, Options),
 1529    download_from_info([git_url(URL)|Options],
 1530                       Info0.put(_{ url:Archive,
 1531                                    git:false,
 1532                                    git_url:URL
 1533                                  }),
 1534                       Info1),
 1535                                % restore the hash to register the download.
 1536    (   Info1.get(version) == Info0.get(version),
 1537        Hash = Info0.get(hash)
 1538    ->  Info = Info1.put(hash, Hash)
 1539    ;   Info = Info1
 1540    ).
 1541download_from_info(Options, Info0, Info),
 1542    _{url:URL} :< Info0 =>
 1543    select_option(pack_directory(Dir), Options, Options1),
 1544    select_option(version(_), Options1, Options2, _),
 1545    download_info_extra(Info0, InstallOptions, Options2),
 1546    pack_download_from_url(URL, Dir, Info0.pack,
 1547                           [ interactive(false),
 1548                             pack_dir(PackDir)
 1549                           | InstallOptions
 1550                           ]),
 1551    reload_info(PackDir, Info0, Info).
 1552
 1553download_info_extra(Info, [git(true),commit(Hash)|Options], Options) :-
 1554    Info.get(git) == true,
 1555    !,
 1556    Hash = Info.get(commit, 'HEAD').
 1557download_info_extra(Info, [link(true)|Options], Options) :-
 1558    Info.get(link) == true,
 1559    !.
 1560download_info_extra(_, Options, Options).
 1561
 1562installed(Info) :-
 1563    _ = Info.get(installed).
 1564
 1565detach_pack(Pack, PackDir) :-
 1566    (   current_pack(Pack, PackDir)
 1567    ->  '$pack_detach'(Pack, PackDir)
 1568    ;   true
 1569    ).
 1570
 1571%!  reload_info(+PackDir, +Info0, -Info) is det.
 1572%
 1573%   Update the requires and provides metadata. Info0 is what we got from
 1574%   the server, but the package may be   different  as we may have asked
 1575%   for the git HEAD or the package URL   may not have been known by the
 1576%   server at all.
 1577
 1578reload_info(_PackDir, Info, Info) :-
 1579    _ = Info.get(installed),	% we read it from the package
 1580    !.
 1581reload_info(PackDir, Info0, Info) :-
 1582    local_pack_info(PackDir, Info1),
 1583    Info = Info0.put(installed, PackDir)
 1584                .put(downloaded, Info0.url)
 1585                .put(Info1).
 1586
 1587%!  work_done(+Targets, +Plan, +PlanB, +Built, +Options) is det.
 1588%
 1589%   Targets has successfully been installed  and   the  packs Built have
 1590%   successfully ran their build scripts.
 1591
 1592work_done(_, _, _, _, Options),
 1593    option(silent(true), Options) =>
 1594    true.
 1595work_done(Targets, Plan, Plan, [], _Options) =>
 1596    convlist(can_upgrade_target(Plan), Targets, CanUpgrade),
 1597    (   CanUpgrade == []
 1598    ->  pairs_keys(Targets, Packs),
 1599        print_message(informational, pack(up_to_date(Packs)))
 1600    ;   print_message(informational, pack(installed_can_upgrade(CanUpgrade)))
 1601    ).
 1602work_done(_, _, _, _, _) =>
 1603    true.
 1604
 1605can_upgrade_target(Plan, Pack-_, Info) =>
 1606    member(Info, Plan),
 1607    Info.pack == Pack,
 1608    !,
 1609    _ = Info.get(latest_version).
 1610
 1611%!  local_packs(+Dir, -Packs) is det.
 1612%
 1613%   True when Packs  is  a  list   with  information  for  all installed
 1614%   packages.
 1615
 1616local_packs(Dir, Packs) :-
 1617    findall(Pack, pack_in_subdir(Dir, Pack), Packs).
 1618
 1619pack_in_subdir(Dir, Info) :-
 1620    directory_member(Dir, PackDir,
 1621                     [ file_type(directory),
 1622                       hidden(false)
 1623                     ]),
 1624    local_pack_info(PackDir, Info).
 1625
 1626local_pack_info(PackDir,
 1627                #{ pack: Pack,
 1628                   version: Version,
 1629                   title: Title,
 1630                   hash: Hash,
 1631                   url: URL,
 1632                   git: IsGit,
 1633                   requires: Requires,
 1634                   provides: Provides,
 1635                   conflicts: Conflicts,
 1636                   installed: PackDir
 1637                 }) :-
 1638    directory_file_path(PackDir, 'pack.pl', MetaFile),
 1639    exists_file(MetaFile),
 1640    file_base_name(PackDir, DirName),
 1641    findall(Term, pack_dir_info(PackDir, _, Term), Info),
 1642    option(pack(Pack), Info, DirName),
 1643    option(title(Title), Info, '<no title>'),
 1644    option(version(Version), Info, '<no version>'),
 1645    option(download(URL), Info, '<no download url>'),
 1646    findall(Req, member(requires(Req), Info), Requires),
 1647    findall(Prv, member(provides(Prv), Info), Provides),
 1648    findall(Cfl, member(conflicts(Cfl), Info), Conflicts),
 1649    (   have_git,
 1650        is_git_directory(PackDir)
 1651    ->  git_hash(Hash, [directory(PackDir)]),
 1652        IsGit = true
 1653    ;   Hash = '-',
 1654        IsGit = false
 1655    ).
 1656
 1657
 1658		 /*******************************
 1659		 *        PROLOG VERSIONS	*
 1660		 *******************************/
 1661
 1662%!  prolog_description(-Description) is det.
 1663%
 1664%   Provide a description of the running Prolog system. Version terms:
 1665%
 1666%     - prolog(Dialect, Version)
 1667%
 1668%   @tbd:   establish   a   language    for     features.    Sync   with
 1669%   library(prolog_versions)
 1670
 1671prolog_description([prolog(swi(Version))]) :-
 1672    prolog_version(Version).
 1673
 1674prolog_version(Version) :-
 1675    current_prolog_flag(version_git, Version),
 1676    !.
 1677prolog_version(Version) :-
 1678    prolog_version_dotted(Version).
 1679
 1680prolog_version_dotted(Version) :-
 1681    current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
 1682    VNumbers = [Major, Minor, Patch],
 1683    atomic_list_concat(VNumbers, '.', Version).
 1684
 1685%!  is_prolog_token(+Token) is semidet.
 1686%
 1687%   True when Token describes a property of the target Prolog
 1688%   system.
 1689
 1690is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true.
 1691is_prolog_token(prolog:Feature), atom(Feature) => true.
 1692is_prolog_token(prolog:Feature), flag_value_feature(Feature, _Flag, _Value) =>
 1693    true.
 1694is_prolog_token(_) => fail.
 1695
 1696%!  prolog_satisfies(+Token) is semidet.
 1697%
 1698%   True when the  running  Prolog   system  satisfies  token. Processes
 1699%   requires(Token) terms for
 1700%
 1701%     - prolog Cmp Version
 1702%       Demand a Prolog version (range).
 1703%     - prolog:Flag
 1704%     - prolog:Flag(Value)
 1705%     - prolog:library(Lib)
 1706%
 1707%   @see require_prolog_version/2.
 1708
 1709prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) =>
 1710    prolog_version(CurrentVersion),
 1711    cmp_versions(Cmp, CurrentVersion, ReqVersion).
 1712prolog_satisfies(prolog:library(Lib)), atom(Lib) =>
 1713    exists_source(library(Lib)).
 1714prolog_satisfies(prolog:Feature), atom(Feature) =>
 1715    current_prolog_flag(Feature, true).
 1716prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) =>
 1717    current_prolog_flag(Flag, Value).
 1718
 1719flag_value_feature(Feature, Flag, Value) :-
 1720    compound(Feature),
 1721    compound_name_arguments(Feature, Flag, [Value]),
 1722    atom(Flag).
 1723
 1724
 1725                 /*******************************
 1726                 *             INFO             *
 1727                 *******************************/
 1728
 1729%!  pack_archive_info(+Archive, +Pack, -Info, -Strip)
 1730%
 1731%   True when Archive archives Pack. Info  is unified with the terms
 1732%   from pack.pl in the  pack  and   Strip  is  the strip-option for
 1733%   archive_extract/3.
 1734%
 1735%   Requires library(archive), which is lazily loaded when needed.
 1736%
 1737%   @error  existence_error(pack_file, 'pack.pl') if the archive
 1738%           doesn't contain pack.pl
 1739%   @error  Syntax errors if pack.pl cannot be parsed.
 1740
 1741:- if(exists_source(library(archive))). 1742ensure_loaded_archive :-
 1743    current_predicate(archive_open/3),
 1744    !.
 1745ensure_loaded_archive :-
 1746    use_module(library(archive)).
 1747
 1748pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
 1749    ensure_loaded_archive,
 1750    size_file(Archive, Bytes),
 1751    setup_call_cleanup(
 1752        archive_open(Archive, Handle, []),
 1753        (   repeat,
 1754            (   archive_next_header(Handle, InfoFile)
 1755            ->  true
 1756            ;   !, fail
 1757            )
 1758        ),
 1759        archive_close(Handle)),
 1760    file_base_name(InfoFile, 'pack.pl'),
 1761    atom_concat(Prefix, 'pack.pl', InfoFile),
 1762    strip_option(Prefix, Pack, Strip),
 1763    setup_call_cleanup(
 1764        archive_open_entry(Handle, Stream),
 1765        read_stream_to_terms(Stream, Info),
 1766        close(Stream)),
 1767    !,
 1768    must_be(ground, Info),
 1769    maplist(valid_term(pack_info_term), Info).
 1770:- else. 1771pack_archive_info(_, _, _, _) :-
 1772    existence_error(library, archive).
 1773:- endif. 1774pack_archive_info(_, _, _, _) :-
 1775    existence_error(pack_file, 'pack.pl').
 1776
 1777strip_option('', _, []) :- !.
 1778strip_option('./', _, []) :- !.
 1779strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
 1780    atom_concat(PrefixDir, /, Prefix),
 1781    file_base_name(PrefixDir, Base),
 1782    (   Base == Pack
 1783    ->  true
 1784    ;   pack_version_file(Pack, _, Base)
 1785    ->  true
 1786    ;   \+ sub_atom(PrefixDir, _, _, _, /)
 1787    ).
 1788
 1789read_stream_to_terms(Stream, Terms) :-
 1790    read(Stream, Term0),
 1791    read_stream_to_terms(Term0, Stream, Terms).
 1792
 1793read_stream_to_terms(end_of_file, _, []) :- !.
 1794read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
 1795    read(Stream, Term1),
 1796    read_stream_to_terms(Term1, Stream, Terms).
 1797
 1798
 1799%!  pack_git_info(+GitDir, -Hash, -Info) is det.
 1800%
 1801%   Retrieve info from a cloned git   repository  that is compatible
 1802%   with pack_archive_info/4.
 1803
 1804pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
 1805    exists_directory(GitDir),
 1806    !,
 1807    git_ls_tree(Entries, [directory(GitDir)]),
 1808    git_hash(Hash, [directory(GitDir)]),
 1809    maplist(arg(4), Entries, Sizes),
 1810    sum_list(Sizes, Bytes),
 1811    dir_metadata(GitDir, Info).
 1812
 1813dir_metadata(GitDir, Info) :-
 1814    directory_file_path(GitDir, 'pack.pl', InfoFile),
 1815    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
 1816    maplist(valid_term(pack_info_term), Info).
 1817
 1818%!  download_file_sanity_check(+Archive, +Pack, +Info) is semidet.
 1819%
 1820%   Perform basic sanity checks on DownloadFile
 1821
 1822download_file_sanity_check(Archive, Pack, Info) :-
 1823    info_field(name(PackName), Info),
 1824    info_field(version(PackVersion), Info),
 1825    pack_version_file(PackFile, FileVersion, Archive),
 1826    must_match([Pack, PackName, PackFile], name),
 1827    must_match([PackVersion, FileVersion], version).
 1828
 1829info_field(Field, Info) :-
 1830    memberchk(Field, Info),
 1831    ground(Field),
 1832    !.
 1833info_field(Field, _Info) :-
 1834    functor(Field, FieldName, _),
 1835    print_message(error, pack(missing(FieldName))),
 1836    fail.
 1837
 1838must_match(Values, _Field) :-
 1839    sort(Values, [_]),
 1840    !.
 1841must_match(Values, Field) :-
 1842    print_message(error, pack(conflict(Field, Values))),
 1843    fail.
 1844
 1845
 1846                 /*******************************
 1847                 *         INSTALLATION         *
 1848                 *******************************/
 1849
 1850%!  prepare_pack_dir(+Dir, +Options)
 1851%
 1852%   Prepare for installing the package into  Dir. This
 1853%
 1854%     - If the directory exist and is empty, done.
 1855%     - Else if the directory exists, remove the directory and recreate
 1856%       it. Note that if the directory is a symlink this just deletes
 1857%       the link.
 1858%     - Else if some entry (file, link, ...) exists, delete it and
 1859%       create a new directory.
 1860%     - Else create the directory.
 1861
 1862prepare_pack_dir(Dir, Options) :-
 1863    exists_directory(Dir),
 1864    !,
 1865    (   empty_directory(Dir)
 1866    ->  true
 1867    ;   remove_existing_pack(Dir, Options)
 1868    ->  make_directory(Dir)
 1869    ).
 1870prepare_pack_dir(Dir, _) :-
 1871    (   read_link(Dir, _, _)
 1872    ;   access_file(Dir, exist)
 1873    ),
 1874    !,
 1875    delete_file(Dir),
 1876    make_directory(Dir).
 1877prepare_pack_dir(Dir, _) :-
 1878    make_directory(Dir).
 1879
 1880%!  empty_directory(+Directory) is semidet.
 1881%
 1882%   True if Directory is empty (holds no files or sub-directories).
 1883
 1884empty_directory(Dir) :-
 1885    \+ ( directory_files(Dir, Entries),
 1886         member(Entry, Entries),
 1887         \+ special(Entry)
 1888       ).
 1889
 1890special(.).
 1891special(..).
 1892
 1893%!  remove_existing_pack(+PackDir, +Options) is semidet.
 1894%
 1895%   Remove  a  possible  existing   pack    directory   if   the  option
 1896%   upgrade(true) is present. This is used to remove an old installation
 1897%   before unpacking a new archive, copy or   link  a directory with the
 1898%   new contents.
 1899
 1900remove_existing_pack(PackDir, Options) :-
 1901    exists_directory(PackDir),
 1902    !,
 1903    (   (   option(upgrade(true), Options)
 1904        ;   confirm(remove_existing_pack(PackDir), yes, Options)
 1905        )
 1906    ->  delete_directory_and_contents(PackDir)
 1907    ;   print_message(error, pack(directory_exists(PackDir))),
 1908        fail
 1909    ).
 1910remove_existing_pack(_, _).
 1911
 1912%!  pack_download_from_url(+URL, +PackDir, +Pack, +Options)
 1913%
 1914%   Download a package from a remote   source.  For git repositories, we
 1915%   simply clone. Archives are downloaded. Options:
 1916%
 1917%     - git(true)
 1918%       Assume URL refers to a git repository.
 1919%     - pack_dir(-Dir)
 1920%       Dir is unified with the location where the pack is installed.
 1921%
 1922%   @tbd We currently  use  the  built-in   HTTP  client.  For  complete
 1923%   coverage, we should consider using  an   external  (e.g., `curl`) if
 1924%   available.
 1925
 1926pack_download_from_url(URL, PackTopDir, Pack, Options) :-
 1927    option(git(true), Options),
 1928    !,
 1929    directory_file_path(PackTopDir, Pack, PackDir),
 1930    prepare_pack_dir(PackDir, Options),
 1931    (   option(branch(Branch), Options)
 1932    ->  Extra = ['--branch', Branch]
 1933    ;   Extra = []
 1934    ),
 1935    run_process(path(git), [clone, URL, PackDir|Extra], []),
 1936    git_checkout_version(PackDir, [update(false)|Options]),
 1937    option(pack_dir(PackDir), Options, _).
 1938pack_download_from_url(URL0, PackTopDir, Pack, Options) :-
 1939    download_url(URL0),
 1940    !,
 1941    hsts(URL0, URL, Options),
 1942    directory_file_path(PackTopDir, Pack, PackDir),
 1943    prepare_pack_dir(PackDir, Options),
 1944    pack_download_dir(PackTopDir, DownLoadDir),
 1945    download_file(URL, Pack, DownloadBase, Options),
 1946    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1947    (   option(insecure(true), Options, false)
 1948    ->  TLSOptions = [cert_verify_hook(ssl_verify)]
 1949    ;   TLSOptions = []
 1950    ),
 1951    print_message(informational, pack(download(begin, Pack, URL, DownloadFile))),
 1952    setup_call_cleanup(
 1953        http_open(URL, In, TLSOptions),
 1954        setup_call_cleanup(
 1955            open(DownloadFile, write, Out, [type(binary)]),
 1956            copy_stream_data(In, Out),
 1957            close(Out)),
 1958        close(In)),
 1959    print_message(informational, pack(download(end, Pack, URL, DownloadFile))),
 1960    pack_archive_info(DownloadFile, Pack, Info, _),
 1961    (   option(git_url(GitURL), Options)
 1962    ->  Origin = GitURL                 % implicit download from git.
 1963    ;   download_file_sanity_check(DownloadFile, Pack, Info),
 1964        Origin = URL
 1965    ),
 1966    pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options),
 1967    pack_assert(PackDir, archive(DownloadFile, Origin)),
 1968    option(pack_dir(PackDir), Options, _).
 1969pack_download_from_url(URL, PackTopDir, Pack, Options) :-
 1970    local_uri_file_name(URL, File),
 1971    !,
 1972    pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options),
 1973    pack_assert(PackDir, archive(File, URL)),
 1974    option(pack_dir(PackDir), Options, _).
 1975pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :-
 1976    domain_error(url, URL).
 1977
 1978%!  git_checkout_version(+PackDir, +Options) is det.
 1979%
 1980%   Given a checked out version of a repository, put the repo at the
 1981%   desired version.  Options:
 1982%
 1983%     - commit(+Commit)
 1984%       Target commit or `'HEAD'`.  If `'HEAD'`, get the HEAD of the
 1985%       explicit (option branch(Branch)), current or default branch. If
 1986%       the commit is a hash and it is the tip of a branch, checkout
 1987%       this branch. Else simply checkout the hash.
 1988%     - branch(+Branch)
 1989%       Used with commit('HEAD').
 1990%     - version(+Version)
 1991%       Checkout a tag.  If there is a tag matching Version use that,
 1992%       otherwise try to find a tag that ends with Version and demand
 1993%       the prefix to be letters, optionally followed by a dash or
 1994%       underscore.  Examples: 2.1, V2.1, v_2.1.
 1995%     - update(true)
 1996%       If none of the above is given update the repo.  If it is on
 1997%       a branch, _pull_.  Else, put it on the default branch and
 1998%       pull.
 1999
 2000git_checkout_version(PackDir, Options) :-
 2001    option(commit('HEAD'), Options),
 2002    option(branch(Branch), Options),
 2003    !,
 2004    git_ensure_on_branch(PackDir, Branch),
 2005    run_process(path(git), ['-C', PackDir, pull], []).
 2006git_checkout_version(PackDir, Options) :-
 2007    option(commit('HEAD'), Options),
 2008    git_current_branch(_, [directory(PackDir)]),
 2009    !,
 2010    run_process(path(git), ['-C', PackDir, pull], []).
 2011git_checkout_version(PackDir, Options) :-
 2012    option(commit('HEAD'), Options),
 2013    !,
 2014    git_default_branch(Branch, [directory(PackDir)]),
 2015    git_ensure_on_branch(PackDir, Branch),
 2016    run_process(path(git), ['-C', PackDir, pull], []).
 2017git_checkout_version(PackDir, Options) :-
 2018    option(commit(Hash), Options),
 2019    run_process(path(git), ['-C', PackDir, fetch], []),
 2020    git_branches(Branches, [contains(Hash), directory(PackDir)]),
 2021    git_process_output(['-C', PackDir, 'rev-parse' | Branches],
 2022                       read_lines_to_atoms(Commits),
 2023                       []),
 2024    nth1(I, Commits, Hash),
 2025    nth1(I, Branches, Branch),
 2026    !,
 2027    git_ensure_on_branch(PackDir, Branch).
 2028git_checkout_version(PackDir, Options) :-
 2029    option(commit(Hash), Options),
 2030    !,
 2031    run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []).
 2032git_checkout_version(PackDir, Options) :-
 2033    option(version(Version), Options),
 2034    !,
 2035    git_tags(Tags, [directory(PackDir)]),
 2036    (   memberchk(Version, Tags)
 2037    ->  Tag = Version
 2038    ;   member(Tag, Tags),
 2039        sub_atom(Tag, B, _, 0, Version),
 2040        sub_atom(Tag, 0, B, _, Prefix),
 2041        version_prefix(Prefix)
 2042    ->  true
 2043    ;   existence_error(version_tag, Version)
 2044    ),
 2045    run_process(path(git), ['-C', PackDir, checkout, Tag], []).
 2046git_checkout_version(_PackDir, Options) :-
 2047    option(fresh(true), Options),
 2048    !.
 2049git_checkout_version(PackDir, _Options) :-
 2050    git_current_branch(_, [directory(PackDir)]),
 2051    !,
 2052    run_process(path(git), ['-C', PackDir, pull], []).
 2053git_checkout_version(PackDir, _Options) :-
 2054    git_default_branch(Branch, [directory(PackDir)]),
 2055    git_ensure_on_branch(PackDir, Branch),
 2056    run_process(path(git), ['-C', PackDir, pull], []).
 2057
 2058%!  git_ensure_on_branch(+PackDir, +Branch) is det.
 2059%
 2060%   Ensure PackDir is on Branch.
 2061
 2062git_ensure_on_branch(PackDir, Branch) :-
 2063    git_current_branch(Branch, [directory(PackDir)]),
 2064    !.
 2065git_ensure_on_branch(PackDir, Branch) :-
 2066    run_process(path(git), ['-C', PackDir, checkout, Branch], []).
 2067
 2068read_lines_to_atoms(Atoms, In) :-
 2069    read_line_to_string(In, Line),
 2070    (   Line == end_of_file
 2071    ->  Atoms = []
 2072    ;   atom_string(Atom, Line),
 2073        Atoms = [Atom|T],
 2074        read_lines_to_atoms(T, In)
 2075    ).
 2076
 2077version_prefix(Prefix) :-
 2078    atom_codes(Prefix, Codes),
 2079    phrase(version_prefix, Codes).
 2080
 2081version_prefix -->
 2082    [C],
 2083    { code_type(C, alpha) },
 2084    !,
 2085    version_prefix.
 2086version_prefix -->
 2087    "-".
 2088version_prefix -->
 2089    "_".
 2090version_prefix -->
 2091    "".
 2092
 2093%!  download_file(+URL, +Pack, -File, +Options) is det.
 2094%
 2095%   Determine the file into which  to   download  URL. The second clause
 2096%   deals with GitHub downloads from a release tag.
 2097
 2098download_file(URL, Pack, File, Options) :-
 2099    option(version(Version), Options),
 2100    !,
 2101    file_name_extension(_, Ext, URL),
 2102    format(atom(File), '~w-~w.~w', [Pack, Version, Ext]).
 2103download_file(URL, Pack, File, _) :-
 2104    file_base_name(URL,Basename),
 2105    no_int_file_name_extension(Tag,Ext,Basename),
 2106    tag_version(Tag,Version),
 2107    !,
 2108    format(atom(File0), '~w-~w', [Pack, Version]),
 2109    file_name_extension(File0, Ext, File).
 2110download_file(URL, _, File, _) :-
 2111    file_base_name(URL, File).
 2112
 2113%!  pack_url_file(+URL, -File) is det.
 2114%
 2115%   True if File is a unique  id   for  the referenced pack and version.
 2116%   Normally, that is simply the base  name, but GitHub archives destroy
 2117%   this picture. Needed by the pack manager in the web server.
 2118
 2119:- public pack_url_file/2. 2120pack_url_file(URL, FileID) :-
 2121    github_release_url(URL, Pack, Version),
 2122    !,
 2123    download_file(URL, Pack, FileID, [version(Version)]).
 2124pack_url_file(URL, FileID) :-
 2125    file_base_name(URL, FileID).
 2126
 2127%   ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
 2128%
 2129%   Used if insecure(true)  is  given   to  pack_install/2.  Accepts any
 2130%   certificate.
 2131
 2132:- public ssl_verify/5. 2133ssl_verify(_SSL,
 2134           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 2135           _Error).
 2136
 2137pack_download_dir(PackTopDir, DownLoadDir) :-
 2138    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 2139    (   exists_directory(DownLoadDir)
 2140    ->  true
 2141    ;   make_directory(DownLoadDir)
 2142    ),
 2143    (   access_file(DownLoadDir, write)
 2144    ->  true
 2145    ;   permission_error(write, directory, DownLoadDir)
 2146    ).
 2147
 2148%!  download_url(@URL) is semidet.
 2149%
 2150%   True if URL looks like a URL we   can  download from. Noet that urls
 2151%   like ``ftp://`` are also download  URLs,   but  _we_ cannot download
 2152%   from them.
 2153
 2154download_url(URL) :-
 2155    url_scheme(URL, Scheme),
 2156    download_scheme(Scheme).
 2157
 2158url_scheme(URL, Scheme) :-
 2159    atom(URL),
 2160    uri_components(URL, Components),
 2161    uri_data(scheme, Components, Scheme),
 2162    atom(Scheme).
 2163
 2164download_scheme(http).
 2165download_scheme(https).
 2166
 2167%!  hsts(+URL0, -URL, +Options) is det.
 2168%
 2169%   HSTS (HTTP Strict Transport Security) is   standard by which means a
 2170%   site asks to always use HTTPS. For  SWI-Prolog packages we now force
 2171%   using HTTPS for all  downloads.  This   may  be  overrules using the
 2172%   option insecure(true), which  may  also  be   used  to  disable  TLS
 2173%   certificate  checking.  Note  that  the   pack  integrity  is  still
 2174%   protected by its SHA1 hash.
 2175
 2176hsts(URL0, URL, Options) :-
 2177    option(insecure(true), Options, false),
 2178    !,
 2179    URL = URL0.
 2180hsts(URL0, URL, _Options) :-
 2181    url_scheme(URL0, http),
 2182    !,
 2183    uri_edit(scheme(https), URL0, URL).
 2184hsts(URL, URL, _Options).
 2185
 2186
 2187%!  pack_post_install(+Pack, +PackDir, +Options) is det.
 2188%
 2189%   Process post installation work.  Steps:
 2190%
 2191%     - Create foreign resources
 2192%     - Register directory as autoload library
 2193%     - Attach the package
 2194
 2195pack_post_install(Pack, PackDir, Options) :-
 2196    post_install_foreign(Pack, PackDir, Options),
 2197    post_install_autoload(PackDir, Options),
 2198    attach_packs(PackDir, [duplicate(warning)]).
 2199
 2200%!  pack_rebuild is det.
 2201%!  pack_rebuild(+Pack) is det.
 2202%
 2203%   Rebuild  possible  foreign  components  of    Pack.   The  predicate
 2204%   pack_rebuild/0 rebuilds all registered packs.
 2205
 2206pack_rebuild :-
 2207    forall(current_pack(Pack),
 2208           ( print_message(informational, pack(rebuild(Pack))),
 2209             pack_rebuild(Pack)
 2210           )).
 2211
 2212pack_rebuild(Pack) :-
 2213    current_pack(Pack, PackDir),
 2214    !,
 2215    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 2216pack_rebuild(Pack) :-
 2217    unattached_pack(Pack, PackDir),
 2218    !,
 2219    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 2220pack_rebuild(Pack) :-
 2221    existence_error(pack, Pack).
 2222
 2223unattached_pack(Pack, BaseDir) :-
 2224    directory_file_path(Pack, 'pack.pl', PackFile),
 2225    absolute_file_name(pack(PackFile), PackPath,
 2226                       [ access(read),
 2227                         file_errors(fail)
 2228                       ]),
 2229    file_directory_name(PackPath, BaseDir).
 2230
 2231
 2232
 2233%!  post_install_foreign(+Pack, +PackDir, +Options) is det.
 2234%
 2235%   Install foreign parts of the package.  Options:
 2236%
 2237%     - rebuild(When)
 2238%       Determine when to rebuild.  Possible values:
 2239%       - if_absent
 2240%         Only rebuild if we have no existing foreign library.  This
 2241%         is the default.
 2242%       - true
 2243%         Always rebuild.
 2244
 2245post_install_foreign(Pack, PackDir, Options) :-
 2246    is_foreign_pack(PackDir, _),
 2247    !,
 2248    (   pack_info_term(PackDir, pack_version(Version))
 2249    ->  true
 2250    ;   Version = 1
 2251    ),
 2252    option(rebuild(Rebuild), Options, if_absent),
 2253    current_prolog_flag(arch, Arch),
 2254    prolog_version_dotted(PrologVersion),
 2255    (   Rebuild == if_absent,
 2256        foreign_present(PackDir, Arch)
 2257    ->  print_message(informational, pack(kept_foreign(Pack, Arch))),
 2258        (   pack_status_dir(PackDir, built(Arch, _, _))
 2259        ->  true
 2260        ;   pack_assert(PackDir, built(Arch, PrologVersion, downloaded))
 2261        )
 2262    ;   BuildSteps0 = [[dependencies], [configure], build, install, [test]],
 2263        (   Rebuild == true
 2264        ->  BuildSteps1 = [distclean|BuildSteps0]
 2265        ;   BuildSteps1 = BuildSteps0
 2266        ),
 2267        (   option(test(false), Options)
 2268        ->  delete(BuildSteps1, [test], BuildSteps2)
 2269        ;   BuildSteps2 = BuildSteps1
 2270        ),
 2271        (   option(clean(true), Options)
 2272        ->  append(BuildSteps2, [[clean]], BuildSteps)
 2273        ;   BuildSteps = BuildSteps2
 2274        ),
 2275        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]),
 2276        pack_assert(PackDir, built(Arch, PrologVersion, built))
 2277    ).
 2278post_install_foreign(_, _, _).
 2279
 2280
 2281%!  foreign_present(+PackDir, +Arch) is semidet.
 2282%
 2283%   True if we find one or more modules  in the pack `lib` directory for
 2284%   the current architecture.
 2285%
 2286%   @tbd Does not check that  these  can   be  loaded,  nor  whether all
 2287%   required modules are present.
 2288
 2289foreign_present(PackDir, Arch) :-
 2290    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 2291    exists_directory(ForeignBaseDir),
 2292    !,
 2293    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 2294    exists_directory(ForeignDir),
 2295    current_prolog_flag(shared_object_extension, Ext),
 2296    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 2297    expand_file_name(Pattern, Files),
 2298    Files \== [].
 2299
 2300%!  is_foreign_pack(+PackDir, -Type) is nondet.
 2301%
 2302%   True when PackDir contains  files  that   indicate  the  need  for a
 2303%   specific class of build tools indicated by Type.
 2304
 2305is_foreign_pack(PackDir, Type) :-
 2306    foreign_file(File, Type),
 2307    directory_file_path(PackDir, File, Path),
 2308    exists_file(Path).
 2309
 2310foreign_file('CMakeLists.txt', cmake).
 2311foreign_file('configure',      configure).
 2312foreign_file('configure.in',   autoconf).
 2313foreign_file('configure.ac',   autoconf).
 2314foreign_file('Makefile.am',    automake).
 2315foreign_file('Makefile',       make).
 2316foreign_file('makefile',       make).
 2317foreign_file('conanfile.txt',  conan).
 2318foreign_file('conanfile.py',   conan).
 2319
 2320
 2321                 /*******************************
 2322                 *           AUTOLOAD           *
 2323                 *******************************/
 2324
 2325%!  post_install_autoload(+PackDir, +Options)
 2326%
 2327%   Create an autoload index if the package demands such.
 2328
 2329post_install_autoload(PackDir, Options) :-
 2330    is_autoload_pack(PackDir, Options),
 2331    !,
 2332    directory_file_path(PackDir, prolog, PrologLibDir),
 2333    make_library_index(PrologLibDir).
 2334post_install_autoload(_, _).
 2335
 2336is_autoload_pack(PackDir, Options) :-
 2337    option(autoload(true), Options, true),
 2338    pack_info_term(PackDir, autoload(true)).
 2339
 2340
 2341                 /*******************************
 2342                 *            UPGRADE           *
 2343                 *******************************/
 2344
 2345%!  pack_upgrade(+Pack) is semidet.
 2346%
 2347%   Upgrade Pack.  Shorthand for pack_install(Pack, [upgrade(true)]).
 2348
 2349pack_upgrade(Pack) :-
 2350    pack_install(Pack, [upgrade(true)]).
 2351
 2352
 2353                 /*******************************
 2354                 *            REMOVE            *
 2355                 *******************************/
 2356
 2357%!  pack_remove(+Name) is det.
 2358%!  pack_remove(+Name, +Options) is det.
 2359%
 2360%   Remove the indicated package.  If   packages  depend (indirectly) on
 2361%   this pack, ask to remove these as well.  Options:
 2362%
 2363%     - interactive(false)
 2364%       Do not prompt the user.
 2365%     - dependencies(Boolean)
 2366%       If `true` delete dependencies without asking.
 2367
 2368pack_remove(Pack) :-
 2369    pack_remove(Pack, []).
 2370
 2371pack_remove(Pack, Options) :-
 2372    option(dependencies(false), Options),
 2373    !,
 2374    pack_remove_forced(Pack).
 2375pack_remove(Pack, Options) :-
 2376    (   dependents(Pack, Deps)
 2377    ->  (   option(dependencies(true), Options)
 2378        ->  true
 2379        ;   confirm_remove(Pack, Deps, Delete, Options)
 2380        ),
 2381        forall(member(P, Delete), pack_remove_forced(P))
 2382    ;   pack_remove_forced(Pack)
 2383    ).
 2384
 2385pack_remove_forced(Pack) :-
 2386    catch('$pack_detach'(Pack, BaseDir),
 2387          error(existence_error(pack, Pack), _),
 2388          fail),
 2389    !,
 2390    print_message(informational, pack(remove(BaseDir))),
 2391    delete_directory_and_contents(BaseDir).
 2392pack_remove_forced(Pack) :-
 2393    unattached_pack(Pack, BaseDir),
 2394    !,
 2395    delete_directory_and_contents(BaseDir).
 2396pack_remove_forced(Pack) :-
 2397    print_message(informational, error(existence_error(pack, Pack),_)).
 2398
 2399confirm_remove(Pack, Deps, Delete, Options) :-
 2400    print_message(warning, pack(depends(Pack, Deps))),
 2401    menu(pack(resolve_remove),
 2402         [ [Pack]      = remove_only(Pack),
 2403           [Pack|Deps] = remove_deps(Pack, Deps),
 2404           []          = cancel
 2405         ], [], Delete, Options),
 2406    Delete \== [].
 2407
 2408
 2409		 /*******************************
 2410		 *           PUBLISH		*
 2411		 *******************************/
 2412
 2413%!  pack_publish(+Spec, +Options) is det.
 2414%
 2415%   Publish a package. There are two ways  typical ways to call this. We
 2416%   recommend developing a pack in a   GIT  repository. In this scenario
 2417%   the pack can be published using
 2418%
 2419%       ?- pack_publish('.', []).
 2420%
 2421%   Alternatively, an archive  file  has  been   uploaded  to  a  public
 2422%   location. In this scenario we can publish the pack using
 2423%
 2424%       ?- pack_publish(URL, [])
 2425%
 2426%   In both scenarios, pack_publish/2  by   default  creates an isolated
 2427%   environment and installs the package  in   this  directory  from the
 2428%   public URL. On success it triggers the   pack server to register the
 2429%   URL as a new pack or a new release of a pack.
 2430%
 2431%   Packs may also be published using the _app_ `pack`, e.g.
 2432%
 2433%       swipl pack publish .
 2434%
 2435%   Options:
 2436%
 2437%     - git(Boolean)
 2438%       If `true`, and Spec is a git managed directory, install using
 2439%       the remote repo.
 2440%     - sign(Boolean)
 2441%       Sign the repository with the current version.  This runs
 2442%       ``git tag -s <tag>``.
 2443%     - force(Boolean)
 2444%       Force the git tag.  This runs ``git tag -f <tag>``.
 2445%     - branch(+Branch)
 2446%       Branch used for releases.  Defined by git_default_branch/2
 2447%       if not specified.
 2448%     - register(+Boolean)
 2449%       If `false` (default `true`), perform the installation, but do
 2450%       not upload to the server. This can be used for testing.
 2451%     - isolated(+Boolean)
 2452%       If `true` (default), install and build all packages in an
 2453%       isolated package directory.  If `false`, use other packages
 2454%       installed for the environment.   The latter may be used to
 2455%       speedup debugging.
 2456%     - pack_directory(+Dir)
 2457%       Install the temporary packages in Dir. If omitted pack_publish/2
 2458%       creates a temporary directory and deletes this directory after
 2459%       completion. An explict target Dir is created if it does not
 2460%       exist and is not deleted on completion.
 2461%     - clean(+Boolean)
 2462%       If `true` (default), clean the destination directory first
 2463
 2464pack_publish(Dir, Options) :-
 2465    \+ download_url(Dir),
 2466    is_git_directory(Dir), !,
 2467    pack_git_info(Dir, _Hash, Metadata),
 2468    prepare_repository(Dir, Metadata, Options),
 2469    (   memberchk(download(URL), Metadata),
 2470        git_url(URL, _)
 2471    ->  true
 2472    ;   option(remote(Remote), Options, origin),
 2473        git_remote_url(Remote, RemoteURL, [directory(Dir)]),
 2474        git_to_https_url(RemoteURL, URL)
 2475    ),
 2476    memberchk(version(Version), Metadata),
 2477    pack_publish_(URL,
 2478                  [ version(Version)
 2479                  | Options
 2480                  ]).
 2481pack_publish(Spec, Options) :-
 2482    pack_publish_(Spec, Options).
 2483
 2484pack_publish_(Spec, Options) :-
 2485    pack_default_options(Spec, Pack, Options, DefOptions),
 2486    option(url(URL), DefOptions),
 2487    valid_publish_url(URL, Options),
 2488    prepare_build_location(Pack, Dir, Clean, Options),
 2489    (   option(register(false), Options)
 2490    ->  InstallOptions = DefOptions
 2491    ;   InstallOptions = [publish(Pack)|DefOptions]
 2492    ),
 2493    call_cleanup(pack_install(Pack,
 2494                              [ pack(Pack)
 2495                              | InstallOptions
 2496                              ]),
 2497                 cleanup_publish(Clean, Dir)).
 2498
 2499cleanup_publish(true, Dir) :-
 2500    !,
 2501    delete_directory_and_contents(Dir).
 2502cleanup_publish(_, _).
 2503
 2504valid_publish_url(URL, Options) :-
 2505    option(register(Register), Options, true),
 2506    (   Register == false
 2507    ->  true
 2508    ;   download_url(URL)
 2509    ->  true
 2510    ;   permission_error(publish, pack, URL)
 2511    ).
 2512
 2513prepare_build_location(Pack, Dir, Clean, Options) :-
 2514    (   option(pack_directory(Dir), Options)
 2515    ->  ensure_directory(Dir),
 2516        (   option(clean(true), Options, true)
 2517        ->  delete_directory_contents(Dir)
 2518        ;   true
 2519        )
 2520    ;   tmp_file(pack, Dir),
 2521        make_directory(Dir),
 2522        Clean = true
 2523    ),
 2524    (   option(isolated(false), Options)
 2525    ->  detach_pack(Pack, _),
 2526        attach_packs(Dir, [search(first)])
 2527    ;   attach_packs(Dir, [replace(true)])
 2528    ).
 2529
 2530
 2531
 2532%!  prepare_repository(+Dir, +Metadata, +Options) is semidet.
 2533%
 2534%   Prepare the git repository. If register(false)  is provided, this is
 2535%   a test run and therefore we do   not  need this. Otherwise we demand
 2536%   the working directory to be clean,  we   tag  the current commit and
 2537%   push the current branch.
 2538
 2539prepare_repository(_Dir, _Metadata, Options) :-
 2540    option(register(false), Options),
 2541    !.
 2542prepare_repository(Dir, Metadata, Options) :-
 2543    git_dir_must_be_clean(Dir),
 2544    git_must_be_on_default_branch(Dir, Options),
 2545    tag_git_dir(Dir, Metadata, Action, Options),
 2546    confirm(git_push, yes, Options),
 2547    run_process(path(git), ['-C', file(Dir), push ], []),
 2548    (   Action = push_tag(Tag)
 2549    ->  run_process(path(git), ['-C', file(Dir), push, origin, Tag ], [])
 2550    ;   true
 2551    ).
 2552
 2553git_dir_must_be_clean(Dir) :-
 2554    git_describe(Description, [directory(Dir)]),
 2555    (   sub_atom(Description, _, _, 0, '-DIRTY')
 2556    ->  print_message(error, pack(git_not_clean(Dir))),
 2557        fail
 2558    ;   true
 2559    ).
 2560
 2561git_must_be_on_default_branch(Dir, Options) :-
 2562    (   option(branch(Default), Options)
 2563    ->  true
 2564    ;   git_default_branch(Default, [directory(Dir)])
 2565    ),
 2566    git_current_branch(Current, [directory(Dir)]),
 2567    (   Default == Current
 2568    ->  true
 2569    ;   print_message(error,
 2570                      pack(git_branch_not_default(Dir, Default, Current))),
 2571        fail
 2572    ).
 2573
 2574
 2575%!  tag_git_dir(+Dir, +Metadata, -Action, +Options) is semidet.
 2576%
 2577%   Add a version tag to the git repository.
 2578%
 2579%   @arg Action is one of push_tag(Tag) or `none`
 2580
 2581tag_git_dir(Dir, Metadata, Action, Options) :-
 2582    memberchk(version(Version), Metadata),
 2583    atom_concat('V', Version, Tag),
 2584    git_tags(Tags, [directory(Dir)]),
 2585    (   memberchk(Tag, Tags)
 2586    ->  git_tag_is_consistent(Dir, Tag, Action, Options)
 2587    ;   format(string(Message), 'Release ~w', [Version]),
 2588        findall(Opt, git_tag_option(Opt, Options), Argv,
 2589                [ '-m', Message, Tag ]),
 2590        confirm(git_tag(Tag), yes, Options),
 2591        run_process(path(git), ['-C', file(Dir), tag | Argv ], []),
 2592        Action = push_tag(Tag)
 2593    ).
 2594
 2595git_tag_option('-s', Options) :- option(sign(true), Options, true).
 2596git_tag_option('-f', Options) :- option(force(true), Options, true).
 2597
 2598git_tag_is_consistent(Dir, Tag, Action, Options) :-
 2599    format(atom(TagRef), 'refs/tags/~w', [Tag]),
 2600    format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]),
 2601    option(remote(Remote), Options, origin),
 2602    git_ls_remote(Dir, LocalTags, [tags(true)]),
 2603    memberchk(CommitHash-CommitRef, LocalTags),
 2604    (   git_hash(CommitHash, [directory(Dir)])
 2605    ->  true
 2606    ;   print_message(error, pack(git_release_tag_not_at_head(Tag))),
 2607        fail
 2608    ),
 2609    memberchk(TagHash-TagRef, LocalTags),
 2610    git_ls_remote(Remote, RemoteTags, [tags(true)]),
 2611    (   memberchk(RemoteCommitHash-CommitRef, RemoteTags),
 2612        memberchk(RemoteTagHash-TagRef, RemoteTags)
 2613    ->  (   RemoteCommitHash == CommitHash,
 2614            RemoteTagHash == TagHash
 2615        ->  Action = none
 2616        ;   print_message(error, pack(git_tag_out_of_sync(Tag))),
 2617            fail
 2618        )
 2619    ;   Action = push_tag(Tag)
 2620    ).
 2621
 2622%!  git_to_https_url(+GitURL, -HTTP_URL) is semidet.
 2623%
 2624%   Get the HTTP(s) URL for a git repository, given a git url.
 2625%   Whether or not this is available and how to translate the
 2626%   one into the other depends in the server software.
 2627
 2628git_to_https_url(URL, URL) :-
 2629    download_url(URL),
 2630    !.
 2631git_to_https_url(GitURL, URL) :-
 2632    atom_concat('git@github.com:', Repo, GitURL),
 2633    !,
 2634    atom_concat('https://github.com/', Repo, URL).
 2635git_to_https_url(GitURL, _) :-
 2636    print_message(error, pack(git_no_https(GitURL))),
 2637    fail.
 2638
 2639
 2640                 /*******************************
 2641                 *           PROPERTIES         *
 2642                 *******************************/
 2643
 2644%!  pack_property(?Pack, ?Property) is nondet.
 2645%
 2646%   True when Property  is  a  property   of  an  installed  Pack.  This
 2647%   interface is intended for programs that   wish  to interact with the
 2648%   package manager. Defined properties are:
 2649%
 2650%     - directory(Directory)
 2651%     Directory into which the package is installed
 2652%     - version(Version)
 2653%     Installed version
 2654%     - title(Title)
 2655%     Full title of the package
 2656%     - author(Author)
 2657%     Registered author
 2658%     - download(URL)
 2659%     Official download URL
 2660%     - readme(File)
 2661%     Package README file (if present)
 2662%     - todo(File)
 2663%     Package TODO file (if present)
 2664
 2665pack_property(Pack, Property) :-
 2666    findall(Pack-Property, pack_property_(Pack, Property), List),
 2667    member(Pack-Property, List).            % make det if applicable
 2668
 2669pack_property_(Pack, Property) :-
 2670    pack_info(Pack, _, Property).
 2671pack_property_(Pack, Property) :-
 2672    \+ \+ info_file(Property, _),
 2673    '$pack':pack(Pack, BaseDir),
 2674    access_file(BaseDir, read),
 2675    directory_files(BaseDir, Files),
 2676    member(File, Files),
 2677    info_file(Property, Pattern),
 2678    downcase_atom(File, Pattern),
 2679    directory_file_path(BaseDir, File, InfoFile),
 2680    arg(1, Property, InfoFile).
 2681
 2682info_file(readme(_), 'readme.txt').
 2683info_file(readme(_), 'readme').
 2684info_file(todo(_),   'todo.txt').
 2685info_file(todo(_),   'todo').
 2686
 2687
 2688                 /*******************************
 2689                 *         VERSION LOGIC        *
 2690                 *******************************/
 2691
 2692%!  pack_version_file(-Pack, -Version:atom, +File) is semidet.
 2693%
 2694%   True if File is the  name  of  a   file  or  URL  of a file that
 2695%   contains Pack at Version. File must   have  an extension and the
 2696%   basename  must  be  of   the    form   <pack>-<n>{.<m>}*.  E.g.,
 2697%   =|mypack-1.5|=.
 2698
 2699pack_version_file(Pack, Version, GitHubRelease) :-
 2700    atomic(GitHubRelease),
 2701    github_release_url(GitHubRelease, Pack, Version),
 2702    !.
 2703pack_version_file(Pack, Version, Path) :-
 2704    atomic(Path),
 2705    file_base_name(Path, File),
 2706    no_int_file_name_extension(Base, _Ext, File),
 2707    atom_codes(Base, Codes),
 2708    (   phrase(pack_version(Pack, Version), Codes),
 2709        safe_pack_name(Pack)
 2710    ->  true
 2711    ).
 2712
 2713no_int_file_name_extension(Base, Ext, File) :-
 2714    file_name_extension(Base0, Ext0, File),
 2715    \+ atom_number(Ext0, _),
 2716    !,
 2717    Base = Base0,
 2718    Ext = Ext0.
 2719no_int_file_name_extension(File, '', File).
 2720
 2721%!  safe_pack_name(+Name:atom) is semidet.
 2722%
 2723%   Verifies that Name is a valid   pack  name. This avoids trickery
 2724%   with pack file names to make shell commands behave unexpectly.
 2725
 2726safe_pack_name(Name) :-
 2727    atom_length(Name, Len),
 2728    Len >= 3,                               % demand at least three length
 2729    atom_codes(Name, Codes),
 2730    maplist(safe_pack_char, Codes),
 2731    !.
 2732
 2733safe_pack_char(C) :- between(0'a, 0'z, C), !.
 2734safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 2735safe_pack_char(C) :- between(0'0, 0'9, C), !.
 2736safe_pack_char(0'_).
 2737
 2738%!  pack_version(-Pack:atom, -Version:atom)// is semidet.
 2739%
 2740%   True when the input statifies <pack>-<version>
 2741
 2742pack_version(Pack, Version) -->
 2743    string(Codes), "-",
 2744    version(Parts),
 2745    !,
 2746    { atom_codes(Pack, Codes),
 2747      atomic_list_concat(Parts, '.', Version)
 2748    }.
 2749
 2750version([H|T]) -->
 2751    version_part(H),
 2752    (   "."
 2753    ->  version(T)
 2754    ;   {T=[]}
 2755    ).
 2756
 2757version_part(*) --> "*", !.
 2758version_part(Int) --> integer(Int).
 2759
 2760
 2761		 /*******************************
 2762		 *           GIT LOGIC		*
 2763		 *******************************/
 2764
 2765have_git :-
 2766    process_which(path(git), _).
 2767
 2768
 2769%!  git_url(+URL, -Pack) is semidet.
 2770%
 2771%   True if URL describes a git url for Pack
 2772
 2773git_url(URL, Pack) :-
 2774    uri_components(URL, Components),
 2775    uri_data(scheme, Components, Scheme),
 2776    nonvar(Scheme),                         % must be full URL
 2777    uri_data(path, Components, Path),
 2778    (   Scheme == git
 2779    ->  true
 2780    ;   git_download_scheme(Scheme),
 2781        file_name_extension(_, git, Path)
 2782    ;   git_download_scheme(Scheme),
 2783        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 2784    ->  true
 2785    ),
 2786    file_base_name(Path, PackExt),
 2787    (   file_name_extension(Pack, git, PackExt)
 2788    ->  true
 2789    ;   Pack = PackExt
 2790    ),
 2791    (   safe_pack_name(Pack)
 2792    ->  true
 2793    ;   domain_error(pack_name, Pack)
 2794    ).
 2795
 2796git_download_scheme(http).
 2797git_download_scheme(https).
 2798
 2799%!  github_release_url(+URL, -Pack, -Version:atom) is semidet.
 2800%
 2801%   True when URL is the URL of a GitHub release.  Such releases are
 2802%   accessible as
 2803%
 2804%       https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
 2805
 2806github_release_url(URL, Pack, Version) :-
 2807    uri_components(URL, Components),
 2808    uri_data(authority, Components, 'github.com'),
 2809    uri_data(scheme, Components, Scheme),
 2810    download_scheme(Scheme),
 2811    uri_data(path, Components, Path),
 2812    github_archive_path(Archive,Pack,File),
 2813    atomic_list_concat(Archive, /, Path),
 2814    file_name_extension(Tag, Ext, File),
 2815    github_archive_extension(Ext),
 2816    tag_version(Tag, Version),
 2817    !.
 2818
 2819github_archive_path(['',_User,Pack,archive,File],Pack,File).
 2820github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 2821
 2822github_archive_extension(tgz).
 2823github_archive_extension(zip).
 2824
 2825%!  tag_version(+GitTag, -Version) is semidet.
 2826%
 2827%   True when a GIT tag describes version Version.  GitTag must
 2828%   satisfy ``[vV]?int(\.int)*``.
 2829
 2830tag_version(Tag, Version) :-
 2831    version_tag_prefix(Prefix),
 2832    atom_concat(Prefix, Version, Tag),
 2833    is_version(Version).
 2834
 2835version_tag_prefix(v).
 2836version_tag_prefix('V').
 2837version_tag_prefix('').
 2838
 2839
 2840%!  git_archive_url(+URL, -Archive, +Options) is semidet.
 2841%
 2842%   If we do not have git installed, some git services offer downloading
 2843%   the code as  an  archive  using   HTTP.  This  predicate  makes this
 2844%   translation.
 2845
 2846git_archive_url(URL, Archive, Options) :-
 2847    uri_components(URL, Components),
 2848    uri_data(authority, Components, 'github.com'),
 2849    uri_data(path, Components, Path),
 2850    atomic_list_concat(['', User, RepoGit], /, Path),
 2851    $,
 2852    remove_git_ext(RepoGit, Repo),
 2853    git_archive_version(Version, Options),
 2854    atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath),
 2855    uri_edit([ path(ArchivePath),
 2856               host('codeload.github.com')
 2857             ],
 2858             URL, Archive).
 2859git_archive_url(URL, _, _) :-
 2860    print_message(error, pack(no_git(URL))),
 2861    fail.
 2862
 2863remove_git_ext(RepoGit, Repo) :-
 2864    file_name_extension(Repo, git, RepoGit),
 2865    !.
 2866remove_git_ext(Repo, Repo).
 2867
 2868git_archive_version(Version, Options) :-
 2869    option(commit(Version), Options),
 2870    !.
 2871git_archive_version(Version, Options) :-
 2872    option(branch(Version), Options),
 2873    !.
 2874git_archive_version(Version, Options) :-
 2875    option(version(Version), Options),
 2876    !.
 2877git_archive_version('HEAD', _).
 2878
 2879                 /*******************************
 2880                 *       QUERY CENTRAL DB       *
 2881                 *******************************/
 2882
 2883%!  publish_download(+Infos, +Options) is semidet.
 2884%!  register_downloads(+Infos, +Options) is det.
 2885%
 2886%   Register our downloads with the  pack server. The publish_download/2
 2887%   version is used to  register  a   specific  pack  after successfully
 2888%   installing the pack.  In this scenario, we
 2889%
 2890%     1. call register_downloads/2 with publish(Pack) that must be
 2891%        a no-op.
 2892%     2. build and test the pack
 2893%     3. call publish_download/2, which calls register_downloads/2
 2894%        after replacing publish(Pack) by do_publish(Pack).
 2895
 2896register_downloads(_, Options) :-
 2897    option(register(false), Options),
 2898    !.
 2899register_downloads(_, Options) :-
 2900    option(publish(_), Options),
 2901    !.
 2902register_downloads(Infos, Options) :-
 2903    convlist(download_data, Infos, Data),
 2904    (   Data == []
 2905    ->  true
 2906    ;   query_pack_server(downloaded(Data), Reply, Options),
 2907        (   option(do_publish(Pack), Options)
 2908        ->  (   member(Info, Infos),
 2909                Info.pack == Pack
 2910            ->  true
 2911            ),
 2912            (   Reply = true(Actions),
 2913                memberchk(Pack-Result, Actions)
 2914            ->  (   registered(Result)
 2915                ->  print_message(informational, pack(published(Info, Result)))
 2916                ;   print_message(error, pack(publish_failed(Info, Result))),
 2917                    fail
 2918                )
 2919            ;   print_message(error, pack(publish_failed(Info, false)))
 2920            )
 2921        ;   true
 2922        )
 2923    ).
 2924
 2925registered(git(_URL)).
 2926registered(file(_URL)).
 2927
 2928publish_download(Infos, Options) :-
 2929    select_option(publish(Pack), Options, Options1),
 2930    !,
 2931    register_downloads(Infos, [do_publish(Pack)|Options1]).
 2932publish_download(_Infos, _Options).
 2933
 2934%!  download_data(+Info, -Data) is semidet.
 2935%
 2936%   If we downloaded and installed Info, unify Data with the information
 2937%   that we share with the pack registry. That is a term
 2938%
 2939%       download(URL, Hash, Metadata).
 2940%
 2941%   Where URL is location of the GIT   repository or URL of the download
 2942%   archive. Hash is either the  GIT  commit   hash  or  the SHA1 of the
 2943%   archive file.
 2944
 2945download_data(Info, Data),
 2946    Info.get(git) == true =>                % Git clone
 2947    Data = download(URL, Hash, Metadata),
 2948    URL = Info.get(downloaded),
 2949    pack_git_info(Info.installed, Hash, Metadata).
 2950download_data(Info, Data),
 2951    _{git_url:URL,hash:Hash} :< Info, Hash \== (-) =>
 2952    Data = download(URL, Hash, Metadata),   % Git downloaded as zip
 2953    dir_metadata(Info.installed, Metadata).
 2954download_data(Info, Data) =>                % Archive download.
 2955    Data = download(URL, Hash, Metadata),
 2956    URL = Info.get(downloaded),
 2957    download_url(URL),
 2958    pack_status_dir(Info.installed, archive(Archive, URL)),
 2959    file_sha1(Archive, Hash),
 2960    pack_archive_info(Archive, _Pack, Metadata, _).
 2961
 2962%!  query_pack_server(+Query, -Result, +Options)
 2963%
 2964%   Send a Prolog query  to  the   package  server  and  process its
 2965%   results.
 2966
 2967query_pack_server(Query, Result, Options) :-
 2968    (   option(server(ServerOpt), Options)
 2969    ->  server_url(ServerOpt, ServerBase)
 2970    ;   setting(server, ServerBase),
 2971        ServerBase \== ''
 2972    ),
 2973    atom_concat(ServerBase, query, Server),
 2974    format(codes(Data), '~q.~n', Query),
 2975    info_level(Informational, Options),
 2976    print_message(Informational, pack(contacting_server(Server))),
 2977    setup_call_cleanup(
 2978        http_open(Server, In,
 2979                  [ post(codes(application/'x-prolog', Data)),
 2980                    header(content_type, ContentType)
 2981                  ]),
 2982        read_reply(ContentType, In, Result),
 2983        close(In)),
 2984    message_severity(Result, Level, Informational),
 2985    print_message(Level, pack(server_reply(Result))).
 2986
 2987server_url(URL0, URL) :-
 2988    uri_components(URL0, Components),
 2989    uri_data(scheme, Components, Scheme),
 2990    var(Scheme),
 2991    !,
 2992    atom_concat('https://', URL0, URL1),
 2993    server_url(URL1, URL).
 2994server_url(URL0, URL) :-
 2995    uri_components(URL0, Components),
 2996    uri_data(path, Components, ''),
 2997    !,
 2998    uri_edit([path('/pack/')], URL0, URL).
 2999server_url(URL, URL).
 3000
 3001read_reply(ContentType, In, Result) :-
 3002    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 3003    !,
 3004    set_stream(In, encoding(utf8)),
 3005    read(In, Result).
 3006read_reply(ContentType, In, _Result) :-
 3007    read_string(In, 500, String),
 3008    print_message(error, pack(no_prolog_response(ContentType, String))),
 3009    fail.
 3010
 3011info_level(Level, Options) :-
 3012    option(silent(true), Options),
 3013    !,
 3014    Level = silent.
 3015info_level(informational, _).
 3016
 3017message_severity(true(_), Informational, Informational).
 3018message_severity(false, warning, _).
 3019message_severity(exception(_), error, _).
 3020
 3021
 3022                 /*******************************
 3023                 *        WILDCARD URIs         *
 3024                 *******************************/
 3025
 3026%!  available_download_versions(+URL, -Versions:list(atom), +Options) is det.
 3027%
 3028%   Deal with wildcard URLs, returning a  list of Version-URL pairs,
 3029%   sorted by version.
 3030%
 3031%   @tbd    Deal with protocols other than HTTP
 3032
 3033available_download_versions(URL, Versions, _Options) :-
 3034    wildcard_pattern(URL),
 3035    github_url(URL, User, Repo),            % demands https
 3036    !,
 3037    findall(Version-VersionURL,
 3038            github_version(User, Repo, Version, VersionURL),
 3039            Versions).
 3040available_download_versions(URL, Versions, Options) :-
 3041    wildcard_pattern(URL0),
 3042    !,
 3043    hsts(URL0, URL, Options),
 3044    file_directory_name(URL, DirURL0),
 3045    ensure_slash(DirURL0, DirURL),
 3046    print_message(informational, pack(query_versions(DirURL))),
 3047    setup_call_cleanup(
 3048        http_open(DirURL, In, []),
 3049        load_html(stream(In), DOM,
 3050                  [ syntax_errors(quiet)
 3051                  ]),
 3052        close(In)),
 3053    findall(MatchingURL,
 3054            absolute_matching_href(DOM, URL, MatchingURL),
 3055            MatchingURLs),
 3056    (   MatchingURLs == []
 3057    ->  print_message(warning, pack(no_matching_urls(URL)))
 3058    ;   true
 3059    ),
 3060    versioned_urls(MatchingURLs, VersionedURLs),
 3061    sort_version_pairs(VersionedURLs, Versions),
 3062    print_message(informational, pack(found_versions(Versions))).
 3063available_download_versions(URL, [Version-URL], _Options) :-
 3064    (   pack_version_file(_Pack, Version0, URL)
 3065    ->  Version = Version0
 3066    ;   Version = '0.0.0'
 3067    ).
 3068
 3069%!  sort_version_pairs(+Pairs, -Sorted) is det.
 3070%
 3071%   Sort a list of Version-Data by decreasing version.
 3072
 3073sort_version_pairs(Pairs, Sorted) :-
 3074    map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed),
 3075    sort(1, @>=, Keyed, SortedKeyed),
 3076    pairs_values(SortedKeyed, Sorted).
 3077
 3078version_pair_sort_key_(Version-_Data, Key) :-
 3079    version_sort_key(Version, Key).
 3080
 3081version_sort_key(Version, Key) :-
 3082    split_string(Version, ".", "", Parts),
 3083    maplist(number_string, Key, Parts),
 3084    !.
 3085version_sort_key(Version, _) :-
 3086    domain_error(version, Version).
 3087
 3088%!  github_url(+URL, -User, -Repo) is semidet.
 3089%
 3090%   True when URL refers to a github repository.
 3091
 3092github_url(URL, User, Repo) :-
 3093    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 3094    atomic_list_concat(['',User,Repo|_], /, Path).
 3095
 3096
 3097%!  github_version(+User, +Repo, -Version, -VersionURI) is nondet.
 3098%
 3099%   True when Version is a release version and VersionURI is the
 3100%   download location for the zip file.
 3101
 3102github_version(User, Repo, Version, VersionURI) :-
 3103    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 3104    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 3105    setup_call_cleanup(
 3106      http_open(ApiUri, In,
 3107                [ request_header('Accept'='application/vnd.github.v3+json')
 3108                ]),
 3109      json_read_dict(In, Dicts),
 3110      close(In)),
 3111    member(Dict, Dicts),
 3112    atom_string(Tag, Dict.name),
 3113    tag_version(Tag, Version),
 3114    atom_string(VersionURI, Dict.zipball_url).
 3115
 3116wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 3117wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 3118
 3119ensure_slash(Dir, DirS) :-
 3120    (   sub_atom(Dir, _, _, 0, /)
 3121    ->  DirS = Dir
 3122    ;   atom_concat(Dir, /, DirS)
 3123    ).
 3124
 3125remove_slash(Dir0, Dir) :-
 3126    Dir0 \== '/',
 3127    atom_concat(Dir1, /, Dir0),
 3128    !,
 3129    remove_slash(Dir1, Dir).
 3130remove_slash(Dir, Dir).
 3131
 3132absolute_matching_href(DOM, Pattern, Match) :-
 3133    xpath(DOM, //a(@href), HREF),
 3134    uri_normalized(HREF, Pattern, Match),
 3135    wildcard_match(Pattern, Match).
 3136
 3137versioned_urls([], []).
 3138versioned_urls([H|T0], List) :-
 3139    file_base_name(H, File),
 3140    (   pack_version_file(_Pack, Version, File)
 3141    ->  List = [Version-H|T]
 3142    ;   List = T
 3143    ),
 3144    versioned_urls(T0, T).
 3145
 3146
 3147                 /*******************************
 3148                 *          DEPENDENCIES        *
 3149                 *******************************/
 3150
 3151%!  pack_provides(?Pack, -Provides) is multi.
 3152%!  pack_requires(?Pack, -Requires) is nondet.
 3153%!  pack_conflicts(?Pack, -Conflicts) is nondet.
 3154%
 3155%   Provide logical access to pack dependency relations.
 3156
 3157pack_provides(Pack, Pack@Version) :-
 3158    current_pack(Pack),
 3159    once(pack_info(Pack, version, version(Version))).
 3160pack_provides(Pack, Provides) :-
 3161    findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList),
 3162    member(Provides, PrvList).
 3163
 3164pack_requires(Pack, Requires) :-
 3165    current_pack(Pack),
 3166    findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList),
 3167    member(Requires, ReqList).
 3168
 3169pack_conflicts(Pack, Conflicts) :-
 3170    current_pack(Pack),
 3171    findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList),
 3172    member(Conflicts, CflList).
 3173
 3174%!  pack_depends_on(?Pack, ?Dependency) is nondet.
 3175%
 3176%   True when Pack depends on pack   Dependency. This predicate does not
 3177%   deal with transitive dependency.
 3178
 3179pack_depends_on(Pack, Dependency) :-
 3180    ground(Pack),
 3181    !,
 3182    pack_requires(Pack, Requires),
 3183    \+ is_prolog_token(Requires),
 3184    pack_provides(Dependency, Provides),
 3185    satisfies_req(Provides, Requires).
 3186pack_depends_on(Pack, Dependency) :-
 3187    ground(Dependency),
 3188    !,
 3189    pack_provides(Dependency, Provides),
 3190    pack_requires(Pack, Requires),
 3191    satisfies_req(Provides, Requires).
 3192pack_depends_on(Pack, Dependency) :-
 3193    current_pack(Pack),
 3194    pack_depends_on(Pack, Dependency).
 3195
 3196%!  dependents(+Pack, -Dependents) is semidet.
 3197%
 3198%   True when Dependents is a list of  packs that (indirectly) depend on
 3199%   Pack.
 3200
 3201dependents(Pack, Deps) :-
 3202    setof(Dep, dependent(Pack, Dep, []), Deps).
 3203
 3204dependent(Pack, Dep, Seen) :-
 3205    pack_depends_on(Dep0, Pack),
 3206    \+ memberchk(Dep0, Seen),
 3207    (   Dep = Dep0
 3208    ;   dependent(Dep0, Dep, [Dep0|Seen])
 3209    ).
 3210
 3211%!  validate_dependencies is det.
 3212%
 3213%   Validate all dependencies, reporting on failures
 3214
 3215validate_dependencies :-
 3216    setof(Issue, pack_dependency_issue(_, Issue), Issues),
 3217    !,
 3218    print_message(warning, pack(dependency_issues(Issues))).
 3219validate_dependencies.
 3220
 3221%!  pack_dependency_issue(?Pack, -Issue) is nondet.
 3222%
 3223%   True when Issue is a dependency issue   regarding Pack. Issue is one
 3224%   of
 3225%
 3226%     - unsatisfied(Pack, Requires)
 3227%       The requirement Requires of Pack is not fulfilled.
 3228%     - conflicts(Pack, Conflict)
 3229%       Pack conflicts with Conflict.
 3230
 3231pack_dependency_issue(Pack, Issue) :-
 3232    current_pack(Pack),
 3233    pack_dependency_issue_(Pack, Issue).
 3234
 3235pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :-
 3236    pack_requires(Pack, Requires),
 3237    (   is_prolog_token(Requires)
 3238    ->  \+ prolog_satisfies(Requires)
 3239    ;   \+ ( pack_provides(_, Provides),
 3240             satisfies_req(Provides, Requires) )
 3241    ).
 3242pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :-
 3243    pack_conflicts(Pack, Conflicts),
 3244    (   is_prolog_token(Conflicts)
 3245    ->  prolog_satisfies(Conflicts)
 3246    ;   pack_provides(_, Provides),
 3247        satisfies_req(Provides, Conflicts)
 3248    ).
 3249
 3250
 3251		 /*******************************
 3252		 *      RECORD PACK FACTS	*
 3253		 *******************************/
 3254
 3255%!  pack_assert(+PackDir, ++Fact) is det.
 3256%
 3257%   Add/update  a  fact  about  packs.  These    facts   are  stored  in
 3258%   PackDir/status.db. Known facts are:
 3259%
 3260%     - built(Arch, Version, How)
 3261%       Pack has been built by SWI-Prolog Version for Arch.  How is one
 3262%       of `built` if we built it or `downloaded` if it was downloaded.
 3263%     - automatic(Boolean)
 3264%       If `true`, pack was installed as dependency.
 3265%     - archive(Archive, URL)
 3266%       Available when the pack was installed by unpacking Archive that
 3267%       was retrieved from URL.
 3268
 3269pack_assert(PackDir, Fact) :-
 3270    must_be(ground, Fact),
 3271    findall(Term, pack_status_dir(PackDir, Term), Facts0),
 3272    update_facts(Facts0, Fact, Facts),
 3273    OpenOptions = [encoding(utf8), lock(exclusive)],
 3274    status_file(PackDir, StatusFile),
 3275    (   Facts == Facts0
 3276    ->  true
 3277    ;   Facts0 \== [],
 3278        append(Facts0, New, Facts)
 3279    ->  setup_call_cleanup(
 3280            open(StatusFile, append, Out, OpenOptions),
 3281            maplist(write_fact(Out), New),
 3282            close(Out))
 3283    ;   setup_call_cleanup(
 3284            open(StatusFile, write, Out, OpenOptions),
 3285            ( write_facts_header(Out),
 3286              maplist(write_fact(Out), Facts)
 3287            ),
 3288            close(Out))
 3289    ).
 3290
 3291update_facts([], Fact, [Fact]) :-
 3292    !.
 3293update_facts([H|T], Fact, [Fact|T]) :-
 3294    general_pack_fact(Fact, GenFact),
 3295    general_pack_fact(H, GenTerm),
 3296    GenFact =@= GenTerm,
 3297    !.
 3298update_facts([H|T0], Fact, [H|T]) :-
 3299    update_facts(T0, Fact, T).
 3300
 3301general_pack_fact(built(Arch, _Version, _How), General) =>
 3302    General = built(Arch, _, _).
 3303general_pack_fact(Term, General), compound(Term) =>
 3304    compound_name_arity(Term, Name, Arity),
 3305    compound_name_arity(General, Name, Arity).
 3306general_pack_fact(Term, General) =>
 3307    General = Term.
 3308
 3309write_facts_header(Out) :-
 3310    format(Out, '% Fact status file.  Managed by package manager.~n', []).
 3311
 3312write_fact(Out, Term) :-
 3313    format(Out, '~q.~n', [Term]).
 3314
 3315%!  pack_status(?Pack, ?Fact).
 3316%!  pack_status_dir(+PackDir, ?Fact)
 3317%
 3318%   True when Fact is true about the package in PackDir.  Facts
 3319%   are asserted a file `status.db`.
 3320
 3321pack_status(Pack, Fact) :-
 3322    current_pack(Pack, PackDir),
 3323    pack_status_dir(PackDir, Fact).
 3324
 3325pack_status_dir(PackDir, Fact) :-
 3326    det_if(ground(Fact), pack_status_(PackDir, Fact)).
 3327
 3328pack_status_(PackDir, Fact) :-
 3329    status_file(PackDir, StatusFile),
 3330    catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact),
 3331          error(existence_error(source_sink, StatusFile), _),
 3332          fail).
 3333
 3334pack_status_term(built(atom, version, oneof([built,downloaded]))).
 3335pack_status_term(automatic(boolean)).
 3336pack_status_term(archive(atom, atom)).
 3337
 3338
 3339%!  update_automatic(+Info) is det.
 3340%
 3341%   Update the _automatic_ status of a package.  If we install it has no
 3342%   automatic status and we install it  as   a  dependency we mark it as
 3343%   _automatic_. Else, we mark  it  as   non-automatic  as  it  has been
 3344%   installed explicitly.
 3345
 3346update_automatic(Info) :-
 3347    _ = Info.get(dependency_for),
 3348    \+ pack_status(Info.installed, automatic(_)),
 3349    !,
 3350    pack_assert(Info.installed, automatic(true)).
 3351update_automatic(Info) :-
 3352    pack_assert(Info.installed, automatic(false)).
 3353
 3354status_file(PackDir, StatusFile) :-
 3355    directory_file_path(PackDir, 'status.db', StatusFile).
 3356
 3357                 /*******************************
 3358                 *        USER INTERACTION      *
 3359                 *******************************/
 3360
 3361:- multifile prolog:message//1. 3362
 3363%!  menu(Question, +Alternatives, +Default, -Selection, +Options)
 3364
 3365menu(_Question, _Alternatives, Default, Selection, Options) :-
 3366    option(interactive(false), Options),
 3367    !,
 3368    Selection = Default.
 3369menu(Question, Alternatives, Default, Selection, _) :-
 3370    length(Alternatives, N),
 3371    between(1, 5, _),
 3372       print_message(query, Question),
 3373       print_menu(Alternatives, Default, 1),
 3374       print_message(query, pack(menu(select))),
 3375       read_selection(N, Choice),
 3376    !,
 3377    (   Choice == default
 3378    ->  Selection = Default
 3379    ;   nth1(Choice, Alternatives, Selection=_)
 3380    ->  true
 3381    ).
 3382
 3383print_menu([], _, _).
 3384print_menu([Value=Label|T], Default, I) :-
 3385    (   Value == Default
 3386    ->  print_message(query, pack(menu(default_item(I, Label))))
 3387    ;   print_message(query, pack(menu(item(I, Label))))
 3388    ),
 3389    I2 is I + 1,
 3390    print_menu(T, Default, I2).
 3391
 3392read_selection(Max, Choice) :-
 3393    get_single_char(Code),
 3394    (   answered_default(Code)
 3395    ->  Choice = default
 3396    ;   code_type(Code, digit(Choice)),
 3397        between(1, Max, Choice)
 3398    ->  true
 3399    ;   print_message(warning, pack(menu(reply(1,Max)))),
 3400        fail
 3401    ).
 3402
 3403%!  confirm(+Question, +Default, +Options) is semidet.
 3404%
 3405%   Ask for confirmation.
 3406%
 3407%   @arg Default is one of `yes`, `no` or `none`.
 3408
 3409confirm(_Question, Default, Options) :-
 3410    Default \== none,
 3411    option(interactive(false), Options, true),
 3412    !,
 3413    Default == yes.
 3414confirm(Question, Default, _) :-
 3415    between(1, 5, _),
 3416       print_message(query, pack(confirm(Question, Default))),
 3417       read_yes_no(YesNo, Default),
 3418    !,
 3419    format(user_error, '~N', []),
 3420    YesNo == yes.
 3421
 3422read_yes_no(YesNo, Default) :-
 3423    get_single_char(Code),
 3424    code_yes_no(Code, Default, YesNo),
 3425    !.
 3426
 3427code_yes_no(0'y, _, yes).
 3428code_yes_no(0'Y, _, yes).
 3429code_yes_no(0'n, _, no).
 3430code_yes_no(0'N, _, no).
 3431code_yes_no(_, none, _) :- !, fail.
 3432code_yes_no(C, Default, Default) :-
 3433    answered_default(C).
 3434
 3435answered_default(0'\r).
 3436answered_default(0'\n).
 3437answered_default(0'\s).
 3438
 3439
 3440                 /*******************************
 3441                 *            MESSAGES          *
 3442                 *******************************/
 3443
 3444:- multifile prolog:message//1. 3445
 3446prolog:message(pack(Message)) -->
 3447    message(Message).
 3448
 3449:- discontiguous
 3450    message//1,
 3451    label//1. 3452
 3453message(invalid_term(pack_info_term, Term)) -->
 3454    [ 'Invalid package meta data: ~q'-[Term] ].
 3455message(invalid_term(pack_status_term, Term)) -->
 3456    [ 'Invalid package status data: ~q'-[Term] ].
 3457message(directory_exists(Dir)) -->
 3458    [ 'Package target directory exists and is not empty:', nl,
 3459      '\t~q'-[Dir]
 3460    ].
 3461message(already_installed(pack(Pack, Version))) -->
 3462    [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ].
 3463message(already_installed(Pack)) -->
 3464    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 3465message(kept_foreign(Pack, Arch)) -->
 3466    [ 'Found foreign libraries for architecture '-[],
 3467      ansi(code, '~q', [Arch]), nl,
 3468      'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]),
 3469      ' to rebuild from sources'-[]
 3470    ].
 3471message(no_pack_installed(Pack)) -->
 3472    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 3473message(dependency_issues(Issues)) -->
 3474    [ 'The current set of packs has dependency issues:', nl ],
 3475    dep_issues(Issues).
 3476message(depends(Pack, Deps)) -->
 3477    [ 'The following packs depend on `~w\':'-[Pack], nl ],
 3478    pack_list(Deps).
 3479message(remove(PackDir)) -->
 3480    [ 'Removing ~q and contents'-[PackDir] ].
 3481message(remove_existing_pack(PackDir)) -->
 3482    [ 'Remove old installation in ~q'-[PackDir] ].
 3483message(download_plan(Plan)) -->
 3484    [ ansi(bold, 'Installation plan:', []), nl ],
 3485    install_plan(Plan, Actions),
 3486    install_label(Actions).
 3487message(build_plan(Plan)) -->
 3488    [ ansi(bold, 'The following packs have post install scripts:', []), nl ],
 3489    msg_build_plan(Plan),
 3490    [ nl, ansi(bold, 'Run scripts?', []) ].
 3491message(no_meta_data(BaseDir)) -->
 3492    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 3493message(search_no_matches(Name)) -->
 3494    [ 'Search for "~w", returned no matching packages'-[Name] ].
 3495message(rebuild(Pack)) -->
 3496    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 3497message(up_to_date([Pack])) -->
 3498    !,
 3499    [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ].
 3500message(up_to_date(Packs)) -->
 3501    [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ].
 3502message(installed_can_upgrade(List)) -->
 3503    sequence(msg_can_upgrade_target, [nl], List).
 3504message(new_dependencies(Deps)) -->
 3505    [ 'Found new dependencies after downloading (~p).'-[Deps], nl ].
 3506message(query_versions(URL)) -->
 3507    [ 'Querying "~w" to find new versions ...'-[URL] ].
 3508message(no_matching_urls(URL)) -->
 3509    [ 'Could not find any matching URL: ~q'-[URL] ].
 3510message(found_versions([Latest-_URL|More])) -->
 3511    { length(More, Len) },
 3512    [ '    Latest version: ~w (~D older)'-[Latest, Len] ].
 3513message(build(Pack, PackDir)) -->
 3514    [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ].
 3515message(contacting_server(Server)) -->
 3516    [ 'Contacting server at ~w ...'-[Server], flush ].
 3517message(server_reply(true(_))) -->
 3518    [ at_same_line, ' ok'-[] ].
 3519message(server_reply(false)) -->
 3520    [ at_same_line, ' done'-[] ].
 3521message(server_reply(exception(E))) -->
 3522    [ 'Server reported the following error:'-[], nl ],
 3523    '$messages':translate_message(E).
 3524message(cannot_create_dir(Alias)) -->
 3525    { findall(PackDir,
 3526              absolute_file_name(Alias, PackDir, [solutions(all)]),
 3527              PackDirs0),
 3528      sort(PackDirs0, PackDirs)
 3529    },
 3530    [ 'Cannot find a place to create a package directory.'-[],
 3531      'Considered:'-[]
 3532    ],
 3533    candidate_dirs(PackDirs).
 3534message(conflict(version, [PackV, FileV])) -->
 3535    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 3536    [', file claims version '-[]], msg_version(FileV).
 3537message(conflict(name, [PackInfo, FileInfo])) -->
 3538    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 3539    [', file claims ~w: ~p'-[FileInfo]].
 3540message(no_prolog_response(ContentType, String)) -->
 3541    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 3542      '~s'-[String]
 3543    ].
 3544message(download(begin, Pack, _URL, _DownloadFile)) -->
 3545    [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ].
 3546message(download(end, _, _, File)) -->
 3547    { size_file(File, Bytes) },
 3548    [ at_same_line, '~D bytes'-[Bytes] ].
 3549message(no_git(URL)) -->
 3550    [ 'Cannot install from git repository ', url(URL), '.', nl,
 3551      'Cannot find git program and do not know how to download the code', nl,
 3552      'from this git service.  Please install git and retry.'
 3553    ].
 3554message(git_no_https(GitURL)) -->
 3555    [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ].
 3556message(git_branch_not_default(Dir, Default, Current)) -->
 3557    [ 'GIT current branch on ', url(Dir), ' is not default.', nl,
 3558      '  Current branch: ', ansi(code, '~w', [Current]),
 3559      ' default: ', ansi(code, '~w', [Default])
 3560    ].
 3561message(git_not_clean(Dir)) -->
 3562    [ 'GIT working directory is dirty: ', url(Dir), nl,
 3563      'Your repository must be clean before publishing.'
 3564    ].
 3565message(git_push) -->
 3566    [ 'Push release to GIT origin?' ].
 3567message(git_tag(Tag)) -->
 3568    [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ].
 3569message(git_release_tag_not_at_head(Tag)) -->
 3570    [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl,
 3571      'If you want to update the tag, please run ',
 3572      ansi(code, 'git tag -d ~w', [Tag])
 3573    ].
 3574message(git_tag_out_of_sync(Tag)) -->
 3575    [ 'Release tag ', ansi(code, '~w', [Tag]),
 3576      ' differs from this tag at the origin'
 3577    ].
 3578
 3579message(published(Info, At)) -->
 3580    [ 'Published pack ' ], msg_pack(Info), msg_info_version(Info),
 3581    [' to be installed from '],
 3582    msg_published_address(At).
 3583message(publish_failed(Info, Reason)) -->
 3584    [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
 3585    msg_publish_failed(Reason).
 3586
 3587msg_publish_failed(throw(error(permission_error(register,
 3588                                                pack(_),_URL),_))) -->
 3589    [ ' is already registered with a different URL'].
 3590msg_publish_failed(download) -->
 3591    [' was already published?'].
 3592msg_publish_failed(Status) -->
 3593    [ ' failed for unknown reason (~p)'-[Status] ].
 3594
 3595msg_published_address(git(URL)) -->
 3596    msg_url(URL, _).
 3597msg_published_address(file(URL)) -->
 3598    msg_url(URL, _).
 3599
 3600candidate_dirs([]) --> [].
 3601candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 3602                                                % Questions
 3603message(resolve_remove) -->
 3604    [ nl, 'Please select an action:', nl, nl ].
 3605message(create_pack_dir) -->
 3606    [ nl, 'Create directory for packages', nl ].
 3607message(menu(item(I, Label))) -->
 3608    [ '~t(~d)~6|   '-[I] ],
 3609    label(Label).
 3610message(menu(default_item(I, Label))) -->
 3611    [ '~t(~d)~6| * '-[I] ],
 3612    label(Label).
 3613message(menu(select)) -->
 3614    [ nl, 'Your choice? ', flush ].
 3615message(confirm(Question, Default)) -->
 3616    message(Question),
 3617    confirm_default(Default),
 3618    [ flush ].
 3619message(menu(reply(Min,Max))) -->
 3620    (  { Max =:= Min+1 }
 3621    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 3622    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 3623    ).
 3624
 3625                                                % support predicates
 3626dep_issues(Issues) -->
 3627    sequence(dep_issue, [nl], Issues).
 3628
 3629dep_issue(unsatisfied(Pack, Requires)) -->
 3630    [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]].
 3631dep_issue(conflicts(Pack, Conflict)) -->
 3632    [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
 3633
 3634%!  install_plan(+Plan, -Actions)// is det.
 3635%!  install_label(+Actions)// is det.
 3636%
 3637%   Describe the overall installation plan before downloading.
 3638
 3639install_label([link]) -->
 3640    !,
 3641    [ ansi(bold, 'Activate pack?', []) ].
 3642install_label([unpack]) -->
 3643    !,
 3644    [ ansi(bold, 'Unpack archive?', []) ].
 3645install_label(_) -->
 3646    [ ansi(bold, 'Download packs?', []) ].
 3647
 3648
 3649install_plan(Plan, Actions) -->
 3650    install_plan(Plan, Actions, Sec),
 3651    sec_warning(Sec).
 3652
 3653install_plan([], [], _) -->
 3654    [].
 3655install_plan([H|T], [AH|AT], Sec) -->
 3656    install_step(H, AH, Sec), [nl],
 3657    install_plan(T, AT, Sec).
 3658
 3659install_step(Info, keep, _Sec) -->
 3660    { Info.get(keep) == true },
 3661    !,
 3662    [ '  Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
 3663    msg_can_upgrade(Info).
 3664install_step(Info, Action, Sec) -->
 3665    { From = Info.get(upgrade),
 3666      VFrom = From.version,
 3667      VTo = Info.get(version),
 3668      (   cmp_versions(>=, VTo, VFrom)
 3669      ->  Label = ansi(bold,    '  Upgrade ',   [])
 3670      ;   Label = ansi(warning, '  Downgrade ', [])
 3671      )
 3672    },
 3673    [ Label ], msg_pack(Info),
 3674    [ ' from version ~w to ~w'- [From.version, Info.get(version)] ],
 3675    install_from(Info, Action, Sec).
 3676install_step(Info, Action, Sec) -->
 3677    { _From = Info.get(upgrade) },
 3678    [ '  Upgrade '  ], msg_pack(Info),
 3679    install_from(Info, Action, Sec).
 3680install_step(Info, Action, Sec) -->
 3681    { Dep = Info.get(dependency_for) },
 3682    [ '  Install ' ], msg_pack(Info),
 3683    [ ' at version ~w as dependency for '-[Info.version],
 3684      ansi(code, '~w', [Dep])
 3685    ],
 3686    install_from(Info, Action, Sec),
 3687    msg_downloads(Info).
 3688install_step(Info, Action, Sec) -->
 3689    { Info.get(commit) == 'HEAD' },
 3690    !,
 3691    [ '  Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ],
 3692    install_from(Info, Action, Sec),
 3693    msg_downloads(Info).
 3694install_step(Info, link, _Sec) -->
 3695    { Info.get(link) == true,
 3696      uri_file_name(Info.get(url), Dir)
 3697    },
 3698    !,
 3699    [ '  Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ].
 3700install_step(Info, Action, Sec) -->
 3701    [ '  Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ],
 3702    install_from(Info, Action, Sec),
 3703    msg_downloads(Info).
 3704install_step(Info, Action, Sec) -->
 3705    [ '  Install ' ], msg_pack(Info),
 3706    install_from(Info, Action, Sec),
 3707    msg_downloads(Info).
 3708
 3709install_from(Info, download, Sec) -->
 3710    { download_url(Info.url) },
 3711    !,
 3712    [ ' from '  ], msg_url(Info.url, Sec).
 3713install_from(Info, unpack, Sec) -->
 3714    [ ' from '  ], msg_url(Info.url, Sec).
 3715
 3716msg_url(URL, unsafe) -->
 3717    { atomic(URL),
 3718      atom_concat('http://', Rest, URL)
 3719    },
 3720    [ ansi(error, '~w', ['http://']), '~w'-[Rest] ].
 3721msg_url(URL, _) -->
 3722    [ url(URL) ].
 3723
 3724sec_warning(Sec) -->
 3725    { var(Sec) },
 3726    !.
 3727sec_warning(unsafe) -->
 3728    [ ansi(warning, '  WARNING: The installation plan includes downloads \c
 3729                                from insecure HTTP servers.', []), nl
 3730    ].
 3731
 3732msg_downloads(Info) -->
 3733    { Downloads = Info.get(all_downloads),
 3734      Downloads > 0
 3735    },
 3736    [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ],
 3737    !.
 3738msg_downloads(_) -->
 3739    [].
 3740
 3741msg_pack(Pack) -->
 3742    { atom(Pack) },
 3743    !,
 3744    [ ansi(code, '~w', [Pack]) ].
 3745msg_pack(Info) -->
 3746    msg_pack(Info.pack).
 3747
 3748msg_info_version(Info) -->
 3749    [ ansi(code, '@~w', [Info.get(version)]) ],
 3750    !.
 3751msg_info_version(_Info) -->
 3752    [].
 3753
 3754%!  msg_build_plan(+Plan)//
 3755%
 3756%   Describe the build plan before running the build steps.
 3757
 3758msg_build_plan(Plan) -->
 3759    sequence(build_step, [nl], Plan).
 3760
 3761build_step(Info) -->
 3762    [ '  Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ].
 3763
 3764msg_can_upgrade_target(Info) -->
 3765    [ '  Pack ' ], msg_pack(Info),
 3766    [ ' is installed at version ~w'-[Info.version] ],
 3767    msg_can_upgrade(Info).
 3768
 3769pack_list([]) --> [].
 3770pack_list([H|T]) -->
 3771    [ '    - Pack ' ],  msg_pack(H), [nl],
 3772    pack_list(T).
 3773
 3774label(remove_only(Pack)) -->
 3775    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 3776label(remove_deps(Pack, Deps)) -->
 3777    { length(Deps, Count) },
 3778    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 3779label(create_dir(Dir)) -->
 3780    [ '~w'-[Dir] ].
 3781label(install_from(git(URL))) -->
 3782    !,
 3783    [ 'GIT repository at ~w'-[URL] ].
 3784label(install_from(URL)) -->
 3785    [ '~w'-[URL] ].
 3786label(cancel) -->
 3787    [ 'Cancel' ].
 3788
 3789confirm_default(yes) -->
 3790    [ ' Y/n? ' ].
 3791confirm_default(no) -->
 3792    [ ' y/N? ' ].
 3793confirm_default(none) -->
 3794    [ ' y/n? ' ].
 3795
 3796msg_version(Version) -->
 3797    [ '~w'-[Version] ].
 3798
 3799msg_can_upgrade(Info) -->
 3800    { Latest = Info.get(latest_version) },
 3801    [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ].
 3802msg_can_upgrade(_) -->
 3803    [].
 3804
 3805
 3806		 /*******************************
 3807		 *              MISC		*
 3808		 *******************************/
 3809
 3810local_uri_file_name(URL, FileName) :-
 3811    uri_file_name(URL, FileName),
 3812    !.
 3813local_uri_file_name(URL, FileName) :-
 3814    uri_components(URL, Components),
 3815    uri_data(scheme, Components, File), File == file,
 3816    uri_data(authority, Components, FileNameEnc),
 3817    uri_data(path, Components, ''),
 3818    uri_encoded(path, FileName, FileNameEnc).
 3819
 3820det_if(Cond, Goal) :-
 3821    (   Cond
 3822    ->  Goal,
 3823        !
 3824    ;   Goal
 3825    ).
 3826
 3827member_nonvar(_, Var) :-
 3828    var(Var),
 3829    !,
 3830    fail.
 3831member_nonvar(E, [E|_]).
 3832member_nonvar(E, [_|T]) :-
 3833    member_nonvar(E, T)