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