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