View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2012-2023, 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_property/2,            % ?Name, ?Property
   51            pack_attach/2,              % +Dir, +Options
   52
   53            pack_url_file/2             % +URL, -File
   54          ]).   55:- use_module(library(apply)).   56:- use_module(library(error)).   57:- use_module(library(option)).   58:- use_module(library(readutil)).   59:- use_module(library(lists)).   60:- use_module(library(filesex)).   61:- use_module(library(xpath)).   62:- use_module(library(settings)).   63:- use_module(library(uri)).   64:- use_module(library(dcg/basics)).   65:- use_module(library(http/http_open)).   66:- use_module(library(http/json)).   67:- use_module(library(http/http_client), []).   % plugin for POST support
   68:- use_module(library(prolog_config)).   69:- use_module(library(debug), [assertion/1]).   70:- use_module(library(pairs), [group_pairs_by_key/2]).   71% Stuff we may not have and may not need
   72:- autoload(library(git)).   73:- autoload(library(sgml)).   74:- autoload(library(sha)).   75:- autoload(library(build/tools)).   76
   77:- meta_predicate
   78    pack_install_local(2, +, +).   79
   80/** <module> A package manager for Prolog
   81
   82The library(prolog_pack) provides the SWI-Prolog   package manager. This
   83library lets you inspect installed   packages,  install packages, remove
   84packages, etc. It is complemented by   the  built-in attach_packs/0 that
   85makes installed packages available as libraries.
   86
   87To make changes to a package:
   88  * Clone the git repo, then go into the repo and run:
   89    `?- pack_install(.).`
   90    This builds the pack locally and creates a symlink to make it
   91    available.  It will also write a file `buildenv.sh` that you can
   92    source to get the environment for running a normal `make` (this is
   93    done only if there is a `configure` step; i.e., if there is a
   94    `configure.in` or `configure` file).
   95  * `(source ./buildenv.sh` && make)` to rebuild
   96  * `?- pack_rebuild(package_name).`
   97    This runs `make distclean` and `make` with the right environment.
   98  * The build process also supports `cmake`.
   99
  100Once you have made the changes, you should edit the `pack.pl` file
  101to change the `version` item. After updating the git repo, issue
  102a `pack_install(package_name, [upgrade(true), test(true), rebuild(make)])`
  103to cause the repository to refresh. You can simulate the full
  104installation process by removing all the build files in the package
  105(including any in submodules), running pack_install/1, and then
  106running pack_install using a =|file://|= URL.
  107
  108@see    Installed packages can be inspected using =|?- doc_browser.|=
  109@see    library(build/tools)
  110@tbd    Version logic
  111@tbd    Find and resolve conflicts
  112@tbd    Upgrade git packages
  113@tbd    Validate git packages
  114@tbd    Test packages: run tests from directory `test'.
  115*/
  116
  117:- multifile
  118    environment/2.                          % Name, Value
  119
  120:- dynamic
  121    pack_requires/2,                        % Pack, Requirement
  122    pack_provides_db/2.                     % Pack, Provided
  123
  124
  125                 /*******************************
  126                 *          CONSTANTS           *
  127                 *******************************/
  128
  129:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  130           'Server to exchange pack information').  131
  132
  133                 /*******************************
  134                 *         PACKAGE INFO         *
  135                 *******************************/
  136
  137%!  current_pack(?Pack) is nondet.
  138%!  current_pack(?Pack, ?Dir) is nondet.
  139%
  140%   True if Pack is a currently installed pack.
  141
  142current_pack(Pack) :-
  143    current_pack(Pack, _).
  144
  145current_pack(Pack, Dir) :-
  146    '$pack':pack(Pack, Dir).
  147
  148%!  pack_list_installed is det.
  149%
  150%   List currently installed  packages.  This calls
  151%
  152%       ?- pack_list('', [server(false)]).
  153%
  154%   @see pack_list/2.
  155
  156pack_list_installed :-
  157    pack_list('', [server(false)]).
  158
  159%!  pack_info(+Pack)
  160%
  161%   Print more detailed information about Pack.
  162
  163pack_info(Name) :-
  164    pack_info(info, Name).
  165
  166pack_info(Level, Name) :-
  167    must_be(atom, Name),
  168    findall(Info, pack_info(Name, Level, Info), Infos0),
  169    (   Infos0 == []
  170    ->  print_message(warning, pack(no_pack_installed(Name))),
  171        fail
  172    ;   true
  173    ),
  174    update_dependency_db(Name, Infos0),
  175    findall(Def,  pack_default(Level, Infos, Def), Defs),
  176    append(Infos0, Defs, Infos1),
  177    sort(Infos1, Infos),
  178    show_info(Name, Infos, [info(Level)]).
  179
  180
  181show_info(_Name, _Properties, Options) :-
  182    option(silent(true), Options),
  183    !.
  184show_info(Name, Properties, Options) :-
  185    option(info(list), Options),
  186    !,
  187    memberchk(title(Title), Properties),
  188    memberchk(version(Version), Properties),
  189    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  190show_info(Name, Properties, _) :-
  191    !,
  192    print_property_value('Package'-'~w', [Name]),
  193    findall(Term, pack_level_info(info, Term, _, _), Terms),
  194    maplist(print_property(Properties), Terms).
  195
  196print_property(_, nl) :-
  197    !,
  198    format('~n').
  199print_property(Properties, Term) :-
  200    findall(Term, member(Term, Properties), Terms),
  201    Terms \== [],
  202    !,
  203    pack_level_info(_, Term, LabelFmt, _Def),
  204    (   LabelFmt = Label-FmtElem
  205    ->  true
  206    ;   Label = LabelFmt,
  207        FmtElem = '~w'
  208    ),
  209    multi_valued(Terms, FmtElem, FmtList, Values),
  210    atomic_list_concat(FmtList, ', ', Fmt),
  211    print_property_value(Label-Fmt, Values).
  212print_property(_, _).
  213
  214multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  215    !,
  216    H =.. [_|Values].
  217multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  218    H =.. [_|VH],
  219    append(VH, MoreValues, Values),
  220    multi_valued(T, LabelFmt, LT, MoreValues).
  221
  222
  223pvalue_column(24).
  224print_property_value(Prop-Fmt, Values) :-
  225    !,
  226    pvalue_column(C),
  227    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  228    format(Format, [Prop,C|Values]).
  229
  230pack_info(Name, Level, Info) :-
  231    '$pack':pack(Name, BaseDir),
  232    pack_dir_info(BaseDir, Level, Info).
  233
  234pack_dir_info(BaseDir, Level, Info) :-
  235    (   Info = directory(BaseDir)
  236    ;   pack_info_term(BaseDir, Info)
  237    ),
  238    pack_level_info(Level, Info, _Format, _Default).
  239
  240:- public pack_level_info/4.                    % used by web-server
  241
  242pack_level_info(_,    title(_),         'Title',                   '<no title>').
  243pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  244pack_level_info(info, directory(_),     'Installed in directory',  -).
  245pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  246pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  247pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  248pack_level_info(info, home(_),          'Home page',               -).
  249pack_level_info(info, download(_),      'Download URL',            -).
  250pack_level_info(_,    provides(_),      'Provides',                -).
  251pack_level_info(_,    requires(_),      'Requires',                -).
  252pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  253pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  254pack_level_info(info, library(_),	'Provided libraries',      -).
  255
  256pack_default(Level, Infos, Def) :-
  257    pack_level_info(Level, ITerm, _Format, Def),
  258    Def \== (-),
  259    \+ memberchk(ITerm, Infos).
  260
  261%!  pack_info_term(+PackDir, ?Info) is nondet.
  262%
  263%   True when Info is meta-data for the package PackName.
  264
  265pack_info_term(BaseDir, Info) :-
  266    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  267    catch(
  268        setup_call_cleanup(
  269            open(InfoFile, read, In),
  270            term_in_stream(In, Info),
  271            close(In)),
  272        error(existence_error(source_sink, InfoFile), _),
  273        ( print_message(error, pack(no_meta_data(BaseDir))),
  274          fail
  275        )).
  276pack_info_term(BaseDir, library(Lib)) :-
  277    atom_concat(BaseDir, '/prolog/', LibDir),
  278    atom_concat(LibDir, '*.pl', Pattern),
  279    expand_file_name(Pattern, Files),
  280    maplist(atom_concat(LibDir), Plain, Files),
  281    convlist(base_name, Plain, Libs),
  282    member(Lib, Libs).
  283
  284base_name(File, Base) :-
  285    file_name_extension(Base, pl, File).
  286
  287term_in_stream(In, Term) :-
  288    repeat,
  289        read_term(In, Term0, []),
  290        (   Term0 == end_of_file
  291        ->  !, fail
  292        ;   Term = Term0,
  293            valid_info_term(Term0)
  294        ).
  295
  296valid_info_term(Term) :-
  297    Term =.. [Name|Args],
  298    same_length(Args, Types),
  299    Decl =.. [Name|Types],
  300    (   pack_info_term(Decl)
  301    ->  maplist(valid_info_arg, Types, Args)
  302    ;   print_message(warning, pack(invalid_info(Term))),
  303        fail
  304    ).
  305
  306valid_info_arg(Type, Arg) :-
  307    must_be(Type, Arg).
  308
  309%!  pack_info_term(?Term) is nondet.
  310%
  311%   True when Term describes name and   arguments of a valid package
  312%   info term.
  313
  314pack_info_term(name(atom)).                     % Synopsis
  315pack_info_term(title(atom)).
  316pack_info_term(keywords(list(atom))).
  317pack_info_term(description(list(atom))).
  318pack_info_term(version(version)).
  319pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  320pack_info_term(maintainer(atom, email_or_url)).
  321pack_info_term(packager(atom, email_or_url)).
  322pack_info_term(pack_version(nonneg)).           % Package convention version
  323pack_info_term(home(atom)).                     % Home page
  324pack_info_term(download(atom)).                 % Source
  325pack_info_term(provides(atom)).                 % Dependencies
  326pack_info_term(requires(dependency)).
  327pack_info_term(conflicts(dependency)).          % Conflicts with package
  328pack_info_term(replaces(atom)).                 % Replaces another package
  329pack_info_term(autoload(boolean)).              % Default installation options
  330
  331:- multifile
  332    error:has_type/2.  333
  334error:has_type(version, Version) :-
  335    atom(Version),
  336    version_data(Version, _Data).
  337error:has_type(email_or_url, Address) :-
  338    atom(Address),
  339    (   sub_atom(Address, _, _, _, @)
  340    ->  true
  341    ;   uri_is_global(Address)
  342    ).
  343error:has_type(email_or_url_or_empty, Address) :-
  344    (   Address == ''
  345    ->  true
  346    ;   error:has_type(email_or_url, Address)
  347    ).
  348error:has_type(dependency, Value) :-
  349    is_dependency(Value, _Token, _Version).
  350
  351version_data(Version, version(Data)) :-
  352    atomic_list_concat(Parts, '.', Version),
  353    maplist(atom_number, Parts, Data).
  354
  355is_dependency(Token, Token, *) :-
  356    atom(Token).
  357is_dependency(Term, Token, VersionCmp) :-
  358    Term =.. [Op,Token,Version],
  359    cmp(Op, _),
  360    version_data(Version, _),
  361    VersionCmp =.. [Op,Version].
  362
  363cmp(<,  @<).
  364cmp(=<, @=<).
  365cmp(==, ==).
  366cmp(>=, @>=).
  367cmp(>,  @>).
  368
  369
  370                 /*******************************
  371                 *            SEARCH            *
  372                 *******************************/
  373
  374%!  pack_list(+Query) is det.
  375%!  pack_list(+Query, +Options) is det.
  376%!  pack_search(+Query) is det.
  377%
  378%   Query package server and  installed   packages  and display results.
  379%   Query is matches case-insensitively against the   name  and title of
  380%   known and installed packages. For each   matching  package, a single
  381%   line is displayed that provides:
  382%
  383%     - Installation status
  384%       - *p*: package, not installed
  385%       - *i*: installed package; up-to-date with public version
  386%       - *U*: installed package; can be upgraded
  387%       - *A*: installed package; newer than publically available
  388%       - *l*: installed package; not on server
  389%     - Name@Version
  390%     - Name@Version(ServerVersion)
  391%     - Title
  392%
  393%   Options processed:
  394%
  395%     - installed(true)
  396%       Only list packages that are locally installed.  Contacts the
  397%       server to compare our local version to the latest available
  398%       version.
  399%     - outdated(true)
  400%       Only list packages that need to be updated.  This option
  401%       implies installed(true).
  402%     - server(Server|false)
  403%       If `false`, do not contact the server. This implies
  404%       installed(true).  Otherwise, use the given pack server.
  405%
  406%   Hint: =|?- pack_list('').|= lists all packages.
  407%
  408%   The predicates pack_list/1 and  pack_search/1   are  synonyms.  Both
  409%   contact the package server  at   https://www.swi-prolog.org  to find
  410%   available packages.
  411%
  412%   @see    pack_list_installed/0 to list installed packages without
  413%           contacting the server.
  414
  415pack_list(Query) :-
  416    pack_list(Query, []).
  417
  418pack_search(Query) :-
  419    pack_list(Query, []).
  420
  421pack_list(Query, Options) :-
  422    (   option(installed(true), Options)
  423    ;   option(outdated(true), Options)
  424    ;   option(server(false), Options)
  425    ),
  426    !,
  427    local_search(Query, Local),
  428    maplist(arg(1), Local, Packs),
  429    (   option(server(false), Options)
  430    ->  Hits = []
  431    ;   query_pack_server(info(Packs), true(Hits), [])
  432    ),
  433    list_hits(Hits, Local, Options).
  434pack_list(Query, _Options) :-
  435    query_pack_server(search(Query), Result, []),
  436    (   Result == false
  437    ->  (   local_search(Query, Packs),
  438            Packs \== []
  439        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  440                   format('~w ~w@~w ~28|- ~w~n',
  441                          [Stat, Pack, Version, Title]))
  442        ;   print_message(warning, pack(search_no_matches(Query)))
  443        )
  444    ;   Result = true(Hits),       % Hits = list(pack(Name, p, Title, Version, URL))
  445        local_search(Query, Local),
  446        list_hits(Hits, Local, [])
  447    ).
  448
  449list_hits(Hits, Local, Options) :-
  450    append(Hits, Local, All),
  451    sort(All, Sorted),
  452    join_status(Sorted, Packs0),
  453    include(filtered(Options), Packs0, Packs),
  454    maplist(list_hit(Options), Packs).
  455
  456filtered(Options, pack(_,Tag,_,_,_)) :-
  457    option(outdated(true), Options),
  458    !,
  459    Tag == 'U'.
  460filtered(_, _).
  461
  462list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) =>
  463    list_tag(Tag),
  464    ansi_format(code, '~w', [Pack]),
  465    format('@'),
  466    list_version(Tag, Version),
  467    format('~35|- ', []),
  468    ansi_format(comment, '~w~n', [Title]).
  469
  470list_tag(Tag) :-
  471    tag_color(Tag, Color),
  472    ansi_format(Color, '~w ', [Tag]).
  473
  474list_version(Tag, VersionI-VersionS) =>
  475    tag_color(Tag, Color),
  476    ansi_format(Color, '~w', [VersionI]),
  477    ansi_format(bold, '(~w)', [VersionS]).
  478list_version(_Tag, Version) =>
  479    ansi_format([], '~w', [Version]).
  480
  481tag_color('U', warning) :- !.
  482tag_color('A', comment) :- !.
  483tag_color(_, []).
  484
  485%!  join_status(+PacksIn, -PacksOut) is det.
  486%
  487%   Combine local and remote information to   assess  the status of each
  488%   package. PacksOut is a list of  pack(Name, Status, Version, URL). If
  489%   the     versions     do      not       match,      `Version`      is
  490%   `VersionInstalled-VersionRemote` and similar for thee URL.
  491
  492join_status([], []).
  493join_status([ pack(Pack, i, Title, Version, URL),
  494              pack(Pack, p, Title, Version, _)
  495            | T0
  496            ],
  497            [ pack(Pack, i, Title, Version, URL)
  498            | T
  499            ]) :-
  500    !,
  501    join_status(T0, T).
  502join_status([ pack(Pack, i, Title, VersionI, URLI),
  503              pack(Pack, p, _,     VersionS, URLS)
  504            | T0
  505            ],
  506            [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS)
  507            | T
  508            ]) :-
  509    !,
  510    version_data(VersionI, VDI),
  511    version_data(VersionS, VDS),
  512    (   VDI @< VDS
  513    ->  Tag = 'U'
  514    ;   Tag = 'A'
  515    ),
  516    join_status(T0, T).
  517join_status([ pack(Pack, i, Title, VersionI, URL)
  518            | T0
  519            ],
  520            [ pack(Pack, l, Title, VersionI, URL)
  521            | T
  522            ]) :-
  523    !,
  524    join_status(T0, T).
  525join_status([H|T0], [H|T]) :-
  526    join_status(T0, T).
  527
  528%!  local_search(+Query, -Packs:list(atom)) is det.
  529%
  530%   Search locally installed packs.
  531
  532local_search(Query, Packs) :-
  533    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  534
  535matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  536    current_pack(Pack),
  537    findall(Term,
  538            ( pack_info(Pack, _, Term),
  539              search_info(Term)
  540            ), Info),
  541    (   sub_atom_icasechk(Pack, _, Query)
  542    ->  true
  543    ;   memberchk(title(Title), Info),
  544        sub_atom_icasechk(Title, _, Query)
  545    ),
  546    option(title(Title), Info, '<no title>'),
  547    option(version(Version), Info, '<no version>'),
  548    option(download(URL), Info, '<no download url>').
  549
  550search_info(title(_)).
  551search_info(version(_)).
  552search_info(download(_)).
  553
  554
  555                 /*******************************
  556                 *            INSTALL           *
  557                 *******************************/
  558
  559%!  pack_install(+Spec:atom) is det.
  560%
  561%   Install a package.  Spec is one of
  562%
  563%     * A package name.  This queries the package repository
  564%       at http://www.swi-prolog.org
  565%     * Archive file name
  566%     * HTTP URL of an archive file name.  This URL may contain a
  567%       star (*) for the version.  In this case pack_install asks
  568%       for the directory content and selects the latest version.
  569%     * GIT URL (not well supported yet)
  570%     * A local directory name given as =|file://|= URL
  571%     * `'.'`, in which case a relative symlink is created to the
  572%       current directory (all other options for Spec make a copy
  573%       of the files).
  574%
  575%   After resolving the type of package,   pack_install/2 is used to
  576%   do the actual installation.
  577
  578pack_install(Spec) :-
  579    pack_default_options(Spec, Pack, [], Options),
  580    pack_install(Pack, [pack(Pack)|Options]).
  581
  582%!  pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det.
  583%
  584%   Establish  the  pack  name  (Pack)  and    install  options  from  a
  585%   specification and options (OptionsIn) provided by the user.
  586
  587pack_default_options(_Spec, Pack, OptsIn, Options) :-
  588    option(already_installed(pack(Pack,_Version)), OptsIn),
  589    !,
  590    Options = OptsIn.
  591pack_default_options(_Spec, Pack, OptsIn, Options) :-
  592    option(url(URL), OptsIn),
  593    !,
  594    (   option(git(_), OptsIn)
  595    ->  Options = OptsIn
  596    ;   git_url(URL, Pack)
  597    ->  Options = [git(true)|OptsIn]
  598    ;   Options = OptsIn
  599    ),
  600    (   nonvar(Pack)
  601    ->  true
  602    ;   option(pack(Pack), Options)
  603    ->  true
  604    ;   pack_version_file(Pack, _Version, URL)
  605    ).
  606pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  607    must_be(atom, Archive),
  608    \+ uri_is_global(Archive),
  609    expand_file_name(Archive, [File]),
  610    exists_file(File),
  611    !,
  612    pack_version_file(Pack, Version, File),
  613    uri_file_name(FileURL, File),
  614    Options = [url(FileURL), version(Version)].
  615pack_default_options(URL, Pack, _, Options) :-
  616    git_url(URL, Pack),
  617    !,
  618    Options = [git(true), url(URL)].
  619pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  620    uri_file_name(FileURL, Dir),
  621    exists_directory(Dir),
  622    pack_info_term(Dir, name(Pack)),
  623    !,
  624    (   pack_info_term(Dir, version(Version))
  625    ->  uri_file_name(DirURL, Dir),
  626        Options = [url(DirURL), version(Version)]
  627    ;   throw(error(existence_error(key, version, Dir),_))
  628    ).
  629pack_default_options('.', Pack, _, Options) :-          % Install from CWD
  630    pack_info_term('.', name(Pack)),
  631    !,
  632    working_directory(Dir, Dir),
  633    (   pack_info_term(Dir, version(Version))
  634    ->  uri_file_name(DirURL, Dir),
  635        Options = [url(DirURL), version(Version) | Options1],
  636        (   current_prolog_flag(windows, true)
  637        ->  Options1 = []
  638        ;   Options1 = [link(true), rebuild(make)]
  639        )
  640    ;   throw(error(existence_error(key, version, Dir),_))
  641    ).
  642pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  643    pack_version_file(Pack, Version, URL),
  644    download_url(URL),
  645    !,
  646    available_download_versions(URL, [URLVersion-LatestURL|_]),
  647    Options = [url(LatestURL)|VersionOptions],
  648    version_options(Version, URLVersion, VersionOptions).
  649pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  650    \+ uri_is_global(Pack),                             % ignore URLs
  651    query_pack_server(locate(Pack), Reply, OptsIn),
  652    (   Reply = true(Results)
  653    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  654    ;   print_message(warning, pack(no_match(Pack))),
  655        fail
  656    ).
  657
  658version_options(Version, Version, [version(Version)]) :- !.
  659version_options(Version, _, [version(Version)]) :-
  660    Version = version(List),
  661    maplist(integer, List),
  662    !.
  663version_options(_, _, []).
  664
  665%!  pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)
  666%
  667%   Select from available packages.
  668
  669pack_select_candidate(Pack, [AtomVersion-_|_], Options,
  670                      [already_installed(pack(Pack, Installed))|Options]) :-
  671    current_pack(Pack),
  672    pack_info(Pack, _, version(InstalledAtom)),
  673    atom_version(InstalledAtom, Installed),
  674    atom_version(AtomVersion, Version),
  675    Installed @>= Version,
  676    in_explicit_pack_dir(Pack, Options),
  677    !.
  678pack_select_candidate(_Pack, Available, Options, OptsOut) :-
  679    option(url(URL), Options),
  680    memberchk(_Version-URLs, Available),
  681    memberchk(URL, URLs),
  682    !,
  683    (   git_url(URL, _)
  684    ->  Extra = [git(true)]
  685    ;   Extra = []
  686    ),
  687    OptsOut = [url(URL), inquiry(true) | Extra].
  688pack_select_candidate(Pack, [Version-[URL]|_], Options,
  689                      [url(URL), git(true), inquiry(true)]) :-
  690    git_url(URL, _Pack),
  691    !,
  692    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  693pack_select_candidate(Pack, [Version-[URL]|More], Options,
  694                      [url(URL), inquiry(true) | Upgrade]) :-
  695    (   More == []
  696    ->  !
  697    ;   true
  698    ),
  699    confirm(install_from(Pack, Version, URL), yes, Options),
  700    !,
  701    add_upgrade(Pack, Upgrade).
  702pack_select_candidate(Pack, [Version-URLs|_], Options,
  703                      [url(URL), inquiry(true)|Rest]) :-
  704    maplist(url_menu_item, URLs, Tagged),
  705    append(Tagged, [cancel=cancel], Menu),
  706    Menu = [Default=_|_],
  707    menu(pack(select_install_from(Pack, Version)),
  708         Menu, Default, Choice, Options),
  709    (   Choice == cancel
  710    ->  fail
  711    ;   Choice = git(URL)
  712    ->  Rest = [git(true)|Upgrade]
  713    ;   Choice = URL,
  714        Rest = Upgrade
  715    ),
  716    add_upgrade(Pack, Upgrade).
  717
  718add_upgrade(Pack, Options) :-
  719    current_pack(Pack),
  720    !,
  721    Options = [upgrade(true)].
  722add_upgrade(_, []).
  723
  724url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  725    git_url(URL, _),
  726    !.
  727url_menu_item(URL, URL=install_from(URL)).
  728
  729%!  in_explicit_pack_dir(+Pack, +Options) is semidet.
  730%
  731%   True when Pack is installed in the explicit target directory.
  732
  733in_explicit_pack_dir(Pack, Options) :-
  734    option(package_directory(Root), Options),
  735    current_pack(Pack, PackDir),
  736    file_directory_name(PackDir, Parent),
  737    same_file(Parent, Root).
  738
  739%!  pack_install(+Name, +Options) is det.
  740%
  741%   Install package Name.  Processes  the   options  below.  Default
  742%   options as would be used by  pack_install/1 are used to complete
  743%   the provided Options.
  744%
  745%     * url(+URL)
  746%     Source for downloading the package
  747%     * package_directory(+Dir)
  748%     Directory into which to install the package.
  749%     * global(+Boolean)
  750%     If `true`, install in the XDG common application data path, making
  751%     the pack accessible to everyone. If `false`, install in the XDG
  752%     user application data path, making the pack accessible for the
  753%     current user only.  If the option is absent, use the first
  754%     existing and writable directory.  If that doesn't exist find
  755%     locations where it can be created and prompt the user to do
  756%     so.
  757%     * insecure(+Boolean)
  758%     When `true` (default `false`), do not perform any checks on SSL
  759%     certificates when downloading using `https`.
  760%     * interactive(+Boolean)
  761%     Use default answer without asking the user if there
  762%     is a default action.
  763%     * silent(+Boolean)
  764%     If `true` (default false), suppress informational progress
  765%     messages.
  766%     * upgrade(+Boolean)
  767%     If `true` (default `false`), upgrade package if it is already
  768%     installed.
  769%     * rebuild(Condition)
  770%     Rebuild the foreign components.  Condition is one of
  771%     `if_absent` (default, do nothing if the directory with foreign
  772%     resources exists), `make` (run `make`) or `true` (run `make
  773%     distclean` followed by the default configure and build steps).
  774%     * test(Boolean)
  775%     If `true` (default), run the pack tests.
  776%     * git(+Boolean)
  777%     If `true` (default `false` unless `URL` ends with =.git=),
  778%     assume the URL is a GIT repository.
  779%     * link(+Boolean)
  780%     Can be used if the installation source is a local directory
  781%     and the file system supports symbolic links.  In this case
  782%     the system adds the current directory to the pack registration
  783%     using a symbolic link and performs the local installation steps.
  784%
  785%   Non-interactive installation can be established using the option
  786%   interactive(false). It is adviced to   install from a particular
  787%   _trusted_ URL instead of the  plain   pack  name  for unattented
  788%   operation.
  789
  790pack_install(Spec, Options) :-
  791    pack_default_options(Spec, Pack, Options, DefOptions),
  792    (   option(already_installed(Installed), DefOptions)
  793    ->  print_message(informational, pack(already_installed(Installed)))
  794    ;   merge_options(Options, DefOptions, PackOptions),
  795        update_dependency_db,
  796        pack_install_dir(PackDir, PackOptions),
  797        pack_install(Pack, PackDir, PackOptions),
  798        pack_make_available(Pack, PackDir, PackOptions)
  799    ).
  800
  801pack_install_dir(PackDir, Options) :-
  802    option(package_directory(PackDir), Options),
  803    !.
  804pack_install_dir(PackDir, Options) :-
  805    base_alias(Alias, Options),
  806    absolute_file_name(Alias, PackDir,
  807                       [ file_type(directory),
  808                         access(write),
  809                         file_errors(fail)
  810                       ]),
  811    !.
  812pack_install_dir(PackDir, Options) :-
  813    pack_create_install_dir(PackDir, Options).
  814
  815base_alias(Alias, Options) :-
  816    option(global(true), Options),
  817    !,
  818    Alias = common_app_data(pack).
  819base_alias(Alias, Options) :-
  820    option(global(false), Options),
  821    !,
  822    Alias = user_app_data(pack).
  823base_alias(Alias, _Options) :-
  824    Alias = pack('.').
  825
  826pack_create_install_dir(PackDir, Options) :-
  827    base_alias(Alias, Options),
  828    findall(Candidate = create_dir(Candidate),
  829            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  830              \+ exists_file(Candidate),
  831              \+ exists_directory(Candidate),
  832              file_directory_name(Candidate, Super),
  833              (   exists_directory(Super)
  834              ->  access_file(Super, write)
  835              ;   true
  836              )
  837            ),
  838            Candidates0),
  839    list_to_set(Candidates0, Candidates),   % keep order
  840    pack_create_install_dir(Candidates, PackDir, Options).
  841
  842pack_create_install_dir(Candidates, PackDir, Options) :-
  843    Candidates = [Default=_|_],
  844    !,
  845    append(Candidates, [cancel=cancel], Menu),
  846    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  847    Selected \== cancel,
  848    (   catch(make_directory_path(Selected), E,
  849              (print_message(warning, E), fail))
  850    ->  PackDir = Selected
  851    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  852        pack_create_install_dir(Remaining, PackDir, Options)
  853    ).
  854pack_create_install_dir(_, _, _) :-
  855    print_message(error, pack(cannot_create_dir(pack(.)))),
  856    fail.
  857
  858
  859%!  pack_install(+Pack, +PackDir, +Options)
  860%
  861%   Install package Pack into PackDir.  Options:
  862%
  863%     - url(URL)
  864%     Install from the given URL, URL is either a file://, a git URL
  865%     or a download URL.
  866%     - upgrade(Boolean)
  867%     If Pack is already installed and Boolean is `true`, update the
  868%     package to the latest version.  If Boolean is `false` print
  869%     an error and fail.
  870
  871pack_install(Name, _, Options) :-
  872    current_pack(Name, Dir),
  873    option(upgrade(false), Options, false),
  874    \+ pack_is_in_local_dir(Name, Dir, Options),
  875    (   option(package_directory(_), Options)
  876    ->  in_explicit_pack_dir(Name, Options)
  877    ;   true
  878    ),
  879    print_message(error, pack(already_installed(Name))),
  880    pack_info(Name),
  881    print_message(information, pack(remove_with(Name))),
  882    !,
  883    fail.
  884pack_install(Name, PackDir, Options) :-
  885    option(url(URL), Options),
  886    uri_file_name(URL, Source),
  887    !,
  888    pack_install_from_local(Source, PackDir, Name, Options).
  889pack_install(Name, PackDir, Options) :-
  890    option(url(URL), Options),
  891    uri_components(URL, Components),
  892    uri_data(scheme, Components, Scheme),
  893    pack_install_from_url(Scheme, URL, PackDir, Name, Options).
  894
  895%!  pack_install_from_local(+Source, +PackTopDir, +Name, +Options)
  896%
  897%   Install a package from a local media.
  898%
  899%   @tbd    Provide an option to install directories using a
  900%           link (or file-links).
  901
  902pack_install_from_local(Source, PackTopDir, Name, Options) :-
  903    exists_directory(Source),
  904    !,
  905    directory_file_path(PackTopDir, Name, PackDir),
  906    (   option(link(true), Options)
  907    ->  (   same_file(Source, PackDir)
  908        ->  true
  909        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  910            relative_file_name(Source, PackTopDirS, RelPath),
  911            link_file(RelPath, PackDir, symbolic),
  912            assertion(same_file(Source, PackDir))
  913        )
  914    ;   prepare_pack_dir(PackDir, Options),
  915        copy_directory(Source, PackDir)
  916    ),
  917    pack_post_install(Name, PackDir, Options).
  918pack_install_from_local(Source, PackTopDir, Name, Options) :-
  919    exists_file(Source),
  920    directory_file_path(PackTopDir, Name, PackDir),
  921    prepare_pack_dir(PackDir, Options),
  922    pack_unpack(Source, PackDir, Name, Options),
  923    pack_post_install(Name, PackDir, Options).
  924
  925pack_is_in_local_dir(_Pack, PackDir, Options) :-
  926    option(url(DirURL), Options),
  927    uri_file_name(DirURL, Dir),
  928    same_file(PackDir, Dir).
  929
  930
  931%!  pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
  932%
  933%   Unpack an archive to the given package dir.
  934
  935:- if(exists_source(library(archive))).  936pack_unpack(Source, PackDir, Pack, Options) :-
  937    ensure_loaded_archive,
  938    pack_archive_info(Source, Pack, _Info, StripOptions),
  939    prepare_pack_dir(PackDir, Options),
  940    archive_extract(Source, PackDir,
  941                    [ exclude(['._*'])          % MacOS resource forks
  942                    | StripOptions
  943                    ]).
  944:- else.  945pack_unpack(_,_,_,_) :-
  946    existence_error(library, archive).
  947:- endif.  948
  949%!  pack_install_local(:Spec, +Dir, +Options) is det.
  950%
  951%   Install a number of packages in   a  local directory. This predicate
  952%   supports installing packages local  to   an  application rather than
  953%   globally.
  954
  955pack_install_local(_:Pairs, Dir, Options), is_list(Pairs) =>
  956    ensure_directory(Dir),
  957    pairs_keys(Pairs, Packs),
  958    query_pack_server(info(Packs), true(Hits), []),
  959    local_packs(Dir, Existing),
  960    maplist(pack_install_local_(Hits, Existing,
  961                                [ package_directory(Dir)|Options
  962                                ]),
  963            Pairs).
  964pack_install_local(M:Gen, Dir, Options), callable(Gen) =>
  965    findall(Pack-Options, call(M:Gen, Pack, Options), Pairs),
  966    pack_install_local(Pairs, Dir, Options).
  967pack_install_local(Spec, _, _) =>
  968    type_error(pairs_or_callable, Spec).
  969
  970%!  pack_install_local_(+Latest, +Installed, +Options,
  971%!                      +PackAndOptions) is det.
  972
  973pack_install_local_(_Latest, Installed, _Options, Pack-PackOptions) :-
  974    option(version(ReqVersion), PackOptions),
  975    memberchk(pack(Pack, i, _Title, Version, _URL), Installed),
  976    catch(require_version(pack(Pack), Version, ReqVersion),
  977          error(version_error(pack(Pack), Version, ReqVersion),_),
  978          fail),
  979    !.                                          % matching version
  980pack_install_local_(Latest, Installed, Options, Pack-PackOptions) :-
  981    memberchk(pack(Pack, p, _TitleS, VersionS, _URLS), Latest),
  982    memberchk(pack(Pack, i, _TitleI, VersionI, _URLI), Installed),
  983    !,
  984    version_data(VersionI, VDI),
  985    version_data(VersionS, VDS),
  986    (   VDI @< VDS
  987    ->  merge_options([upgrade(true)|PackOptions], Options, InstallOptions),
  988        pack_install(Pack, InstallOptions)
  989    ;   true                                    % up-to-date
  990    ).
  991pack_install_local_(Latest, _Installed, Options, Pack-PackOptions) :-
  992    memberchk(pack(Pack, p, _Title, _Version, _URL), Latest),
  993    !,
  994    merge_options([upgrade(true)|PackOptions], Options, InstallOptions),
  995    pack_install(Pack, InstallOptions).         % not installed
  996pack_install_local_(_Latest, _Installed, _Options, Pack-_PackOptions) :-
  997    print_message(error, pack(no_match(Pack))). % not known
  998
  999%!  local_packs(+Dir, -Packs) is det.
 1000%
 1001%   True when Packs is a list of   package search term results for packs
 1002%   installed in Dir.
 1003
 1004local_packs(Dir, Packs) :-
 1005    findall(Pack, pack_in_subdir(Dir, Pack), Packs).
 1006
 1007pack_in_subdir(Dir, pack(Pack, i, Title, Version, URL)) :-
 1008    directory_member(Dir, PackDir,
 1009                     [ file_type(directory),
 1010                       hidden(false)
 1011                     ]),
 1012    directory_file_path(PackDir, 'pack.pl', MetaFile),
 1013    exists_file(MetaFile),
 1014    file_base_name(PackDir, DirName),
 1015    findall(Term,
 1016            ( pack_dir_info(PackDir, _, Term),
 1017              search_info(Term)
 1018            ), Info),
 1019    option(pack(Pack), Info, DirName),
 1020    option(title(Title), Info, '<no title>'),
 1021    option(version(Version), Info, '<no version>'),
 1022    option(download(URL), Info, '<no download url>').
 1023
 1024
 1025                 /*******************************
 1026                 *             INFO             *
 1027                 *******************************/
 1028
 1029%!  pack_archive_info(+Archive, +Pack, -Info, -Strip)
 1030%
 1031%   True when Archive archives Pack. Info  is unified with the terms
 1032%   from pack.pl in the  pack  and   Strip  is  the strip-option for
 1033%   archive_extract/3.
 1034%
 1035%   Requires library(archive), which is lazily loaded when needed.
 1036%
 1037%   @error  existence_error(pack_file, 'pack.pl') if the archive
 1038%           doesn't contain pack.pl
 1039%   @error  Syntax errors if pack.pl cannot be parsed.
 1040
 1041:- if(exists_source(library(archive))). 1042ensure_loaded_archive :-
 1043    current_predicate(archive_open/3),
 1044    !.
 1045ensure_loaded_archive :-
 1046    use_module(library(archive)).
 1047
 1048pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
 1049    ensure_loaded_archive,
 1050    size_file(Archive, Bytes),
 1051    setup_call_cleanup(
 1052        archive_open(Archive, Handle, []),
 1053        (   repeat,
 1054            (   archive_next_header(Handle, InfoFile)
 1055            ->  true
 1056            ;   !, fail
 1057            )
 1058        ),
 1059        archive_close(Handle)),
 1060    file_base_name(InfoFile, 'pack.pl'),
 1061    atom_concat(Prefix, 'pack.pl', InfoFile),
 1062    strip_option(Prefix, Pack, Strip),
 1063    setup_call_cleanup(
 1064        archive_open_entry(Handle, Stream),
 1065        read_stream_to_terms(Stream, Info),
 1066        close(Stream)),
 1067    !,
 1068    must_be(ground, Info),
 1069    maplist(valid_info_term, Info).
 1070:- else. 1071pack_archive_info(_, _, _, _) :-
 1072    existence_error(library, archive).
 1073:- endif. 1074pack_archive_info(_, _, _, _) :-
 1075    existence_error(pack_file, 'pack.pl').
 1076
 1077strip_option('', _, []) :- !.
 1078strip_option('./', _, []) :- !.
 1079strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
 1080    atom_concat(PrefixDir, /, Prefix),
 1081    file_base_name(PrefixDir, Base),
 1082    (   Base == Pack
 1083    ->  true
 1084    ;   pack_version_file(Pack, _, Base)
 1085    ->  true
 1086    ;   \+ sub_atom(PrefixDir, _, _, _, /)
 1087    ).
 1088
 1089read_stream_to_terms(Stream, Terms) :-
 1090    read(Stream, Term0),
 1091    read_stream_to_terms(Term0, Stream, Terms).
 1092
 1093read_stream_to_terms(end_of_file, _, []) :- !.
 1094read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
 1095    read(Stream, Term1),
 1096    read_stream_to_terms(Term1, Stream, Terms).
 1097
 1098
 1099%!  pack_git_info(+GitDir, -Hash, -Info) is det.
 1100%
 1101%   Retrieve info from a cloned git   repository  that is compatible
 1102%   with pack_archive_info/4.
 1103
 1104pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
 1105    exists_directory(GitDir),
 1106    !,
 1107    git_ls_tree(Entries, [directory(GitDir)]),
 1108    git_hash(Hash, [directory(GitDir)]),
 1109    maplist(arg(4), Entries, Sizes),
 1110    sum_list(Sizes, Bytes),
 1111    directory_file_path(GitDir, 'pack.pl', InfoFile),
 1112    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
 1113    must_be(ground, Info),
 1114    maplist(valid_info_term, Info).
 1115
 1116%!  download_file_sanity_check(+Archive, +Pack, +Info) is semidet.
 1117%
 1118%   Perform basic sanity checks on DownloadFile
 1119
 1120download_file_sanity_check(Archive, Pack, Info) :-
 1121    info_field(name(Name), Info),
 1122    info_field(version(VersionAtom), Info),
 1123    atom_version(VersionAtom, Version),
 1124    pack_version_file(PackA, VersionA, Archive),
 1125    must_match([Pack, PackA, Name], name),
 1126    must_match([Version, VersionA], version).
 1127
 1128info_field(Field, Info) :-
 1129    memberchk(Field, Info),
 1130    ground(Field),
 1131    !.
 1132info_field(Field, _Info) :-
 1133    functor(Field, FieldName, _),
 1134    print_message(error, pack(missing(FieldName))),
 1135    fail.
 1136
 1137must_match(Values, _Field) :-
 1138    sort(Values, [_]),
 1139    !.
 1140must_match(Values, Field) :-
 1141    print_message(error, pack(conflict(Field, Values))),
 1142    fail.
 1143
 1144
 1145                 /*******************************
 1146                 *         INSTALLATION         *
 1147                 *******************************/
 1148
 1149%!  prepare_pack_dir(+Dir, +Options)
 1150%
 1151%   Prepare for installing the package into  Dir. This
 1152%
 1153%     - If the directory exist and is empty, done.
 1154%     - Else if the directory exists, remove the directory and recreate
 1155%       it. Note that if the directory is a symlink this just deletes
 1156%       the link.
 1157%     - Else create the directory.
 1158
 1159prepare_pack_dir(Dir, Options) :-
 1160    exists_directory(Dir),
 1161    !,
 1162    (   empty_directory(Dir)
 1163    ->  true
 1164    ;   (   option(upgrade(true), Options)
 1165        ;   confirm(remove_existing_pack(Dir), yes, Options)
 1166        )
 1167    ->  delete_directory_and_contents(Dir),
 1168        make_directory(Dir)
 1169    ).
 1170prepare_pack_dir(Dir, _) :-
 1171    make_directory(Dir).
 1172
 1173%!  empty_directory(+Directory) is semidet.
 1174%
 1175%   True if Directory is empty (holds no files or sub-directories).
 1176
 1177empty_directory(Dir) :-
 1178    \+ ( directory_files(Dir, Entries),
 1179         member(Entry, Entries),
 1180         \+ special(Entry)
 1181       ).
 1182
 1183special(.).
 1184special(..).
 1185
 1186
 1187%!  pack_install_from_url(+Scheme, +URL, +PackDir, +Pack, +Options)
 1188%
 1189%   Install a package from a remote source. For git repositories, we
 1190%   simply clone. Archives are  downloaded.   We  currently  use the
 1191%   built-in HTTP client. For complete  coverage, we should consider
 1192%   using an external (e.g., curl) if available.
 1193
 1194pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
 1195    option(git(true), Options),
 1196    !,
 1197    directory_file_path(PackTopDir, Pack, PackDir),
 1198    prepare_pack_dir(PackDir, Options),
 1199    run_process(path(git), [clone, URL, PackDir], []),
 1200    pack_git_info(PackDir, Hash, Info),
 1201    pack_inquiry(URL, git(Hash), Info, Options),
 1202    show_info(Pack, Info, Options),
 1203    confirm(git_post_install(PackDir, Pack), yes, Options),
 1204    pack_post_install(Pack, PackDir, Options).
 1205pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
 1206    download_scheme(Scheme),
 1207    directory_file_path(PackTopDir, Pack, PackDir),
 1208    prepare_pack_dir(PackDir, Options),
 1209    pack_download_dir(PackTopDir, DownLoadDir),
 1210    download_file(URL, Pack, DownloadBase, Options),
 1211    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1212    (   option(insecure(true), Options, false)
 1213    ->  TLSOptions = [cert_verify_hook(ssl_verify)]
 1214    ;   TLSOptions = []
 1215    ),
 1216    setup_call_cleanup(
 1217        http_open(URL, In, TLSOptions),
 1218        setup_call_cleanup(
 1219            open(DownloadFile, write, Out, [type(binary)]),
 1220            copy_stream_data(In, Out),
 1221            close(Out)),
 1222        close(In)),
 1223    pack_archive_info(DownloadFile, Pack, Info, _),
 1224    download_file_sanity_check(DownloadFile, Pack, Info),
 1225    pack_inquiry(URL, DownloadFile, Info, Options),
 1226    show_info(Pack, Info, Options),
 1227    confirm(install_downloaded(DownloadFile), yes, Options),
 1228    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
 1229
 1230%!  download_file(+URL, +Pack, -File, +Options) is det.
 1231
 1232download_file(URL, Pack, File, Options) :-
 1233    option(version(Version), Options),
 1234    !,
 1235    atom_version(VersionA, Version),
 1236    file_name_extension(_, Ext, URL),
 1237    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1238download_file(URL, Pack, File, _) :-
 1239    file_base_name(URL,Basename),
 1240    no_int_file_name_extension(Tag,Ext,Basename),
 1241    tag_version(Tag,Version),
 1242    !,
 1243    atom_version(VersionA,Version),
 1244    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1245    file_name_extension(File0, Ext, File).
 1246download_file(URL, _, File, _) :-
 1247    file_base_name(URL, File).
 1248
 1249%!  pack_url_file(+URL, -File) is det.
 1250%
 1251%   True if File is a unique id for the referenced pack and version.
 1252%   Normally, that is simply the  base   name,  but  GitHub archives
 1253%   destroy this picture. Needed by the pack manager.
 1254
 1255pack_url_file(URL, FileID) :-
 1256    github_release_url(URL, Pack, Version),
 1257    !,
 1258    download_file(URL, Pack, FileID, [version(Version)]).
 1259pack_url_file(URL, FileID) :-
 1260    file_base_name(URL, FileID).
 1261
 1262
 1263:- public ssl_verify/5. 1264
 1265%   ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
 1266%
 1267%   Currently we accept  all  certificates.   We  organise  our  own
 1268%   security using SHA1 signatures, so  we   do  not  care about the
 1269%   source of the data.
 1270
 1271ssl_verify(_SSL,
 1272           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1273           _Error).
 1274
 1275pack_download_dir(PackTopDir, DownLoadDir) :-
 1276    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1277    (   exists_directory(DownLoadDir)
 1278    ->  true
 1279    ;   make_directory(DownLoadDir)
 1280    ),
 1281    (   access_file(DownLoadDir, write)
 1282    ->  true
 1283    ;   permission_error(write, directory, DownLoadDir)
 1284    ).
 1285
 1286%!  download_url(+URL) is det.
 1287%
 1288%   True if URL looks like a URL we can download from.
 1289
 1290download_url(URL) :-
 1291    atom(URL),
 1292    uri_components(URL, Components),
 1293    uri_data(scheme, Components, Scheme),
 1294    download_scheme(Scheme).
 1295
 1296download_scheme(http).
 1297download_scheme(https) :-
 1298    catch(use_module(library(http/http_ssl_plugin)),
 1299          E, (print_message(warning, E), fail)).
 1300
 1301%!  pack_post_install(+Pack, +PackDir, +Options) is det.
 1302%
 1303%   Process post installation work.  Steps:
 1304%
 1305%     - Create foreign resources
 1306%     - Register directory as autoload library
 1307%     - Attach the package
 1308
 1309pack_post_install(Pack, PackDir, Options) :-
 1310    post_install_foreign(Pack, PackDir, Options),
 1311    post_install_autoload(PackDir, Options),
 1312    attach_packs(PackDir, [duplicate(warning)]).
 1313
 1314%!  pack_rebuild(+Pack) is det.
 1315%
 1316%   Rebuild possible foreign components of Pack.
 1317
 1318pack_rebuild(Pack) :-
 1319    current_pack(Pack, PackDir),
 1320    !,
 1321    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1322pack_rebuild(Pack) :-
 1323    unattached_pack(Pack, PackDir),
 1324    !,
 1325    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1326pack_rebuild(Pack) :-
 1327    existence_error(pack, Pack).
 1328
 1329unattached_pack(Pack, BaseDir) :-
 1330    directory_file_path(Pack, 'pack.pl', PackFile),
 1331    absolute_file_name(pack(PackFile), PackPath,
 1332                       [ access(read),
 1333                         file_errors(fail)
 1334                       ]),
 1335    file_directory_name(PackPath, BaseDir).
 1336
 1337%!  pack_rebuild is det.
 1338%
 1339%   Rebuild foreign components of all packages.
 1340
 1341pack_rebuild :-
 1342    forall(current_pack(Pack),
 1343           ( print_message(informational, pack(rebuild(Pack))),
 1344             pack_rebuild(Pack)
 1345           )).
 1346
 1347
 1348%!  post_install_foreign(+Pack, +PackDir, +Options) is det.
 1349%
 1350%   Install foreign parts of the package.
 1351
 1352post_install_foreign(Pack, PackDir, Options) :-
 1353    is_foreign_pack(PackDir, _),
 1354    !,
 1355    (   pack_info_term(PackDir, pack_version(Version))
 1356    ->  true
 1357    ;   Version = 1
 1358    ),
 1359    option(rebuild(Rebuild), Options, if_absent),
 1360    (   Rebuild == if_absent,
 1361        foreign_present(PackDir)
 1362    ->  print_message(informational, pack(kept_foreign(Pack)))
 1363    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1364        (   Rebuild == true
 1365        ->  BuildSteps1 = [distclean|BuildSteps0]
 1366        ;   BuildSteps1 = BuildSteps0
 1367        ),
 1368        (   option(test(false), Options)
 1369        ->  delete(BuildSteps1, [test], BuildSteps)
 1370        ;   BuildSteps = BuildSteps1
 1371        ),
 1372        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
 1373    ).
 1374post_install_foreign(_, _, _).
 1375
 1376
 1377%!  foreign_present(+PackDir) is semidet.
 1378%
 1379%   True if we find one or more modules  in the pack `lib` directory for
 1380%   the current architecture. Does not check   that these can be loaded,
 1381%   nor whether all required modules are present.
 1382
 1383foreign_present(PackDir) :-
 1384    current_prolog_flag(arch, Arch),
 1385    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1386    exists_directory(ForeignBaseDir),
 1387    !,
 1388    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1389    exists_directory(ForeignDir),
 1390    current_prolog_flag(shared_object_extension, Ext),
 1391    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1392    expand_file_name(Pattern, Files),
 1393    Files \== [].
 1394
 1395%!  is_foreign_pack(+PackDir, -Type) is nondet.
 1396%
 1397%   True when PackDir contains  files  that   indicate  the  need  for a
 1398%   specific class of build tools indicated by Type.
 1399
 1400is_foreign_pack(PackDir, Type) :-
 1401    foreign_file(File, Type),
 1402    directory_file_path(PackDir, File, Path),
 1403    exists_file(Path).
 1404
 1405foreign_file('CMakeLists.txt', cmake).
 1406foreign_file('configure',      configure).
 1407foreign_file('configure.in',   autoconf).
 1408foreign_file('configure.ac',   autoconf).
 1409foreign_file('Makefile.am',    automake).
 1410foreign_file('Makefile',       make).
 1411foreign_file('makefile',       make).
 1412foreign_file('conanfile.txt',  conan).
 1413foreign_file('conanfile.py',   conan).
 1414
 1415
 1416                 /*******************************
 1417                 *           AUTOLOAD           *
 1418                 *******************************/
 1419
 1420%!  post_install_autoload(+PackDir, +Options)
 1421%
 1422%   Create an autoload index if the package demands such.
 1423
 1424post_install_autoload(PackDir, Options) :-
 1425    option(autoload(true), Options, true),
 1426    pack_info_term(PackDir, autoload(true)),
 1427    !,
 1428    directory_file_path(PackDir, prolog, PrologLibDir),
 1429    make_library_index(PrologLibDir).
 1430post_install_autoload(_, _).
 1431
 1432
 1433                 /*******************************
 1434                 *            UPGRADE           *
 1435                 *******************************/
 1436
 1437%!  pack_upgrade(+Pack) is semidet.
 1438%
 1439%   Try to upgrade the package Pack.
 1440%
 1441%   @tbd    Update dependencies when updating a pack from git?
 1442
 1443pack_upgrade(Pack) :-
 1444    pack_info(Pack, _, directory(Dir)),
 1445    directory_file_path(Dir, '.git', GitDir),
 1446    exists_directory(GitDir),
 1447    !,
 1448    print_message(informational, pack(git_fetch(Dir))),
 1449    git([fetch], [ directory(Dir) ]),
 1450    git_describe(V0, [ directory(Dir) ]),
 1451    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1452    (   V0 == V1
 1453    ->  print_message(informational, pack(up_to_date(Pack)))
 1454    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1455        git([merge, 'origin/master'], [ directory(Dir) ]),
 1456        pack_rebuild(Pack)
 1457    ).
 1458pack_upgrade(Pack) :-
 1459    once(pack_info(Pack, _, version(VersionAtom))),
 1460    atom_version(VersionAtom, Version),
 1461    pack_info(Pack, _, download(URL)),
 1462    (   wildcard_pattern(URL)
 1463    ->  true
 1464    ;   github_url(URL, _User, _Repo)
 1465    ),
 1466    !,
 1467    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1468    (   Latest @> Version
 1469    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1470        pack_install(Pack,
 1471                     [ url(LatestURL),
 1472                       upgrade(true),
 1473                       pack(Pack)
 1474                     ])
 1475    ;   print_message(informational, pack(up_to_date(Pack)))
 1476    ).
 1477pack_upgrade(Pack) :-
 1478    print_message(warning, pack(no_upgrade_info(Pack))).
 1479
 1480
 1481                 /*******************************
 1482                 *            REMOVE            *
 1483                 *******************************/
 1484
 1485%!  pack_remove(+Name) is det.
 1486%
 1487%   Remove the indicated package.
 1488
 1489pack_remove(Pack) :-
 1490    update_dependency_db,
 1491    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1492    ->  confirm_remove(Pack, Deps, Delete),
 1493        forall(member(P, Delete), pack_remove_forced(P))
 1494    ;   pack_remove_forced(Pack)
 1495    ).
 1496
 1497pack_remove_forced(Pack) :-
 1498    catch('$pack_detach'(Pack, BaseDir),
 1499          error(existence_error(pack, Pack), _),
 1500          fail),
 1501    !,
 1502    print_message(informational, pack(remove(BaseDir))),
 1503    delete_directory_and_contents(BaseDir).
 1504pack_remove_forced(Pack) :-
 1505    unattached_pack(Pack, BaseDir),
 1506    !,
 1507    delete_directory_and_contents(BaseDir).
 1508pack_remove_forced(Pack) :-
 1509    print_message(informational, error(existence_error(pack, Pack),_)).
 1510
 1511confirm_remove(Pack, Deps, Delete) :-
 1512    print_message(warning, pack(depends(Pack, Deps))),
 1513    menu(pack(resolve_remove),
 1514         [ [Pack]      = remove_only(Pack),
 1515           [Pack|Deps] = remove_deps(Pack, Deps),
 1516           []          = cancel
 1517         ], [], Delete, []),
 1518    Delete \== [].
 1519
 1520
 1521                 /*******************************
 1522                 *           PROPERTIES         *
 1523                 *******************************/
 1524
 1525%!  pack_property(?Pack, ?Property) is nondet.
 1526%
 1527%   True when Property  is  a  property   of  an  installed  Pack.  This
 1528%   interface is intended for programs that   wish  to interact with the
 1529%   package manager. Defined properties are:
 1530%
 1531%     - directory(Directory)
 1532%     Directory into which the package is installed
 1533%     - version(Version)
 1534%     Installed version
 1535%     - title(Title)
 1536%     Full title of the package
 1537%     - author(Author)
 1538%     Registered author
 1539%     - download(URL)
 1540%     Official download URL
 1541%     - readme(File)
 1542%     Package README file (if present)
 1543%     - todo(File)
 1544%     Package TODO file (if present)
 1545
 1546pack_property(Pack, Property) :-
 1547    findall(Pack-Property, pack_property_(Pack, Property), List),
 1548    member(Pack-Property, List).            % make det if applicable
 1549
 1550pack_property_(Pack, Property) :-
 1551    pack_info(Pack, _, Property).
 1552pack_property_(Pack, Property) :-
 1553    \+ \+ info_file(Property, _),
 1554    '$pack':pack(Pack, BaseDir),
 1555    access_file(BaseDir, read),
 1556    directory_files(BaseDir, Files),
 1557    member(File, Files),
 1558    info_file(Property, Pattern),
 1559    downcase_atom(File, Pattern),
 1560    directory_file_path(BaseDir, File, InfoFile),
 1561    arg(1, Property, InfoFile).
 1562
 1563info_file(readme(_), 'readme.txt').
 1564info_file(readme(_), 'readme').
 1565info_file(todo(_),   'todo.txt').
 1566info_file(todo(_),   'todo').
 1567
 1568
 1569                 /*******************************
 1570                 *             GIT              *
 1571                 *******************************/
 1572
 1573%!  git_url(+URL, -Pack) is semidet.
 1574%
 1575%   True if URL describes a git url for Pack
 1576
 1577git_url(URL, Pack) :-
 1578    uri_components(URL, Components),
 1579    uri_data(scheme, Components, Scheme),
 1580    nonvar(Scheme),                         % must be full URL
 1581    uri_data(path, Components, Path),
 1582    (   Scheme == git
 1583    ->  true
 1584    ;   git_download_scheme(Scheme),
 1585        file_name_extension(_, git, Path)
 1586    ;   git_download_scheme(Scheme),
 1587        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 1588    ->  true
 1589    ),
 1590    file_base_name(Path, PackExt),
 1591    (   file_name_extension(Pack, git, PackExt)
 1592    ->  true
 1593    ;   Pack = PackExt
 1594    ),
 1595    (   safe_pack_name(Pack)
 1596    ->  true
 1597    ;   domain_error(pack_name, Pack)
 1598    ).
 1599
 1600git_download_scheme(http).
 1601git_download_scheme(https).
 1602
 1603%!  safe_pack_name(+Name:atom) is semidet.
 1604%
 1605%   Verifies that Name is a valid   pack  name. This avoids trickery
 1606%   with pack file names to make shell commands behave unexpectly.
 1607
 1608safe_pack_name(Name) :-
 1609    atom_length(Name, Len),
 1610    Len >= 3,                               % demand at least three length
 1611    atom_codes(Name, Codes),
 1612    maplist(safe_pack_char, Codes),
 1613    !.
 1614
 1615safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1616safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1617safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1618safe_pack_char(0'_).
 1619
 1620
 1621                 /*******************************
 1622                 *         VERSION LOGIC        *
 1623                 *******************************/
 1624
 1625%!  pack_version_file(-Pack, -Version, +File) is semidet.
 1626%
 1627%   True if File is the  name  of  a   file  or  URL  of a file that
 1628%   contains Pack at Version. File must   have  an extension and the
 1629%   basename  must  be  of   the    form   <pack>-<n>{.<m>}*.  E.g.,
 1630%   =|mypack-1.5|=.
 1631
 1632pack_version_file(Pack, Version, GitHubRelease) :-
 1633    atomic(GitHubRelease),
 1634    github_release_url(GitHubRelease, Pack, Version),
 1635    !.
 1636pack_version_file(Pack, Version, Path) :-
 1637    atomic(Path),
 1638    file_base_name(Path, File),
 1639    no_int_file_name_extension(Base, _Ext, File),
 1640    atom_codes(Base, Codes),
 1641    (   phrase(pack_version(Pack, Version), Codes),
 1642        safe_pack_name(Pack)
 1643    ->  true
 1644    ).
 1645
 1646no_int_file_name_extension(Base, Ext, File) :-
 1647    file_name_extension(Base0, Ext0, File),
 1648    \+ atom_number(Ext0, _),
 1649    !,
 1650    Base = Base0,
 1651    Ext = Ext0.
 1652no_int_file_name_extension(File, '', File).
 1653
 1654
 1655
 1656%!  github_release_url(+URL, -Pack, -Version) is semidet.
 1657%
 1658%   True when URL is the URL of a GitHub release.  Such releases are
 1659%   accessible as
 1660%
 1661%     ==
 1662%     https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
 1663%     ==
 1664
 1665github_release_url(URL, Pack, Version) :-
 1666    uri_components(URL, Components),
 1667    uri_data(authority, Components, 'github.com'),
 1668    uri_data(scheme, Components, Scheme),
 1669    download_scheme(Scheme),
 1670    uri_data(path, Components, Path),
 1671    github_archive_path(Archive,Pack,File),
 1672    atomic_list_concat(Archive, /, Path),
 1673    file_name_extension(Tag, Ext, File),
 1674    github_archive_extension(Ext),
 1675    tag_version(Tag, Version),
 1676    !.
 1677
 1678github_archive_path(['',_User,Pack,archive,File],Pack,File).
 1679github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 1680
 1681github_archive_extension(tgz).
 1682github_archive_extension(zip).
 1683
 1684tag_version(Tag, Version) :-
 1685    version_tag_prefix(Prefix),
 1686    atom_concat(Prefix, AtomVersion, Tag),
 1687    atom_version(AtomVersion, Version).
 1688
 1689version_tag_prefix(v).
 1690version_tag_prefix('V').
 1691version_tag_prefix('').
 1692
 1693
 1694:- public
 1695    atom_version/2. 1696
 1697%   atom_version(?Atom, ?Version)
 1698%
 1699%   Translate   between   atomic   version   representation   and   term
 1700%   representation.  The  term  representation  is  a  list  of  version
 1701%   components as integers and can be compared using `@>`
 1702
 1703atom_version(Atom, version(Parts)) :-
 1704    (   atom(Atom)
 1705    ->  atom_codes(Atom, Codes),
 1706        phrase(version(Parts), Codes)
 1707    ;   atomic_list_concat(Parts, '.', Atom)
 1708    ).
 1709
 1710pack_version(Pack, version(Parts)) -->
 1711    string(Codes), "-",
 1712    version(Parts),
 1713    !,
 1714    { atom_codes(Pack, Codes)
 1715    }.
 1716
 1717version([_|T]) -->
 1718    "*",
 1719    !,
 1720    (   "."
 1721    ->  version(T)
 1722    ;   []
 1723    ).
 1724version([H|T]) -->
 1725    integer(H),
 1726    (   "."
 1727    ->  version(T)
 1728    ;   { T = [] }
 1729    ).
 1730
 1731                 /*******************************
 1732                 *       QUERY CENTRAL DB       *
 1733                 *******************************/
 1734
 1735%!  pack_inquiry(+URL, +DownloadFile, +Info, +Options) is semidet.
 1736%
 1737%   Query the status of a package  with   the  central repository. To do
 1738%   this, we POST a Prolog document  containing   the  URL, info and the
 1739%   SHA1 hash to http://www.swi-prolog.org/pack/eval. The server replies
 1740%   using a list of Prolog terms, described  below. The only member that
 1741%   is always included is downloads (with default value 0).
 1742%
 1743%     - alt_hash(Count, URLs, Hash)
 1744%       A file with the same base-name, but a different hash was
 1745%       found at URLs and downloaded Count times.
 1746%     - downloads(Count)
 1747%       Number of times a file with this hash was downloaded.
 1748%     - rating(VoteCount, Rating)
 1749%       User rating (1..5), provided based on VoteCount votes.
 1750%     - dependency(Token, Pack, Version, URLs, SubDeps)
 1751%       Required tokens can be provided by the given provides.
 1752
 1753pack_inquiry(_, _, _, Options) :-
 1754    option(inquiry(false), Options),
 1755    !.
 1756pack_inquiry(URL, DownloadFile, Info, Options) :-
 1757    setting(server, ServerBase),
 1758    ServerBase \== '',
 1759    atom_concat(ServerBase, query, Server),
 1760    (   option(inquiry(true), Options)
 1761    ->  true
 1762    ;   confirm(inquiry(Server), yes, Options)
 1763    ),
 1764    !,
 1765    (   DownloadFile = git(SHA1)
 1766    ->  true
 1767    ;   file_sha1(DownloadFile, SHA1)
 1768    ),
 1769    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1770    inquiry_result(Reply, URL, Options).
 1771pack_inquiry(_, _, _, _).
 1772
 1773
 1774%!  query_pack_server(+Query, -Result, +Options)
 1775%
 1776%   Send a Prolog query  to  the   package  server  and  process its
 1777%   results.
 1778
 1779query_pack_server(Query, Result, Options) :-
 1780    (   option(server(ServerBase), Options)
 1781    ->  true
 1782    ;   setting(server, ServerBase),
 1783        ServerBase \== ''
 1784    ),
 1785    atom_concat(ServerBase, query, Server),
 1786    format(codes(Data), '~q.~n', Query),
 1787    info_level(Informational, Options),
 1788    print_message(Informational, pack(contacting_server(Server))),
 1789    setup_call_cleanup(
 1790        http_open(Server, In,
 1791                  [ post(codes(application/'x-prolog', Data)),
 1792                    header(content_type, ContentType)
 1793                  ]),
 1794        read_reply(ContentType, In, Result),
 1795        close(In)),
 1796    message_severity(Result, Level, Informational),
 1797    print_message(Level, pack(server_reply(Result))).
 1798
 1799read_reply(ContentType, In, Result) :-
 1800    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1801    !,
 1802    set_stream(In, encoding(utf8)),
 1803    read(In, Result).
 1804read_reply(ContentType, In, _Result) :-
 1805    read_string(In, 500, String),
 1806    print_message(error, pack(no_prolog_response(ContentType, String))),
 1807    fail.
 1808
 1809info_level(Level, Options) :-
 1810    option(silent(true), Options),
 1811    !,
 1812    Level = silent.
 1813info_level(informational, _).
 1814
 1815message_severity(true(_), Informational, Informational).
 1816message_severity(false, warning, _).
 1817message_severity(exception(_), error, _).
 1818
 1819
 1820%!  inquiry_result(+Reply, +File, +Options) is semidet.
 1821%
 1822%   Analyse the results  of  the  inquiry   and  decide  whether  to
 1823%   continue or not.
 1824
 1825inquiry_result(Reply, File, Options) :-
 1826    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1827    \+ member(cancel, Evaluation),
 1828    select_option(git(_), Options, Options1, _),
 1829    forall(member(install_dependencies(Resolution), Evaluation),
 1830           maplist(install_dependency(Options1), Resolution)).
 1831
 1832eval_inquiry(true(Reply), URL, Eval, _) :-
 1833    include(alt_hash, Reply, Alts),
 1834    Alts \== [],
 1835    print_message(warning, pack(alt_hashes(URL, Alts))),
 1836    (   memberchk(downloads(Count), Reply),
 1837        (   git_url(URL, _)
 1838        ->  Default = yes,
 1839            Eval = with_git_commits_in_same_version
 1840        ;   Default = no,
 1841            Eval = with_alt_hashes
 1842        ),
 1843        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1844    ->  true
 1845    ;   !,                          % Stop other rules
 1846        Eval = cancel
 1847    ).
 1848eval_inquiry(true(Reply), _, Eval, Options) :-
 1849    include(dependency, Reply, Deps),
 1850    Deps \== [],
 1851    select_dependency_resolution(Deps, Eval, Options),
 1852    (   Eval == cancel
 1853    ->  !
 1854    ;   true
 1855    ).
 1856eval_inquiry(true(Reply), URL, true, Options) :-
 1857    file_base_name(URL, File),
 1858    info_level(Informational, Options),
 1859    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1860eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1861             URL, Eval, Options) :-
 1862    (   confirm(continue_with_modified_hash(URL), no, Options)
 1863    ->  Eval = true
 1864    ;   Eval = cancel
 1865    ).
 1866
 1867alt_hash(alt_hash(_,_,_)).
 1868dependency(dependency(_,_,_,_,_)).
 1869
 1870
 1871%!  select_dependency_resolution(+Deps, -Eval, +Options)
 1872%
 1873%   Select a resolution.
 1874%
 1875%   @tbd    Exploit backtracking over resolve_dependencies/2.
 1876
 1877select_dependency_resolution(Deps, Eval, Options) :-
 1878    resolve_dependencies(Deps, Resolution),
 1879    exclude(local_dep, Resolution, ToBeDone),
 1880    (   ToBeDone == []
 1881    ->  !, Eval = true
 1882    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1883        (   memberchk(_-unresolved, Resolution)
 1884        ->  Default = cancel
 1885        ;   Default = install_deps
 1886        ),
 1887        menu(pack(resolve_deps),
 1888             [ install_deps    = install_deps,
 1889               install_no_deps = install_no_deps,
 1890               cancel          = cancel
 1891             ], Default, Choice, Options),
 1892        (   Choice == cancel
 1893        ->  !, Eval = cancel
 1894        ;   Choice == install_no_deps
 1895        ->  !, Eval = install_no_deps
 1896        ;   !, Eval = install_dependencies(Resolution)
 1897        )
 1898    ).
 1899
 1900local_dep(_-resolved(_)).
 1901
 1902
 1903%!  install_dependency(+Options, +TokenResolution)
 1904%
 1905%   Install dependencies for the given resolution.
 1906%
 1907%   @tbd: Query URI to use
 1908
 1909install_dependency(Options,
 1910                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1911    atom_version(VersionAtom, Version),
 1912    current_pack(Pack),
 1913    pack_info(Pack, _, version(InstalledAtom)),
 1914    atom_version(InstalledAtom, Installed),
 1915    Installed == Version,               % already installed
 1916    !,
 1917    maplist(install_dependency(Options), SubResolve).
 1918install_dependency(Options,
 1919                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1920    !,
 1921    atom_version(VersionAtom, Version),
 1922    merge_options([ url(URL),
 1923                    version(Version),
 1924                    interactive(false),
 1925                    inquiry(false),
 1926                    info(list),
 1927                    pack(Pack)
 1928                  ], Options, InstallOptions),
 1929    pack_install(Pack, InstallOptions),
 1930    maplist(install_dependency(Options), SubResolve).
 1931install_dependency(_, _-_).
 1932
 1933
 1934                 /*******************************
 1935                 *        WILDCARD URIs         *
 1936                 *******************************/
 1937
 1938%!  available_download_versions(+URL, -Versions) is det.
 1939%
 1940%   Deal with wildcard URLs, returning a  list of Version-URL pairs,
 1941%   sorted by version.
 1942%
 1943%   @tbd    Deal with protocols other than HTTP
 1944
 1945available_download_versions(URL, Versions) :-
 1946    wildcard_pattern(URL),
 1947    github_url(URL, User, Repo),
 1948    !,
 1949    findall(Version-VersionURL,
 1950            github_version(User, Repo, Version, VersionURL),
 1951            Versions).
 1952available_download_versions(URL, Versions) :-
 1953    wildcard_pattern(URL),
 1954    !,
 1955    file_directory_name(URL, DirURL0),
 1956    ensure_slash(DirURL0, DirURL),
 1957    print_message(informational, pack(query_versions(DirURL))),
 1958    setup_call_cleanup(
 1959        http_open(DirURL, In, []),
 1960        load_html(stream(In), DOM,
 1961                  [ syntax_errors(quiet)
 1962                  ]),
 1963        close(In)),
 1964    findall(MatchingURL,
 1965            absolute_matching_href(DOM, URL, MatchingURL),
 1966            MatchingURLs),
 1967    (   MatchingURLs == []
 1968    ->  print_message(warning, pack(no_matching_urls(URL)))
 1969    ;   true
 1970    ),
 1971    versioned_urls(MatchingURLs, VersionedURLs),
 1972    keysort(VersionedURLs, SortedVersions),
 1973    reverse(SortedVersions, Versions),
 1974    print_message(informational, pack(found_versions(Versions))).
 1975available_download_versions(URL, [Version-URL]) :-
 1976    (   pack_version_file(_Pack, Version0, URL)
 1977    ->  Version = Version0
 1978    ;   Version = unknown
 1979    ).
 1980
 1981%!  github_url(+URL, -User, -Repo) is semidet.
 1982%
 1983%   True when URL refers to a github repository.
 1984
 1985github_url(URL, User, Repo) :-
 1986    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1987    atomic_list_concat(['',User,Repo|_], /, Path).
 1988
 1989
 1990%!  github_version(+User, +Repo, -Version, -VersionURI) is nondet.
 1991%
 1992%   True when Version is a release version and VersionURI is the
 1993%   download location for the zip file.
 1994
 1995github_version(User, Repo, Version, VersionURI) :-
 1996    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1997    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1998    setup_call_cleanup(
 1999      http_open(ApiUri, In,
 2000                [ request_header('Accept'='application/vnd.github.v3+json')
 2001                ]),
 2002      json_read_dict(In, Dicts),
 2003      close(In)),
 2004    member(Dict, Dicts),
 2005    atom_string(Tag, Dict.name),
 2006    tag_version(Tag, Version),
 2007    atom_string(VersionURI, Dict.zipball_url).
 2008
 2009wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 2010wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 2011
 2012ensure_slash(Dir, DirS) :-
 2013    (   sub_atom(Dir, _, _, 0, /)
 2014    ->  DirS = Dir
 2015    ;   atom_concat(Dir, /, DirS)
 2016    ).
 2017
 2018absolute_matching_href(DOM, Pattern, Match) :-
 2019    xpath(DOM, //a(@href), HREF),
 2020    uri_normalized(HREF, Pattern, Match),
 2021    wildcard_match(Pattern, Match).
 2022
 2023versioned_urls([], []).
 2024versioned_urls([H|T0], List) :-
 2025    file_base_name(H, File),
 2026    (   pack_version_file(_Pack, Version, File)
 2027    ->  List = [Version-H|T]
 2028    ;   List = T
 2029    ),
 2030    versioned_urls(T0, T).
 2031
 2032
 2033                 /*******************************
 2034                 *          DEPENDENCIES        *
 2035                 *******************************/
 2036
 2037%!  update_dependency_db
 2038%
 2039%   Reload dependency declarations between packages.
 2040
 2041update_dependency_db :-
 2042    retractall(pack_requires(_,_)),
 2043    retractall(pack_provides_db(_,_)),
 2044    forall(current_pack(Pack),
 2045           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 2046               update_dependency_db(Pack, Infos)
 2047           )).
 2048
 2049update_dependency_db(Name, Info) :-
 2050    retractall(pack_requires(Name, _)),
 2051    retractall(pack_provides_db(Name, _)),
 2052    maplist(assert_dep(Name), Info).
 2053
 2054assert_dep(Pack, provides(Token)) :-
 2055    !,
 2056    assertz(pack_provides_db(Pack, Token)).
 2057assert_dep(Pack, requires(Token)) :-
 2058    !,
 2059    assertz(pack_requires(Pack, Token)).
 2060assert_dep(_, _).
 2061
 2062%!  validate_dependencies is det.
 2063%
 2064%   Validate all dependencies, reporting on failures
 2065
 2066validate_dependencies :-
 2067    unsatisfied_dependencies(Unsatisfied),
 2068    !,
 2069    print_message(warning, pack(unsatisfied(Unsatisfied))).
 2070validate_dependencies.
 2071
 2072
 2073unsatisfied_dependencies(Unsatisfied) :-
 2074    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 2075    keysort(Reqs0, Reqs1),
 2076    group_pairs_by_key(Reqs1, GroupedReqs),
 2077    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 2078    Unsatisfied \== [].
 2079
 2080satisfied_dependency(Needed-_By) :-
 2081    pack_provides(_, Needed),
 2082    !.
 2083satisfied_dependency(Needed-_By) :-
 2084    compound(Needed),
 2085    Needed =.. [Op, Pack, ReqVersion],
 2086    (   pack_provides(Pack, Pack)
 2087    ->  pack_info(Pack, _, version(PackVersion)),
 2088        version_data(PackVersion, PackData)
 2089    ;   Pack == prolog
 2090    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 2091        PackData = [Major,Minor,Patch]
 2092    ),
 2093    version_data(ReqVersion, ReqData),
 2094    cmp(Op, Cmp),
 2095    call(Cmp, PackData, ReqData).
 2096
 2097%!  pack_provides(?Package, ?Token) is multi.
 2098%
 2099%   True if Pack provides Token.  A package always provides itself.
 2100
 2101pack_provides(Pack, Pack) :-
 2102    current_pack(Pack).
 2103pack_provides(Pack, Token) :-
 2104    pack_provides_db(Pack, Token).
 2105
 2106%!  pack_depends_on(?Pack, ?Dependency) is nondet.
 2107%
 2108%   True if Pack requires Dependency, direct or indirect.
 2109
 2110pack_depends_on(Pack, Dependency) :-
 2111    (   atom(Pack)
 2112    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 2113    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 2114    ).
 2115
 2116pack_depends_on_fwd(Pack, Dependency, Visited) :-
 2117    pack_depends_on_1(Pack, Dep1),
 2118    \+ memberchk(Dep1, Visited),
 2119    (   Dependency = Dep1
 2120    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 2121    ).
 2122
 2123pack_depends_on_bwd(Pack, Dependency, Visited) :-
 2124    pack_depends_on_1(Dep1, Dependency),
 2125    \+ memberchk(Dep1, Visited),
 2126    (   Pack = Dep1
 2127    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 2128    ).
 2129
 2130pack_depends_on_1(Pack, Dependency) :-
 2131    atom(Dependency),
 2132    !,
 2133    pack_provides(Dependency, Token),
 2134    pack_requires(Pack, Token).
 2135pack_depends_on_1(Pack, Dependency) :-
 2136    pack_requires(Pack, Token),
 2137    pack_provides(Dependency, Token).
 2138
 2139
 2140%!  resolve_dependencies(+Dependencies, -Resolution) is multi.
 2141%
 2142%   Resolve dependencies as reported by the remote package server.
 2143%
 2144%   @param  Dependencies is a list of
 2145%           dependency(Token, Pack, Version, URLs, SubDeps)
 2146%   @param  Resolution is a list of items
 2147%           - Token-resolved(Pack)
 2148%           - Token-resolve(Pack, Version, URLs, SubResolve)
 2149%           - Token-unresolved
 2150%   @tbd    Watch out for conflicts
 2151%   @tbd    If there are different packs that resolve a token,
 2152%           make an intelligent choice instead of using the first
 2153
 2154resolve_dependencies(Dependencies, Resolution) :-
 2155    maplist(dependency_pair, Dependencies, Pairs0),
 2156    keysort(Pairs0, Pairs1),
 2157    group_pairs_by_key(Pairs1, ByToken),
 2158    maplist(resolve_dep, ByToken, Resolution).
 2159
 2160dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 2161                Token-(Pack-pack(Version,URLs, SubDeps))).
 2162
 2163resolve_dep(Token-Pairs, Token-Resolution) :-
 2164    (   resolve_dep2(Token-Pairs, Resolution)
 2165    *-> true
 2166    ;   Resolution = unresolved
 2167    ).
 2168
 2169resolve_dep2(Token-_, resolved(Pack)) :-
 2170    pack_provides(Pack, Token).
 2171resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 2172    keysort(Pairs, Sorted),
 2173    group_pairs_by_key(Sorted, ByPack),
 2174    member(Pack-Versions, ByPack),
 2175    Pack \== (-),
 2176    maplist(version_pack, Versions, VersionData),
 2177    sort(VersionData, ByVersion),
 2178    reverse(ByVersion, ByVersionLatest),
 2179    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 2180    atom_version(VersionAtom, Version),
 2181    include(dependency, SubDeps, Deps),
 2182    resolve_dependencies(Deps, SubResolves).
 2183
 2184version_pack(pack(VersionAtom,URLs,SubDeps),
 2185             pack(Version,URLs,SubDeps)) :-
 2186    atom_version(VersionAtom, Version).
 2187
 2188
 2189
 2190%!  pack_attach(+Dir, +Options) is det.
 2191%
 2192%   Attach a single package in Dir.  The Dir is expected to contain
 2193%   the file `pack.pl` and a `prolog` directory.  Options processed:
 2194%
 2195%     - duplicate(+Action)
 2196%     What to do if the same package is already installed in a different
 2197%     directory.  Action is one of
 2198%       - warning
 2199%       Warn and ignore the package
 2200%       - keep
 2201%       Silently ignore the package
 2202%       - replace
 2203%       Unregister the existing and insert the new package
 2204%     - search(+Where)
 2205%     Determines the order of searching package library directories.
 2206%     Default is `last`, alternative is `first`.
 2207%
 2208%   @see attach_packs/2 to attach multiple packs from a directory.
 2209
 2210pack_attach(Dir, Options) :-
 2211    '$pack_attach'(Dir, Options).
 2212
 2213pack_make_available(Pack, PackTopDir, PackOptions) :-
 2214    directory_file_path(PackTopDir, Pack, PackDir),
 2215    (   option(package_directory(_Parent), PackOptions)
 2216    ->  pack_attach(PackDir, [duplicate(replace)])
 2217    ;   pack_attach(PackDir, [])
 2218    ).
 2219
 2220
 2221                 /*******************************
 2222                 *        USER INTERACTION      *
 2223                 *******************************/
 2224
 2225:- multifile prolog:message//1. 2226
 2227%!  menu(Question, +Alternatives, +Default, -Selection, +Options)
 2228
 2229menu(_Question, _Alternatives, Default, Selection, Options) :-
 2230    option(interactive(false), Options),
 2231    !,
 2232    Selection = Default.
 2233menu(Question, Alternatives, Default, Selection, _) :-
 2234    length(Alternatives, N),
 2235    between(1, 5, _),
 2236       print_message(query, Question),
 2237       print_menu(Alternatives, Default, 1),
 2238       print_message(query, pack(menu(select))),
 2239       read_selection(N, Choice),
 2240    !,
 2241    (   Choice == default
 2242    ->  Selection = Default
 2243    ;   nth1(Choice, Alternatives, Selection=_)
 2244    ->  true
 2245    ).
 2246
 2247print_menu([], _, _).
 2248print_menu([Value=Label|T], Default, I) :-
 2249    (   Value == Default
 2250    ->  print_message(query, pack(menu(default_item(I, Label))))
 2251    ;   print_message(query, pack(menu(item(I, Label))))
 2252    ),
 2253    I2 is I + 1,
 2254    print_menu(T, Default, I2).
 2255
 2256read_selection(Max, Choice) :-
 2257    get_single_char(Code),
 2258    (   answered_default(Code)
 2259    ->  Choice = default
 2260    ;   code_type(Code, digit(Choice)),
 2261        between(1, Max, Choice)
 2262    ->  true
 2263    ;   print_message(warning, pack(menu(reply(1,Max)))),
 2264        fail
 2265    ).
 2266
 2267%!  confirm(+Question, +Default, +Options) is semidet.
 2268%
 2269%   Ask for confirmation.
 2270%
 2271%   @param Default is one of =yes=, =no= or =none=.
 2272
 2273confirm(_Question, Default, Options) :-
 2274    Default \== none,
 2275    option(interactive(false), Options, true),
 2276    !,
 2277    Default == yes.
 2278confirm(Question, Default, _) :-
 2279    between(1, 5, _),
 2280       print_message(query, pack(confirm(Question, Default))),
 2281       read_yes_no(YesNo, Default),
 2282    !,
 2283    format(user_error, '~N', []),
 2284    YesNo == yes.
 2285
 2286read_yes_no(YesNo, Default) :-
 2287    get_single_char(Code),
 2288    code_yes_no(Code, Default, YesNo),
 2289    !.
 2290
 2291code_yes_no(0'y, _, yes).
 2292code_yes_no(0'Y, _, yes).
 2293code_yes_no(0'n, _, no).
 2294code_yes_no(0'N, _, no).
 2295code_yes_no(_, none, _) :- !, fail.
 2296code_yes_no(C, Default, Default) :-
 2297    answered_default(C).
 2298
 2299answered_default(0'\r).
 2300answered_default(0'\n).
 2301answered_default(0'\s).
 2302
 2303
 2304                 /*******************************
 2305                 *            MESSAGES          *
 2306                 *******************************/
 2307
 2308:- multifile prolog:message//1. 2309
 2310prolog:message(pack(Message)) -->
 2311    message(Message).
 2312
 2313:- discontiguous
 2314    message//1,
 2315    label//1. 2316
 2317message(invalid_info(Term)) -->
 2318    [ 'Invalid package description: ~q'-[Term] ].
 2319message(directory_exists(Dir)) -->
 2320    [ 'Package target directory exists and is not empty:', nl,
 2321      '\t~q'-[Dir]
 2322    ].
 2323message(already_installed(pack(Pack, Version))) -->
 2324    { atom_version(AVersion, Version) },
 2325    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2326message(already_installed(Pack)) -->
 2327    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2328message(invalid_name(File)) -->
 2329    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2330    no_tar_gz(File).
 2331
 2332no_tar_gz(File) -->
 2333    { sub_atom(File, _, _, 0, '.tar.gz') },
 2334    !,
 2335    [ nl,
 2336      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2337    ].
 2338no_tar_gz(_) --> [].
 2339
 2340message(kept_foreign(Pack)) -->
 2341    [ 'Found foreign libraries for target platform.'-[], nl,
 2342      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2343    ].
 2344message(no_pack_installed(Pack)) -->
 2345    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2346message(no_packages_installed) -->
 2347    { setting(server, ServerBase) },
 2348    [ 'There are no extra packages installed.', nl,
 2349      'Please visit ~wlist.'-[ServerBase]
 2350    ].
 2351message(remove_with(Pack)) -->
 2352    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2353    ].
 2354message(unsatisfied(Packs)) -->
 2355    [ 'The following dependencies are not satisfied:', nl ],
 2356    unsatisfied(Packs).
 2357message(depends(Pack, Deps)) -->
 2358    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2359    pack_list(Deps).
 2360message(remove(PackDir)) -->
 2361    [ 'Removing ~q and contents'-[PackDir] ].
 2362message(remove_existing_pack(PackDir)) -->
 2363    [ 'Remove old installation in ~q'-[PackDir] ].
 2364message(install_from(Pack, Version, git(URL))) -->
 2365    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2366message(install_from(Pack, Version, URL)) -->
 2367    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2368message(select_install_from(Pack, Version)) -->
 2369    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2370message(install_downloaded(File)) -->
 2371    { file_base_name(File, Base),
 2372      size_file(File, Size) },
 2373    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2374message(git_post_install(PackDir, Pack)) -->
 2375    (   { is_foreign_pack(PackDir, _) }
 2376    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2377    ;   [ 'Activate pack "~w"'-[Pack] ]
 2378    ).
 2379message(no_meta_data(BaseDir)) -->
 2380    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2381message(inquiry(Server)) -->
 2382    [ 'Verify package status (anonymously)', nl,
 2383      '\tat "~w"'-[Server]
 2384    ].
 2385message(search_no_matches(Name)) -->
 2386    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2387message(rebuild(Pack)) -->
 2388    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2389message(upgrade(Pack, From, To)) -->
 2390    [ 'Upgrade "~w" from '-[Pack] ],
 2391    msg_version(From), [' to '-[]], msg_version(To).
 2392message(up_to_date(Pack)) -->
 2393    [ 'Package "~w" is up-to-date'-[Pack] ].
 2394message(query_versions(URL)) -->
 2395    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2396message(no_matching_urls(URL)) -->
 2397    [ 'Could not find any matching URL: ~q'-[URL] ].
 2398message(found_versions([Latest-_URL|More])) -->
 2399    { length(More, Len),
 2400      atom_version(VLatest, Latest)
 2401    },
 2402    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2403message(process_output(Codes)) -->
 2404    { split_lines(Codes, Lines) },
 2405    process_lines(Lines).
 2406message(contacting_server(Server)) -->
 2407    [ 'Contacting server at ~w ...'-[Server], flush ].
 2408message(server_reply(true(_))) -->
 2409    [ at_same_line, ' ok'-[] ].
 2410message(server_reply(false)) -->
 2411    [ at_same_line, ' done'-[] ].
 2412message(server_reply(exception(E))) -->
 2413    [ 'Server reported the following error:'-[], nl ],
 2414    '$messages':translate_message(E).
 2415message(cannot_create_dir(Alias)) -->
 2416    { findall(PackDir,
 2417              absolute_file_name(Alias, PackDir, [solutions(all)]),
 2418              PackDirs0),
 2419      sort(PackDirs0, PackDirs)
 2420    },
 2421    [ 'Cannot find a place to create a package directory.'-[],
 2422      'Considered:'-[]
 2423    ],
 2424    candidate_dirs(PackDirs).
 2425message(no_match(Name)) -->
 2426    [ 'No registered pack matches "~w"'-[Name] ].
 2427message(conflict(version, [PackV, FileV])) -->
 2428    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2429    [', file claims version '-[]], msg_version(FileV).
 2430message(conflict(name, [PackInfo, FileInfo])) -->
 2431    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2432    [', file claims ~w: ~p'-[FileInfo]].
 2433message(no_prolog_response(ContentType, String)) -->
 2434    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2435      '~s'-[String]
 2436    ].
 2437message(pack(no_upgrade_info(Pack))) -->
 2438    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2439
 2440candidate_dirs([]) --> [].
 2441candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2442
 2443                                                % Questions
 2444message(resolve_remove) -->
 2445    [ nl, 'Please select an action:', nl, nl ].
 2446message(create_pack_dir) -->
 2447    [ nl, 'Create directory for packages', nl ].
 2448message(menu(item(I, Label))) -->
 2449    [ '~t(~d)~6|   '-[I] ],
 2450    label(Label).
 2451message(menu(default_item(I, Label))) -->
 2452    [ '~t(~d)~6| * '-[I] ],
 2453    label(Label).
 2454message(menu(select)) -->
 2455    [ nl, 'Your choice? ', flush ].
 2456message(confirm(Question, Default)) -->
 2457    message(Question),
 2458    confirm_default(Default),
 2459    [ flush ].
 2460message(menu(reply(Min,Max))) -->
 2461    (  { Max =:= Min+1 }
 2462    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2463    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2464    ).
 2465
 2466% Alternate hashes for found for the same file
 2467
 2468message(alt_hashes(URL, _Alts)) -->
 2469    { git_url(URL, _)
 2470    },
 2471    !,
 2472    [ 'GIT repository was updated without updating version' ].
 2473message(alt_hashes(URL, Alts)) -->
 2474    { file_base_name(URL, File)
 2475    },
 2476    [ 'Found multiple versions of "~w".'-[File], nl,
 2477      'This could indicate a compromised or corrupted file', nl
 2478    ],
 2479    alt_hashes(Alts).
 2480message(continue_with_alt_hashes(Count, URL)) -->
 2481    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2482message(continue_with_modified_hash(_URL)) -->
 2483    [ 'Pack may be compromised.  Continue anyway'
 2484    ].
 2485message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2486    [ 'Content of ~q has changed.'-[URL]
 2487    ].
 2488
 2489alt_hashes([]) --> [].
 2490alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2491
 2492alt_hash(alt_hash(Count, URLs, Hash)) -->
 2493    [ '~t~d~8| ~w'-[Count, Hash] ],
 2494    alt_urls(URLs).
 2495
 2496alt_urls([]) --> [].
 2497alt_urls([H|T]) -->
 2498    [ nl, '    ~w'-[H] ],
 2499    alt_urls(T).
 2500
 2501% Installation dependencies gathered from inquiry server.
 2502
 2503message(install_dependencies(Resolution)) -->
 2504    [ 'Package depends on the following:' ],
 2505    msg_res_tokens(Resolution, 1).
 2506
 2507msg_res_tokens([], _) --> [].
 2508msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2509
 2510msg_res_token(Token-unresolved, L) -->
 2511    res_indent(L),
 2512    [ '"~w" cannot be satisfied'-[Token] ].
 2513msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2514    !,
 2515    res_indent(L),
 2516    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2517    { L2 is L+1 },
 2518    msg_res_tokens(SubResolves, L2).
 2519msg_res_token(Token-resolved(Pack), L) -->
 2520    !,
 2521    res_indent(L),
 2522    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2523
 2524res_indent(L) -->
 2525    { I is L*2 },
 2526    [ nl, '~*c'-[I,0'\s] ].
 2527
 2528message(resolve_deps) -->
 2529    [ nl, 'What do you wish to do' ].
 2530label(install_deps) -->
 2531    [ 'Install proposed dependencies' ].
 2532label(install_no_deps) -->
 2533    [ 'Only install requested package' ].
 2534
 2535
 2536message(git_fetch(Dir)) -->
 2537    [ 'Running "git fetch" in ~q'-[Dir] ].
 2538
 2539% inquiry is blank
 2540
 2541message(inquiry_ok(Reply, File)) -->
 2542    { memberchk(downloads(Count), Reply),
 2543      memberchk(rating(VoteCount, Rating), Reply),
 2544      !,
 2545      length(Stars, Rating),
 2546      maplist(=(0'*), Stars)
 2547    },
 2548    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2549      [ File, Count, Stars, VoteCount ]
 2550    ].
 2551message(inquiry_ok(Reply, File)) -->
 2552    { memberchk(downloads(Count), Reply)
 2553    },
 2554    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2555
 2556                                                % support predicates
 2557unsatisfied([]) --> [].
 2558unsatisfied([Needed-[By]|T]) -->
 2559    [ '  - "~w" is needed by package "~w"'-[Needed, By], nl ],
 2560    unsatisfied(T).
 2561unsatisfied([Needed-By|T]) -->
 2562    [ '  - "~w" is needed by the following packages:'-[Needed], nl ],
 2563    pack_list(By),
 2564    unsatisfied(T).
 2565
 2566pack_list([]) --> [].
 2567pack_list([H|T]) -->
 2568    [ '    - Package "~w"'-[H], nl ],
 2569    pack_list(T).
 2570
 2571process_lines([]) --> [].
 2572process_lines([H|T]) -->
 2573    [ '~s'-[H] ],
 2574    (   {T==[]}
 2575    ->  []
 2576    ;   [nl], process_lines(T)
 2577    ).
 2578
 2579split_lines([], []) :- !.
 2580split_lines(All, [Line1|More]) :-
 2581    append(Line1, [0'\n|Rest], All),
 2582    !,
 2583    split_lines(Rest, More).
 2584split_lines(Line, [Line]).
 2585
 2586label(remove_only(Pack)) -->
 2587    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2588label(remove_deps(Pack, Deps)) -->
 2589    { length(Deps, Count) },
 2590    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2591label(create_dir(Dir)) -->
 2592    [ '~w'-[Dir] ].
 2593label(install_from(git(URL))) -->
 2594    !,
 2595    [ 'GIT repository at ~w'-[URL] ].
 2596label(install_from(URL)) -->
 2597    [ '~w'-[URL] ].
 2598label(cancel) -->
 2599    [ 'Cancel' ].
 2600
 2601confirm_default(yes) -->
 2602    [ ' Y/n? ' ].
 2603confirm_default(no) -->
 2604    [ ' y/N? ' ].
 2605confirm_default(none) -->
 2606    [ ' y/n? ' ].
 2607
 2608msg_version(Version) -->
 2609    { atom(Version) },
 2610    !,
 2611    [ '~w'-[Version] ].
 2612msg_version(VersionData) -->
 2613    !,
 2614    { atom_version(Atom, VersionData) },
 2615    [ '~w'-[Atom] ]