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