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