View source with raw 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-2019, VU University Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(prolog_pack,
   37          [ pack_list_installed/0,
   38            pack_info/1,                % +Name
   39            pack_list/1,                % +Keyword
   40            pack_search/1,              % +Keyword
   41            pack_install/1,             % +Name
   42            pack_install/2,             % +Name, +Options
   43            pack_upgrade/1,             % +Name
   44            pack_rebuild/1,             % +Name
   45            pack_rebuild/0,             % All packages
   46            pack_remove/1,              % +Name
   47            pack_property/2,            % ?Name, ?Property
   48            pack_attach/2,              % +Dir, +Options
   49
   50            pack_url_file/2             % +URL, -File
   51          ]).   52:- use_module(library(apply)).   53:- use_module(library(error)).   54:- use_module(library(process)).   55:- use_module(library(option)).   56:- use_module(library(readutil)).   57:- use_module(library(lists)).   58:- use_module(library(filesex)).   59:- use_module(library(xpath)).   60:- use_module(library(settings)).   61:- use_module(library(uri)).   62:- use_module(library(http/http_open)).   63:- use_module(library(http/json)).   64:- use_module(library(http/http_client), []).   % plugin for POST support
   65:- use_module(library(prolog_config)).

A package manager for Prolog

The library(prolog_pack) provides the SWI-Prolog package manager. This library lets you inspect installed packages, install packages, remove packages, etc. It is complemented by the built-in attach_packs/0 that makes installed packages available as libraries.

See also
- Installed packages can be inspected using ?- doc_browser.
To be done
- Version logic
- Find and resolve conflicts
- Upgrade git packages
- Validate git packages
- Test packages: run tests from directory `test'. */
   82:- multifile
   83    environment/2.                          % Name, Value
   84
   85:- dynamic
   86    pack_requires/2,                        % Pack, Requirement
   87    pack_provides_db/2.                     % Pack, Provided
   88
   89
   90                 /*******************************
   91                 *          CONSTANTS           *
   92                 *******************************/
   93
   94:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
   95           'Server to exchange pack information').   96
   97
   98                 /*******************************
   99                 *         PACKAGE INFO         *
  100                 *******************************/
 current_pack(?Pack) is nondet
True if Pack is a currently installed pack.
  106current_pack(Pack) :-
  107    '$pack':pack(Pack, _).
 pack_list_installed is det
List currently installed packages. Unlike pack_list/1, only locally installed packages are displayed and no connection is made to the internet.
See also
- Use pack_list/1 to find packages.
  117pack_list_installed :-
  118    findall(Pack, current_pack(Pack), Packages0),
  119    Packages0 \== [],
  120    !,
  121    sort(Packages0, Packages),
  122    length(Packages, Count),
  123    format('Installed packages (~D):~n~n', [Count]),
  124    maplist(pack_info(list), Packages),
  125    validate_dependencies.
  126pack_list_installed :-
  127    print_message(informational, pack(no_packages_installed)).
 pack_info(+Pack)
Print more detailed information about Pack.
  133pack_info(Name) :-
  134    pack_info(info, Name).
  135
  136pack_info(Level, Name) :-
  137    must_be(atom, Name),
  138    findall(Info, pack_info(Name, Level, Info), Infos0),
  139    (   Infos0 == []
  140    ->  print_message(warning, pack(no_pack_installed(Name))),
  141        fail
  142    ;   true
  143    ),
  144    update_dependency_db(Name, Infos0),
  145    findall(Def,  pack_default(Level, Infos, Def), Defs),
  146    append(Infos0, Defs, Infos1),
  147    sort(Infos1, Infos),
  148    show_info(Name, Infos, [info(Level)]).
  149
  150
  151show_info(_Name, _Properties, Options) :-
  152    option(silent(true), Options),
  153    !.
  154show_info(Name, Properties, Options) :-
  155    option(info(list), Options),
  156    !,
  157    memberchk(title(Title), Properties),
  158    memberchk(version(Version), Properties),
  159    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  160show_info(Name, Properties, _) :-
  161    !,
  162    print_property_value('Package'-'~w', [Name]),
  163    findall(Term, pack_level_info(info, Term, _, _), Terms),
  164    maplist(print_property(Properties), Terms).
  165
  166print_property(_, nl) :-
  167    !,
  168    format('~n').
  169print_property(Properties, Term) :-
  170    findall(Term, member(Term, Properties), Terms),
  171    Terms \== [],
  172    !,
  173    pack_level_info(_, Term, LabelFmt, _Def),
  174    (   LabelFmt = Label-FmtElem
  175    ->  true
  176    ;   Label = LabelFmt,
  177        FmtElem = '~w'
  178    ),
  179    multi_valued(Terms, FmtElem, FmtList, Values),
  180    atomic_list_concat(FmtList, ', ', Fmt),
  181    print_property_value(Label-Fmt, Values).
  182print_property(_, _).
  183
  184multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  185    !,
  186    H =.. [_|Values].
  187multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  188    H =.. [_|VH],
  189    append(VH, MoreValues, Values),
  190    multi_valued(T, LabelFmt, LT, MoreValues).
  191
  192
  193pvalue_column(24).
  194print_property_value(Prop-Fmt, Values) :-
  195    !,
  196    pvalue_column(C),
  197    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  198    format(Format, [Prop,C|Values]).
  199
  200pack_info(Name, Level, Info) :-
  201    '$pack':pack(Name, BaseDir),
  202    (   Info = directory(BaseDir)
  203    ;   pack_info_term(BaseDir, Info)
  204    ),
  205    pack_level_info(Level, Info, _Format, _Default).
  206
  207:- public pack_level_info/4.                    % used by web-server
  208
  209pack_level_info(_,    title(_),         'Title',                   '<no title>').
  210pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  211pack_level_info(info, directory(_),     'Installed in directory',  -).
  212pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  213pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  214pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  215pack_level_info(info, home(_),          'Home page',               -).
  216pack_level_info(info, download(_),      'Download URL',            -).
  217pack_level_info(_,    provides(_),      'Provides',                -).
  218pack_level_info(_,    requires(_),      'Requires',                -).
  219pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  220pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  221pack_level_info(info, library(_),	'Provided libraries',      -).
  222
  223pack_default(Level, Infos, Def) :-
  224    pack_level_info(Level, ITerm, _Format, Def),
  225    Def \== (-),
  226    \+ memberchk(ITerm, Infos).
 pack_info_term(+PackDir, ?Info) is nondet
True when Info is meta-data for the package PackName.
  232pack_info_term(BaseDir, Info) :-
  233    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  234    catch(
  235        setup_call_cleanup(
  236            open(InfoFile, read, In),
  237            term_in_stream(In, Info),
  238            close(In)),
  239        error(existence_error(source_sink, InfoFile), _),
  240        ( print_message(error, pack(no_meta_data(BaseDir))),
  241          fail
  242        )).
  243pack_info_term(BaseDir, library(Lib)) :-
  244    atom_concat(BaseDir, '/prolog/', LibDir),
  245    atom_concat(LibDir, '*.pl', Pattern),
  246    expand_file_name(Pattern, Files),
  247    maplist(atom_concat(LibDir), Plain, Files),
  248    convlist(base_name, Plain, Libs),
  249    member(Lib, Libs).
  250
  251base_name(File, Base) :-
  252    file_name_extension(Base, pl, File).
  253
  254term_in_stream(In, Term) :-
  255    repeat,
  256        read_term(In, Term0, []),
  257        (   Term0 == end_of_file
  258        ->  !, fail
  259        ;   Term = Term0,
  260            valid_info_term(Term0)
  261        ).
  262
  263valid_info_term(Term) :-
  264    Term =.. [Name|Args],
  265    same_length(Args, Types),
  266    Decl =.. [Name|Types],
  267    (   pack_info_term(Decl)
  268    ->  maplist(valid_info_arg, Types, Args)
  269    ;   print_message(warning, pack(invalid_info(Term))),
  270        fail
  271    ).
  272
  273valid_info_arg(Type, Arg) :-
  274    must_be(Type, Arg).
 pack_info_term(?Term) is nondet
True when Term describes name and arguments of a valid package info term.
  281pack_info_term(name(atom)).                     % Synopsis
  282pack_info_term(title(atom)).
  283pack_info_term(keywords(list(atom))).
  284pack_info_term(description(list(atom))).
  285pack_info_term(version(version)).
  286pack_info_term(author(atom, email_or_url)).     % Persons
  287pack_info_term(maintainer(atom, email_or_url)).
  288pack_info_term(packager(atom, email_or_url)).
  289pack_info_term(home(atom)).                     % Home page
  290pack_info_term(download(atom)).                 % Source
  291pack_info_term(provides(atom)).                 % Dependencies
  292pack_info_term(requires(dependency)).
  293pack_info_term(conflicts(dependency)).          % Conflicts with package
  294pack_info_term(replaces(atom)).                 % Replaces another package
  295pack_info_term(autoload(boolean)).              % Default installation options
  296
  297:- multifile
  298    error:has_type/2.  299
  300error:has_type(version, Version) :-
  301    atom(Version),
  302    version_data(Version, _Data).
  303error:has_type(email_or_url, Address) :-
  304    atom(Address),
  305    (   sub_atom(Address, _, _, _, @)
  306    ->  true
  307    ;   uri_is_global(Address)
  308    ).
  309error:has_type(dependency, Value) :-
  310    is_dependency(Value, _Token, _Version).
  311
  312version_data(Version, version(Data)) :-
  313    atomic_list_concat(Parts, '.', Version),
  314    maplist(atom_number, Parts, Data).
  315
  316is_dependency(Token, Token, *) :-
  317    atom(Token).
  318is_dependency(Term, Token, VersionCmp) :-
  319    Term =.. [Op,Token,Version],
  320    cmp(Op, _),
  321    version_data(Version, _),
  322    VersionCmp =.. [Op,Version].
  323
  324cmp(<,  @<).
  325cmp(=<, @=<).
  326cmp(==, ==).
  327cmp(>=, @>=).
  328cmp(>,  @>).
  329
  330
  331                 /*******************************
  332                 *            SEARCH            *
  333                 *******************************/
 pack_search(+Query) is det
 pack_list(+Query) is det
Query package server and installed packages and display results. Query is matches case-insensitively against the name and title of known and installed packages. For each matching package, a single line is displayed that provides:

Hint: ?- pack_list(''). lists all packages.

The predicates pack_list/1 and pack_search/1 are synonyms. Both contact the package server at http://www.swi-prolog.org to find available packages.

See also
- pack_list_installed/0 to list installed packages without contacting the server.
  362pack_list(Query) :-
  363    pack_search(Query).
  364
  365pack_search(Query) :-
  366    query_pack_server(search(Query), Result, []),
  367    (   Result == false
  368    ->  (   local_search(Query, Packs),
  369            Packs \== []
  370        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  371                   format('~w ~w@~w ~28|- ~w~n',
  372                          [Stat, Pack, Version, Title]))
  373        ;   print_message(warning, pack(search_no_matches(Query)))
  374        )
  375    ;   Result = true(Hits),
  376        local_search(Query, Local),
  377        append(Hits, Local, All),
  378        sort(All, Sorted),
  379        list_hits(Sorted)
  380    ).
  381
  382list_hits([]).
  383list_hits([ pack(Pack, i, Title, Version, _),
  384            pack(Pack, p, Title, Version, _)
  385          | More
  386          ]) :-
  387    !,
  388    format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
  389    list_hits(More).
  390list_hits([ pack(Pack, i, Title, VersionI, _),
  391            pack(Pack, p, _,     VersionS, _)
  392          | More
  393          ]) :-
  394    !,
  395    version_data(VersionI, VDI),
  396    version_data(VersionS, VDS),
  397    (   VDI @< VDS
  398    ->  Tag = ('U')
  399    ;   Tag = ('A')
  400    ),
  401    format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
  402    list_hits(More).
  403list_hits([ pack(Pack, i, Title, VersionI, _)
  404          | More
  405          ]) :-
  406    !,
  407    format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
  408    list_hits(More).
  409list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
  410    format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
  411    list_hits(More).
  412
  413
  414local_search(Query, Packs) :-
  415    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  416
  417matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  418    current_pack(Pack),
  419    findall(Term,
  420            ( pack_info(Pack, _, Term),
  421              search_info(Term)
  422            ), Info),
  423    (   sub_atom_icasechk(Pack, _, Query)
  424    ->  true
  425    ;   memberchk(title(Title), Info),
  426        sub_atom_icasechk(Title, _, Query)
  427    ),
  428    option(title(Title), Info, '<no title>'),
  429    option(version(Version), Info, '<no version>'),
  430    option(download(URL), Info, '<no download url>').
  431
  432search_info(title(_)).
  433search_info(version(_)).
  434search_info(download(_)).
  435
  436
  437                 /*******************************
  438                 *            INSTALL           *
  439                 *******************************/
 pack_install(+Spec:atom) is det
Install a package. Spec is one of

After resolving the type of package, pack_install/2 is used to do the actual installation.

  457pack_install(Spec) :-
  458    pack_default_options(Spec, Pack, [], Options),
  459    pack_install(Pack, [pack(Pack)|Options]).
 pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det
Establish the pack name (Pack) and install options from a specification and options (OptionsIn) provided by the user.
  466pack_default_options(_Spec, Pack, OptsIn, Options) :-
  467    option(already_installed(pack(Pack,_Version)), OptsIn),
  468    !,
  469    Options = OptsIn.
  470pack_default_options(_Spec, Pack, OptsIn, Options) :-
  471    option(url(URL), OptsIn),
  472    !,
  473    (   option(git(_), OptsIn)
  474    ->  Options = OptsIn
  475    ;   git_url(URL, Pack)
  476    ->  Options = [git(true)|OptsIn]
  477    ;   Options = OptsIn
  478    ),
  479    (   nonvar(Pack)
  480    ->  true
  481    ;   option(pack(Pack), Options)
  482    ->  true
  483    ;   pack_version_file(Pack, _Version, URL)
  484    ).
  485pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  486    must_be(atom, Archive),
  487    \+ uri_is_global(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(_, _, []).
 pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)
Select from available packages.
  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)).
 pack_install(+Name, +Options) is det
Install package Name. Processes the options below. Default options as would be used by pack_install/1 are used to complete the provided Options.
url(+URL)
Source for downloading the package
package_directory(+Dir)
Directory into which to install the package
interactive(+Boolean)
Use default answer without asking the user if there is a default action.
silent(+Boolean)
If true (default false), suppress informational progress messages.
upgrade(+Boolean)
If true (default false), upgrade package if it is already installed.
git(+Boolean)
If true (default false unless URL ends with =.git=), assume the URL is a GIT repository.

Non-interactive installation can be established using the option interactive(false). It is adviced to install from a particular trusted URL instead of the plain pack name for unattented operation.

  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.
 pack_install(+Pack, +PackDir, +Options)
Install package Pack into PackDir. Options:
url(URL)
Install from the given URL, URL is either a file://, a git URL or a download URL.
upgrade(Boolean)
If Pack is already installed and Boolean is true, update the package to the latest version. If Boolean is false print an error and fail.
  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).
 pack_install_from_local(+Source, +PackTopDir, +Name, +Options)
Install a package from a local media.
To be done
- Provide an option to install directories using a link (or file-links).
  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).
 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
Unpack an archive to the given package dir.
  726:- if(exists_source(library(archive))).  727pack_unpack(Source, PackDir, Pack, Options) :-
  728    ensure_loaded_archive,
  729    pack_archive_info(Source, Pack, _Info, StripOptions),
  730    prepare_pack_dir(PackDir, Options),
  731    archive_extract(Source, PackDir,
  732                    [ exclude(['._*'])          % MacOS resource forks
  733                    | StripOptions
  734                    ]).
  735:- else.  736pack_unpack(_,_,_,_) :-
  737    existence_error(library, archive).
  738:- endif.  739
  740                 /*******************************
  741                 *             INFO             *
  742                 *******************************/
 pack_archive_info(+Archive, +Pack, -Info, -Strip)
True when Archive archives Pack. Info is unified with the terms from pack.pl in the pack and Strip is the strip-option for archive_extract/3.

Requires library(archive), which is lazily loaded when needed.

Errors
- existence_error(pack_file, 'pack.pl') if the archive doesn't contain pack.pl
- Syntax errors if pack.pl cannot be parsed.
  756:- if(exists_source(library(archive))).  757ensure_loaded_archive :-
  758    current_predicate(archive_open/3),
  759    !.
  760ensure_loaded_archive :-
  761    use_module(library(archive)).
  762
  763pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  764    ensure_loaded_archive,
  765    size_file(Archive, Bytes),
  766    setup_call_cleanup(
  767        archive_open(Archive, Handle, []),
  768        (   repeat,
  769            (   archive_next_header(Handle, InfoFile)
  770            ->  true
  771            ;   !, fail
  772            )
  773        ),
  774        archive_close(Handle)),
  775    file_base_name(InfoFile, 'pack.pl'),
  776    atom_concat(Prefix, 'pack.pl', InfoFile),
  777    strip_option(Prefix, Pack, Strip),
  778    setup_call_cleanup(
  779        archive_open_entry(Handle, Stream),
  780        read_stream_to_terms(Stream, Info),
  781        close(Stream)),
  782    !,
  783    must_be(ground, Info),
  784    maplist(valid_info_term, Info).
  785:- else.  786pack_archive_info(_, _, _, _) :-
  787    existence_error(library, archive).
  788:- endif.  789pack_archive_info(_, _, _, _) :-
  790    existence_error(pack_file, 'pack.pl').
  791
  792strip_option('', _, []) :- !.
  793strip_option('./', _, []) :- !.
  794strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  795    atom_concat(PrefixDir, /, Prefix),
  796    file_base_name(PrefixDir, Base),
  797    (   Base == Pack
  798    ->  true
  799    ;   pack_version_file(Pack, _, Base)
  800    ->  true
  801    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  802    ).
  803
  804read_stream_to_terms(Stream, Terms) :-
  805    read(Stream, Term0),
  806    read_stream_to_terms(Term0, Stream, Terms).
  807
  808read_stream_to_terms(end_of_file, _, []) :- !.
  809read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  810    read(Stream, Term1),
  811    read_stream_to_terms(Term1, Stream, Terms).
 pack_git_info(+GitDir, -Hash, -Info) is det
Retrieve info from a cloned git repository that is compatible with pack_archive_info/4.
  819pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  820    exists_directory(GitDir),
  821    !,
  822    git_ls_tree(Entries, [directory(GitDir)]),
  823    git_hash(Hash, [directory(GitDir)]),
  824    maplist(arg(4), Entries, Sizes),
  825    sum_list(Sizes, Bytes),
  826    directory_file_path(GitDir, 'pack.pl', InfoFile),
  827    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  828    must_be(ground, Info),
  829    maplist(valid_info_term, Info).
 download_file_sanity_check(+Archive, +Pack, +Info) is semidet
Perform basic sanity checks on DownloadFile
  835download_file_sanity_check(Archive, Pack, Info) :-
  836    info_field(name(Name), Info),
  837    info_field(version(VersionAtom), Info),
  838    atom_version(VersionAtom, Version),
  839    pack_version_file(PackA, VersionA, Archive),
  840    must_match([Pack, PackA, Name], name),
  841    must_match([Version, VersionA], version).
  842
  843info_field(Field, Info) :-
  844    memberchk(Field, Info),
  845    ground(Field),
  846    !.
  847info_field(Field, _Info) :-
  848    functor(Field, FieldName, _),
  849    print_message(error, pack(missing(FieldName))),
  850    fail.
  851
  852must_match(Values, _Field) :-
  853    sort(Values, [_]),
  854    !.
  855must_match(Values, Field) :-
  856    print_message(error, pack(conflict(Field, Values))),
  857    fail.
  858
  859
  860                 /*******************************
  861                 *         INSTALLATION         *
  862                 *******************************/
 prepare_pack_dir(+Dir, +Options)
Prepare for installing the package into Dir. This should create Dir if it does not exist and warn if the directory already exists, asking to make it empty.
  870prepare_pack_dir(Dir, Options) :-
  871    exists_directory(Dir),
  872    !,
  873    (   empty_directory(Dir)
  874    ->  true
  875    ;   option(upgrade(true), Options)
  876    ->  delete_directory_contents(Dir)
  877    ;   confirm(remove_existing_pack(Dir), yes, Options),
  878        delete_directory_contents(Dir)
  879    ).
  880prepare_pack_dir(Dir, _) :-
  881    make_directory(Dir).
 empty_directory(+Directory) is semidet
True if Directory is empty (holds no files or sub-directories).
  887empty_directory(Dir) :-
  888    \+ ( directory_files(Dir, Entries),
  889         member(Entry, Entries),
  890         \+ special(Entry)
  891       ).
  892
  893special(.).
  894special(..).
 pack_install_from_url(+Scheme, +URL, +PackDir, +Pack, +Options)
Install a package from a remote source. For git repositories, we simply clone. Archives are downloaded. We currently use the built-in HTTP client. For complete coverage, we should consider using an external (e.g., curl) if available.
  904pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  905    option(git(true), Options),
  906    !,
  907    directory_file_path(PackTopDir, Pack, PackDir),
  908    prepare_pack_dir(PackDir, Options),
  909    run_process(path(git), [clone, URL, PackDir], []),
  910    pack_git_info(PackDir, Hash, Info),
  911    pack_inquiry(URL, git(Hash), Info, Options),
  912    show_info(Pack, Info, Options),
  913    confirm(git_post_install(PackDir, Pack), yes, Options),
  914    pack_post_install(Pack, PackDir, Options).
  915pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
  916    download_scheme(Scheme),
  917    directory_file_path(PackTopDir, Pack, PackDir),
  918    prepare_pack_dir(PackDir, Options),
  919    pack_download_dir(PackTopDir, DownLoadDir),
  920    download_file(URL, Pack, DownloadBase, Options),
  921    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
  922    setup_call_cleanup(
  923        http_open(URL, In,
  924                  [ cert_verify_hook(ssl_verify)
  925                  ]),
  926        setup_call_cleanup(
  927            open(DownloadFile, write, Out, [type(binary)]),
  928            copy_stream_data(In, Out),
  929            close(Out)),
  930        close(In)),
  931    pack_archive_info(DownloadFile, Pack, Info, _),
  932    download_file_sanity_check(DownloadFile, Pack, Info),
  933    pack_inquiry(URL, DownloadFile, Info, Options),
  934    show_info(Pack, Info, Options),
  935    confirm(install_downloaded(DownloadFile), yes, Options),
  936    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
 download_file(+URL, +Pack, -File, +Options) is det
  940download_file(URL, Pack, File, Options) :-
  941    option(version(Version), Options),
  942    !,
  943    atom_version(VersionA, Version),
  944    file_name_extension(_, Ext, URL),
  945    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
  946download_file(URL, Pack, File, _) :-
  947    file_base_name(URL,Basename),
  948    no_int_file_name_extension(Tag,Ext,Basename),
  949    tag_version(Tag,Version),
  950    !,
  951    atom_version(VersionA,Version),
  952    format(atom(File0), '~w-~w', [Pack, VersionA]),
  953    file_name_extension(File0, Ext, File).
  954download_file(URL, _, File, _) :-
  955    file_base_name(URL, File).
 pack_url_file(+URL, -File) is det
True if File is a unique id for the referenced pack and version. Normally, that is simply the base name, but GitHub archives destroy this picture. Needed by the pack manager.
  963pack_url_file(URL, FileID) :-
  964    github_release_url(URL, Pack, Version),
  965    !,
  966    download_file(URL, Pack, FileID, [version(Version)]).
  967pack_url_file(URL, FileID) :-
  968    file_base_name(URL, FileID).
  969
  970
  971:- public ssl_verify/5.
 ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
Currently we accept all certificates. We organise our own security using SHA1 signatures, so we do not care about the source of the data.
  979ssl_verify(_SSL,
  980           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  981           _Error).
  982
  983pack_download_dir(PackTopDir, DownLoadDir) :-
  984    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
  985    (   exists_directory(DownLoadDir)
  986    ->  true
  987    ;   make_directory(DownLoadDir)
  988    ),
  989    (   access_file(DownLoadDir, write)
  990    ->  true
  991    ;   permission_error(write, directory, DownLoadDir)
  992    ).
 download_url(+URL) is det
True if URL looks like a URL we can download from.
  998download_url(URL) :-
  999    atom(URL),
 1000    uri_components(URL, Components),
 1001    uri_data(scheme, Components, Scheme),
 1002    download_scheme(Scheme).
 1003
 1004download_scheme(http).
 1005download_scheme(https) :-
 1006    catch(use_module(library(http/http_ssl_plugin)),
 1007          E, (print_message(warning, E), fail)).
 pack_post_install(+Pack, +PackDir, +Options) is det
Process post installation work. Steps:
 1017pack_post_install(Pack, PackDir, Options) :-
 1018    post_install_foreign(Pack, PackDir,
 1019                         [ build_foreign(if_absent)
 1020                         | Options
 1021                         ]),
 1022    post_install_autoload(PackDir, Options),
 1023    '$pack_attach'(PackDir).
 pack_rebuild(+Pack) is det
Rebuilt possible foreign components of Pack.
 1029pack_rebuild(Pack) :-
 1030    '$pack':pack(Pack, BaseDir),
 1031    !,
 1032    catch(pack_make(BaseDir, [distclean], []), E,
 1033          print_message(warning, E)),
 1034    post_install_foreign(Pack, BaseDir, []).
 1035pack_rebuild(Pack) :-
 1036    existence_error(pack, Pack).
 pack_rebuild is det
Rebuild foreign components of all packages.
 1042pack_rebuild :-
 1043    forall(current_pack(Pack),
 1044           ( print_message(informational, pack(rebuild(Pack))),
 1045             pack_rebuild(Pack)
 1046           )).
 post_install_foreign(+Pack, +PackDir, +Options) is det
Install foreign parts of the package.
 1053post_install_foreign(Pack, PackDir, Options) :-
 1054    is_foreign_pack(PackDir),
 1055    !,
 1056    (   option(build_foreign(if_absent), Options),
 1057        foreign_present(PackDir)
 1058    ->  print_message(informational, pack(kept_foreign(Pack)))
 1059    ;   setup_path,
 1060        save_build_environment(PackDir),
 1061        configure_foreign(PackDir, Options),
 1062        make_foreign(PackDir, Options)
 1063    ).
 1064post_install_foreign(_, _, _).
 1065
 1066foreign_present(PackDir) :-
 1067    current_prolog_flag(arch, Arch),
 1068    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1069    exists_directory(ForeignBaseDir),
 1070    !,
 1071    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1072    exists_directory(ForeignDir),
 1073    current_prolog_flag(shared_object_extension, Ext),
 1074    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1075    expand_file_name(Pattern, Files),
 1076    Files \== [].
 1077
 1078is_foreign_pack(PackDir) :-
 1079    foreign_file(File),
 1080    directory_file_path(PackDir, File, Path),
 1081    exists_file(Path),
 1082    !.
 1083
 1084foreign_file('configure.in').
 1085foreign_file('configure.ac').
 1086foreign_file('configure').
 1087foreign_file('Makefile').
 1088foreign_file('makefile').
 1089foreign_file('CMakeLists.txt').
 configure_foreign(+PackDir, +Options) is det
Run configure if it exists. If configure.ac or configure.in exists, first run autoheader and autoconf
 1097configure_foreign(PackDir, Options) :-
 1098    directory_file_path(PackDir, 'CMakeLists.txt', CMakeFile),
 1099    exists_file(CMakeFile),
 1100    !,
 1101    cmake_configure_foreign(PackDir, Options).
 1102configure_foreign(PackDir, Options) :-
 1103    make_configure(PackDir, Options),
 1104    directory_file_path(PackDir, configure, Configure),
 1105    exists_file(Configure),
 1106    !,
 1107    build_environment(BuildEnv),
 1108    run_process(path(bash), [Configure],
 1109                [ env(BuildEnv),
 1110                  directory(PackDir)
 1111                ]).
 1112configure_foreign(_, _).
 1113
 1114make_configure(PackDir, _Options) :-
 1115    directory_file_path(PackDir, 'configure', Configure),
 1116    exists_file(Configure),
 1117    !.
 1118make_configure(PackDir, _Options) :-
 1119    autoconf_master(ConfigMaster),
 1120    directory_file_path(PackDir, ConfigMaster, ConfigureIn),
 1121    exists_file(ConfigureIn),
 1122    !,
 1123    run_process(path(autoheader), [], [directory(PackDir)]),
 1124    run_process(path(autoconf),   [], [directory(PackDir)]).
 1125make_configure(_, _).
 1126
 1127autoconf_master('configure.ac').
 1128autoconf_master('configure.in').
 cmake_configure_foreign(+PackDir, +Options) is det
Create a build directory in PackDir and run `cmake ..`
 1134cmake_configure_foreign(PackDir, _Options) :-
 1135    directory_file_path(PackDir, build, BuildDir),
 1136    make_directory_path(BuildDir),
 1137    current_prolog_flag(executable, Exe),
 1138    format(atom(CDEF), '-DSWIPL=~w', [Exe]),
 1139    run_process(path(cmake), [CDEF, '..'],
 1140                [directory(BuildDir)]).
 make_foreign(+PackDir, +Options) is det
Generate the foreign executable.
 1147make_foreign(PackDir, Options) :-
 1148    pack_make(PackDir, [all, check, install], Options).
 1149
 1150pack_make(PackDir, Targets, _Options) :-
 1151    directory_file_path(PackDir, 'Makefile', Makefile),
 1152    exists_file(Makefile),
 1153    !,
 1154    build_environment(BuildEnv),
 1155    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1156    forall(member(Target, Targets),
 1157           run_process(path(make), [Target], ProcessOptions)).
 1158pack_make(PackDir, Targets, _Options) :-
 1159    directory_file_path(PackDir, 'CMakeLists.txt', CMakefile),
 1160    exists_file(CMakefile),
 1161    directory_file_path(PackDir, 'build', BuildDir),
 1162    exists_directory(BuildDir),
 1163    !,
 1164    (   Targets == [distclean]
 1165    ->  delete_directory_contents(BuildDir)
 1166    ;   build_environment(BuildEnv),
 1167        ProcessOptions = [ directory(BuildDir), env(BuildEnv) ],
 1168        forall(member(Target, Targets),
 1169               run_cmake_target(Target, BuildDir, ProcessOptions))
 1170    ).
 1171pack_make(_, _, _).
 1172
 1173run_cmake_target(check, BuildDir, ProcessOptions) :-
 1174    !,
 1175    (   directory_file_path(BuildDir, 'CTestTestfile.cmake', TestFile),
 1176        exists_file(TestFile)
 1177    ->  run_process(path(ctest), [], ProcessOptions)
 1178    ;   true
 1179    ).
 1180run_cmake_target(Target, _, ProcessOptions) :-
 1181    run_process(path(make), [Target], ProcessOptions).
 save_build_environment(+PackDir)
Create a shell-script build.env that contains the build environment.
 1188save_build_environment(PackDir) :-
 1189    directory_file_path(PackDir, 'buildenv.sh', EnvFile),
 1190    build_environment(Env),
 1191    setup_call_cleanup(
 1192        open(EnvFile, write, Out),
 1193        write_env_script(Out, Env),
 1194        close(Out)).
 1195
 1196write_env_script(Out, Env) :-
 1197    format(Out,
 1198           '# This file contains the environment that can be used to\n\c
 1199                # build the foreign pack outside Prolog.  This file must\n\c
 1200                # be loaded into a bourne-compatible shell using\n\c
 1201                #\n\c
 1202                #   $ source buildenv.sh\n\n',
 1203           []),
 1204    forall(member(Var=Value, Env),
 1205           format(Out, '~w=\'~w\'\n', [Var, Value])),
 1206    format(Out, '\nexport ', []),
 1207    forall(member(Var=_, Env),
 1208           format(Out, ' ~w', [Var])),
 1209    format(Out, '\n', []).
 1210
 1211build_environment(Env) :-
 1212    findall(Name=Value, environment(Name, Value), UserEnv),
 1213    findall(Name=Value,
 1214            ( def_environment(Name, Value),
 1215              \+ memberchk(Name=_, UserEnv)
 1216            ),
 1217            DefEnv),
 1218    append(UserEnv, DefEnv, Env).
 environment(-Name, -Value) is nondet
Hook to define the environment for building packs. This Multifile hook extends the process environment for building foreign extensions. A value provided by this hook overrules defaults provided by def_environment/2. In addition to changing the environment, this may be used to pass additional values to the environment, as in:
prolog_pack:environment('USER', User) :-
    getenv('USER', User).
Arguments:
Name- is an atom denoting a valid variable name
Value- is either an atom or number representing the value of the variable.
 def_environment(-Name, -Value) is nondet
True if Name=Value must appear in the environment for building foreign extensions.
 1245def_environment('PATH', Value) :-
 1246    getenv('PATH', PATH),
 1247    current_prolog_flag(executable, Exe),
 1248    file_directory_name(Exe, ExeDir),
 1249    prolog_to_os_filename(ExeDir, OsExeDir),
 1250    (   current_prolog_flag(windows, true)
 1251    ->  Sep = (;)
 1252    ;   Sep = (:)
 1253    ),
 1254    atomic_list_concat([OsExeDir, Sep, PATH], Value).
 1255def_environment('SWIPL', Value) :-
 1256    current_prolog_flag(executable, Value).
 1257def_environment('SWIPLVERSION', Value) :-
 1258    current_prolog_flag(version, Value).
 1259def_environment('SWIHOME', Value) :-
 1260    current_prolog_flag(home, Value).
 1261def_environment('SWIARCH', Value) :-
 1262    current_prolog_flag(arch, Value).
 1263def_environment('PACKSODIR', Value) :-
 1264    current_prolog_flag(arch, Arch),
 1265    atom_concat('lib/', Arch, Value).
 1266def_environment('SWISOLIB', Value) :-
 1267    current_prolog_flag(c_libplso, Value).
 1268def_environment('SWILIB', '-lswipl').
 1269def_environment('CC', Value) :-
 1270    (   getenv('CC', Value)
 1271    ->  true
 1272    ;   default_c_compiler(Value)
 1273    ->  true
 1274    ;   current_prolog_flag(c_cc, Value)
 1275    ).
 1276def_environment('LD', Value) :-
 1277    (   getenv('LD', Value)
 1278    ->  true
 1279    ;   current_prolog_flag(c_cc, Value)
 1280    ).
 1281def_environment('CFLAGS', Value) :-
 1282    (   getenv('CFLAGS', SystemFlags)
 1283    ->  Extra = [' ', SystemFlags]
 1284    ;   Extra = []
 1285    ),
 1286    current_prolog_flag(c_cflags, Value0),
 1287    current_prolog_flag(home, Home),
 1288    atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
 1289def_environment('LDSOFLAGS', Value) :-
 1290    (   getenv('LDFLAGS', SystemFlags)
 1291    ->  Extra = [SystemFlags|System]
 1292    ;   Extra = System
 1293    ),
 1294    (   current_prolog_flag(windows, true)
 1295    ->  current_prolog_flag(home, Home),
 1296        atomic_list_concat(['-L"', Home, '/bin"'], SystemLib),
 1297        System = [SystemLib]
 1298    ;   apple_bundle_libdir(LibDir)
 1299    ->  atomic_list_concat(['-L"', LibDir, '"'], SystemLib),
 1300        System = [SystemLib]
 1301    ;   current_prolog_flag(c_libplso, '')
 1302    ->  System = []                 % ELF systems do not need this
 1303    ;   prolog_library_dir(SystemLibDir),
 1304        atomic_list_concat(['-L"',SystemLibDir,'"'], SystemLib),
 1305        System = [SystemLib]
 1306    ),
 1307    current_prolog_flag(c_ldflags, LDFlags),
 1308    atomic_list_concat([LDFlags, '-shared' | Extra], ' ', Value).
 1309def_environment('SOEXT', Value) :-
 1310    current_prolog_flag(shared_object_extension, Value).
 1311def_environment(Pass, Value) :-
 1312    pass_env(Pass),
 1313    getenv(Pass, Value).
 1314
 1315pass_env('TMP').
 1316pass_env('TEMP').
 1317pass_env('USER').
 1318pass_env('HOME').
 1319
 1320:- multifile
 1321    prolog:runtime_config/2. 1322
 1323prolog_library_dir(Dir) :-
 1324    prolog:runtime_config(c_libdir, Dir),
 1325    !.
 1326prolog_library_dir(Dir) :-
 1327    current_prolog_flag(home, Home),
 1328    (   current_prolog_flag(c_libdir, Rel)
 1329    ->  atomic_list_concat([Home, Rel], /, Dir)
 1330    ;   current_prolog_flag(arch, Arch)
 1331    ->  atomic_list_concat([Home, lib, Arch], /, Dir)
 1332    ).
 default_c_compiler(-CC) is semidet
Try to find a suitable C compiler for compiling packages with foreign code.
To be done
- Needs proper defaults for Windows. Find MinGW? Find MSVC?
 1341default_c_compiler(CC) :-
 1342    preferred_c_compiler(CC),
 1343    has_program(path(CC), _),
 1344    !.
 1345
 1346preferred_c_compiler(gcc).
 1347preferred_c_compiler(clang).
 1348preferred_c_compiler(cc).
 1349
 1350
 1351                 /*******************************
 1352                 *             PATHS            *
 1353                 *******************************/
 1354
 1355setup_path :-
 1356    has_program(path(make), _),
 1357    has_program(path(gcc), _),
 1358    !.
 1359setup_path :-
 1360    current_prolog_flag(windows, true),
 1361    !,
 1362    (   mingw_extend_path
 1363    ->  true
 1364    ;   print_message(error, pack(no_mingw))
 1365    ).
 1366setup_path.
 1367
 1368has_program(Program, Path) :-
 1369    exe_options(ExeOptions),
 1370    absolute_file_name(Program, Path,
 1371                       [ file_errors(fail)
 1372                       | ExeOptions
 1373                       ]).
 1374
 1375exe_options(Options) :-
 1376    current_prolog_flag(windows, true),
 1377    !,
 1378    Options = [ extensions(['',exe,com]), access(read) ].
 1379exe_options(Options) :-
 1380    Options = [ access(execute) ].
 1381
 1382mingw_extend_path :-
 1383    mingw_root(MinGW),
 1384    directory_file_path(MinGW, bin, MinGWBinDir),
 1385    atom_concat(MinGW, '/msys/*/bin', Pattern),
 1386    expand_file_name(Pattern, MsysDirs),
 1387    last(MsysDirs, MSysBinDir),
 1388    prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
 1389    prolog_to_os_filename(MSysBinDir, WinDirMSYS),
 1390    getenv('PATH', Path0),
 1391    atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
 1392    setenv('PATH', Path).
 1393
 1394mingw_root(MinGwRoot) :-
 1395    current_prolog_flag(executable, Exe),
 1396    sub_atom(Exe, 1, _, _, :),
 1397    sub_atom(Exe, 0, 1, _, PlDrive),
 1398    Drives = [PlDrive,c,d],
 1399    member(Drive, Drives),
 1400    format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
 1401    exists_directory(MinGwRoot),
 1402    !.
 1403
 1404
 1405                 /*******************************
 1406                 *           AUTOLOAD           *
 1407                 *******************************/
 post_install_autoload(+PackDir, +Options)
Create an autoload index if the package demands such.
 1413post_install_autoload(PackDir, Options) :-
 1414    option(autoload(true), Options, true),
 1415    pack_info_term(PackDir, autoload(true)),
 1416    !,
 1417    directory_file_path(PackDir, prolog, PrologLibDir),
 1418    make_library_index(PrologLibDir).
 1419post_install_autoload(_, _).
 1420
 1421
 1422                 /*******************************
 1423                 *            UPGRADE           *
 1424                 *******************************/
 pack_upgrade(+Pack) is semidet
Try to upgrade the package Pack.
To be done
- Update dependencies when updating a pack from git?
 1432pack_upgrade(Pack) :-
 1433    pack_info(Pack, _, directory(Dir)),
 1434    directory_file_path(Dir, '.git', GitDir),
 1435    exists_directory(GitDir),
 1436    !,
 1437    print_message(informational, pack(git_fetch(Dir))),
 1438    git([fetch], [ directory(Dir) ]),
 1439    git_describe(V0, [ directory(Dir) ]),
 1440    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1441    (   V0 == V1
 1442    ->  print_message(informational, pack(up_to_date(Pack)))
 1443    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1444        git([merge, 'origin/master'], [ directory(Dir) ]),
 1445        pack_rebuild(Pack)
 1446    ).
 1447pack_upgrade(Pack) :-
 1448    once(pack_info(Pack, _, version(VersionAtom))),
 1449    atom_version(VersionAtom, Version),
 1450    pack_info(Pack, _, download(URL)),
 1451    (   wildcard_pattern(URL)
 1452    ->  true
 1453    ;   github_url(URL, _User, _Repo)
 1454    ),
 1455    !,
 1456    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1457    (   Latest @> Version
 1458    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1459        pack_install(Pack,
 1460                     [ url(LatestURL),
 1461                       upgrade(true),
 1462                       pack(Pack)
 1463                     ])
 1464    ;   print_message(informational, pack(up_to_date(Pack)))
 1465    ).
 1466pack_upgrade(Pack) :-
 1467    print_message(warning, pack(no_upgrade_info(Pack))).
 1468
 1469
 1470                 /*******************************
 1471                 *            REMOVE            *
 1472                 *******************************/
 pack_remove(+Name) is det
Remove the indicated package.
 1478pack_remove(Pack) :-
 1479    update_dependency_db,
 1480    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1481    ->  confirm_remove(Pack, Deps, Delete),
 1482        forall(member(P, Delete), pack_remove_forced(P))
 1483    ;   pack_remove_forced(Pack)
 1484    ).
 1485
 1486pack_remove_forced(Pack) :-
 1487    catch('$pack_detach'(Pack, BaseDir),
 1488          error(existence_error(pack, Pack), _),
 1489          fail),
 1490    !,
 1491    print_message(informational, pack(remove(BaseDir))),
 1492    delete_directory_and_contents(BaseDir).
 1493pack_remove_forced(Pack) :-
 1494    directory_file_path(Pack, 'pack.pl', PackFile),
 1495    absolute_file_name(pack(PackFile), PackPath,
 1496                       [ access(read),
 1497                         file_errors(fail)
 1498                       ]),
 1499    !,
 1500    file_directory_name(PackPath, BaseDir),
 1501    delete_directory_and_contents(BaseDir).
 1502pack_remove_forced(Pack) :-
 1503    print_message(informational, error(existence_error(pack, Pack),_)).
 1504
 1505confirm_remove(Pack, Deps, Delete) :-
 1506    print_message(warning, pack(depends(Pack, Deps))),
 1507    menu(pack(resolve_remove),
 1508         [ [Pack]      = remove_only(Pack),
 1509           [Pack|Deps] = remove_deps(Pack, Deps),
 1510           []          = cancel
 1511         ], [], Delete, []),
 1512    Delete \== [].
 1513
 1514
 1515                 /*******************************
 1516                 *           PROPERTIES         *
 1517                 *******************************/
 pack_property(?Pack, ?Property) is nondet
True when Property is a property of an installed Pack. This interface is intended for programs that wish to interact with the package manager. Defined properties are:
directory(Directory)
Directory into which the package is installed
version(Version)
Installed version
title(Title)
Full title of the package
author(Author)
Registered author
download(URL)
Official download URL
readme(File)
Package README file (if present)
todo(File)
Package TODO file (if present)
 1540pack_property(Pack, Property) :-
 1541    findall(Pack-Property, pack_property_(Pack, Property), List),
 1542    member(Pack-Property, List).            % make det if applicable
 1543
 1544pack_property_(Pack, Property) :-
 1545    pack_info(Pack, _, Property).
 1546pack_property_(Pack, Property) :-
 1547    \+ \+ info_file(Property, _),
 1548    '$pack':pack(Pack, BaseDir),
 1549    access_file(BaseDir, read),
 1550    directory_files(BaseDir, Files),
 1551    member(File, Files),
 1552    info_file(Property, Pattern),
 1553    downcase_atom(File, Pattern),
 1554    directory_file_path(BaseDir, File, InfoFile),
 1555    arg(1, Property, InfoFile).
 1556
 1557info_file(readme(_), 'readme.txt').
 1558info_file(readme(_), 'readme').
 1559info_file(todo(_),   'todo.txt').
 1560info_file(todo(_),   'todo').
 1561
 1562
 1563                 /*******************************
 1564                 *             GIT              *
 1565                 *******************************/
 git_url(+URL, -Pack) is semidet
True if URL describes a git url for Pack
 1571git_url(URL, Pack) :-
 1572    uri_components(URL, Components),
 1573    uri_data(scheme, Components, Scheme),
 1574    uri_data(path, Components, Path),
 1575    (   Scheme == git
 1576    ->  true
 1577    ;   git_download_scheme(Scheme),
 1578        file_name_extension(_, git, Path)
 1579    ),
 1580    file_base_name(Path, PackExt),
 1581    (   file_name_extension(Pack, git, PackExt)
 1582    ->  true
 1583    ;   Pack = PackExt
 1584    ),
 1585    (   safe_pack_name(Pack)
 1586    ->  true
 1587    ;   domain_error(pack_name, Pack)
 1588    ).
 1589
 1590git_download_scheme(http).
 1591git_download_scheme(https).
 safe_pack_name(+Name:atom) is semidet
Verifies that Name is a valid pack name. This avoids trickery with pack file names to make shell commands behave unexpectly.
 1598safe_pack_name(Name) :-
 1599    atom_length(Name, Len),
 1600    Len >= 3,                               % demand at least three length
 1601    atom_codes(Name, Codes),
 1602    maplist(safe_pack_char, Codes),
 1603    !.
 1604
 1605safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1606safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1607safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1608safe_pack_char(0'_).
 1609
 1610
 1611                 /*******************************
 1612                 *         VERSION LOGIC        *
 1613                 *******************************/
 pack_version_file(-Pack, -Version, +File) is semidet
True if File is the name of a file or URL of a file that contains Pack at Version. File must have an extension and the basename must be of the form <pack>-<n>{.<m>}*. E.g., mypack-1.5.
 1622pack_version_file(Pack, Version, GitHubRelease) :-
 1623    atomic(GitHubRelease),
 1624    github_release_url(GitHubRelease, Pack, Version),
 1625    !.
 1626pack_version_file(Pack, Version, Path) :-
 1627    atomic(Path),
 1628    file_base_name(Path, File),
 1629    no_int_file_name_extension(Base, _Ext, File),
 1630    atom_codes(Base, Codes),
 1631    (   phrase(pack_version(Pack, Version), Codes),
 1632        safe_pack_name(Pack)
 1633    ->  true
 1634    ).
 1635
 1636no_int_file_name_extension(Base, Ext, File) :-
 1637    file_name_extension(Base0, Ext0, File),
 1638    \+ atom_number(Ext0, _),
 1639    !,
 1640    Base = Base0,
 1641    Ext = Ext0.
 1642no_int_file_name_extension(File, '', File).
 github_release_url(+URL, -Pack, -Version) is semidet
True when URL is the URL of a GitHub release. Such releases are accessible as
https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
 1655github_release_url(URL, Pack, Version) :-
 1656    uri_components(URL, Components),
 1657    uri_data(authority, Components, 'github.com'),
 1658    uri_data(scheme, Components, Scheme),
 1659    download_scheme(Scheme),
 1660    uri_data(path, Components, Path),
 1661    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1662    file_name_extension(Tag, Ext, File),
 1663    github_archive_extension(Ext),
 1664    tag_version(Tag, Version),
 1665    !.
 1666
 1667github_archive_extension(tgz).
 1668github_archive_extension(zip).
 1669
 1670tag_version(Tag, Version) :-
 1671    version_tag_prefix(Prefix),
 1672    atom_concat(Prefix, AtomVersion, Tag),
 1673    atom_version(AtomVersion, Version).
 1674
 1675version_tag_prefix(v).
 1676version_tag_prefix('V').
 1677version_tag_prefix('').
 1678
 1679
 1680:- public
 1681    atom_version/2.
 atom_version(?Atom, ?Version)
Translate between atomic version representation and term representation. The term representation is a list of version components as integers and can be compared using @>
 1689atom_version(Atom, version(Parts)) :-
 1690    (   atom(Atom)
 1691    ->  atom_codes(Atom, Codes),
 1692        phrase(version(Parts), Codes)
 1693    ;   atomic_list_concat(Parts, '.', Atom)
 1694    ).
 1695
 1696pack_version(Pack, version(Parts)) -->
 1697    string(Codes), "-",
 1698    version(Parts),
 1699    !,
 1700    { atom_codes(Pack, Codes)
 1701    }.
 1702
 1703version([_|T]) -->
 1704    "*",
 1705    !,
 1706    (   "."
 1707    ->  version(T)
 1708    ;   []
 1709    ).
 1710version([H|T]) -->
 1711    integer(H),
 1712    (   "."
 1713    ->  version(T)
 1714    ;   { T = [] }
 1715    ).
 1716
 1717integer(H)    --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
 1718digit(D)      --> [D], { code_type(D, digit) }.
 1719digits([H|T]) --> digit(H), !, digits(T).
 1720digits([])    --> [].
 1721
 1722
 1723                 /*******************************
 1724                 *       QUERY CENTRAL DB       *
 1725                 *******************************/
 pack_inquiry(+URL, +DownloadFile, +Info, +Options) is semidet
Query the status of a package with the central repository. To do this, we POST a Prolog document containing the URL, info and the SHA1 hash to http://www.swi-prolog.org/pack/eval. The server replies using a list of Prolog terms, described below. The only member that is always included is downloads (with default value 0).
alt_hash(Count, URLs, Hash)
A file with the same base-name, but a different hash was found at URLs and downloaded Count times.
downloads(Count)
Number of times a file with this hash was downloaded.
rating(VoteCount, Rating)
User rating (1..5), provided based on VoteCount votes.
dependency(Token, Pack, Version, URLs, SubDeps)
Required tokens can be provided by the given provides.
 1745pack_inquiry(_, _, _, Options) :-
 1746    option(inquiry(false), Options),
 1747    !.
 1748pack_inquiry(URL, DownloadFile, Info, Options) :-
 1749    setting(server, ServerBase),
 1750    ServerBase \== '',
 1751    atom_concat(ServerBase, query, Server),
 1752    (   option(inquiry(true), Options)
 1753    ->  true
 1754    ;   confirm(inquiry(Server), yes, Options)
 1755    ),
 1756    !,
 1757    (   DownloadFile = git(SHA1)
 1758    ->  true
 1759    ;   file_sha1(DownloadFile, SHA1)
 1760    ),
 1761    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1762    inquiry_result(Reply, URL, Options).
 1763pack_inquiry(_, _, _, _).
 query_pack_server(+Query, -Result, +Options)
Send a Prolog query to the package server and process its results.
 1771query_pack_server(Query, Result, Options) :-
 1772    setting(server, ServerBase),
 1773    ServerBase \== '',
 1774    atom_concat(ServerBase, query, Server),
 1775    format(codes(Data), '~q.~n', Query),
 1776    info_level(Informational, Options),
 1777    print_message(Informational, pack(contacting_server(Server))),
 1778    setup_call_cleanup(
 1779        http_open(Server, In,
 1780                  [ post(codes(application/'x-prolog', Data)),
 1781                    header(content_type, ContentType)
 1782                  ]),
 1783        read_reply(ContentType, In, Result),
 1784        close(In)),
 1785    message_severity(Result, Level, Informational),
 1786    print_message(Level, pack(server_reply(Result))).
 1787
 1788read_reply(ContentType, In, Result) :-
 1789    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1790    !,
 1791    set_stream(In, encoding(utf8)),
 1792    read(In, Result).
 1793read_reply(ContentType, In, _Result) :-
 1794    read_string(In, 500, String),
 1795    print_message(error, pack(no_prolog_response(ContentType, String))),
 1796    fail.
 1797
 1798info_level(Level, Options) :-
 1799    option(silent(true), Options),
 1800    !,
 1801    Level = silent.
 1802info_level(informational, _).
 1803
 1804message_severity(true(_), Informational, Informational).
 1805message_severity(false, warning, _).
 1806message_severity(exception(_), error, _).
 inquiry_result(+Reply, +File, +Options) is semidet
Analyse the results of the inquiry and decide whether to continue or not.
 1814inquiry_result(Reply, File, Options) :-
 1815    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1816    \+ member(cancel, Evaluation),
 1817    select_option(git(_), Options, Options1, _),
 1818    forall(member(install_dependencies(Resolution), Evaluation),
 1819           maplist(install_dependency(Options1), Resolution)).
 1820
 1821eval_inquiry(true(Reply), URL, Eval, _) :-
 1822    include(alt_hash, Reply, Alts),
 1823    Alts \== [],
 1824    print_message(warning, pack(alt_hashes(URL, Alts))),
 1825    (   memberchk(downloads(Count), Reply),
 1826        (   git_url(URL, _)
 1827        ->  Default = yes,
 1828            Eval = with_git_commits_in_same_version
 1829        ;   Default = no,
 1830            Eval = with_alt_hashes
 1831        ),
 1832        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1833    ->  true
 1834    ;   !,                          % Stop other rules
 1835        Eval = cancel
 1836    ).
 1837eval_inquiry(true(Reply), _, Eval, Options) :-
 1838    include(dependency, Reply, Deps),
 1839    Deps \== [],
 1840    select_dependency_resolution(Deps, Eval, Options),
 1841    (   Eval == cancel
 1842    ->  !
 1843    ;   true
 1844    ).
 1845eval_inquiry(true(Reply), URL, true, Options) :-
 1846    file_base_name(URL, File),
 1847    info_level(Informational, Options),
 1848    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1849eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1850             URL, Eval, Options) :-
 1851    (   confirm(continue_with_modified_hash(URL), no, Options)
 1852    ->  Eval = true
 1853    ;   Eval = cancel
 1854    ).
 1855
 1856alt_hash(alt_hash(_,_,_)).
 1857dependency(dependency(_,_,_,_,_)).
 select_dependency_resolution(+Deps, -Eval, +Options)
Select a resolution.
To be done
- Exploit backtracking over resolve_dependencies/2.
 1866select_dependency_resolution(Deps, Eval, Options) :-
 1867    resolve_dependencies(Deps, Resolution),
 1868    exclude(local_dep, Resolution, ToBeDone),
 1869    (   ToBeDone == []
 1870    ->  !, Eval = true
 1871    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1872        (   memberchk(_-unresolved, Resolution)
 1873        ->  Default = cancel
 1874        ;   Default = install_deps
 1875        ),
 1876        menu(pack(resolve_deps),
 1877             [ install_deps    = install_deps,
 1878               install_no_deps = install_no_deps,
 1879               cancel          = cancel
 1880             ], Default, Choice, Options),
 1881        (   Choice == cancel
 1882        ->  !, Eval = cancel
 1883        ;   Choice == install_no_deps
 1884        ->  !, Eval = install_no_deps
 1885        ;   !, Eval = install_dependencies(Resolution)
 1886        )
 1887    ).
 1888
 1889local_dep(_-resolved(_)).
 install_dependency(+Options, +TokenResolution)
Install dependencies for the given resolution.
To be done
- : Query URI to use
 1898install_dependency(Options,
 1899                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1900    atom_version(VersionAtom, Version),
 1901    current_pack(Pack),
 1902    pack_info(Pack, _, version(InstalledAtom)),
 1903    atom_version(InstalledAtom, Installed),
 1904    Installed == Version,               % already installed
 1905    !,
 1906    maplist(install_dependency(Options), SubResolve).
 1907install_dependency(Options,
 1908                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1909    !,
 1910    atom_version(VersionAtom, Version),
 1911    merge_options([ url(URL),
 1912                    version(Version),
 1913                    interactive(false),
 1914                    inquiry(false),
 1915                    info(list),
 1916                    pack(Pack)
 1917                  ], Options, InstallOptions),
 1918    pack_install(Pack, InstallOptions),
 1919    maplist(install_dependency(Options), SubResolve).
 1920install_dependency(_, _-_).
 1921
 1922
 1923                 /*******************************
 1924                 *        WILDCARD URIs         *
 1925                 *******************************/
 available_download_versions(+URL, -Versions) is det
Deal with wildcard URLs, returning a list of Version-URL pairs, sorted by version.
To be done
- Deal with protocols other than HTTP
 1934available_download_versions(URL, Versions) :-
 1935    wildcard_pattern(URL),
 1936    github_url(URL, User, Repo),
 1937    !,
 1938    findall(Version-VersionURL,
 1939            github_version(User, Repo, Version, VersionURL),
 1940            Versions).
 1941available_download_versions(URL, Versions) :-
 1942    wildcard_pattern(URL),
 1943    !,
 1944    file_directory_name(URL, DirURL0),
 1945    ensure_slash(DirURL0, DirURL),
 1946    print_message(informational, pack(query_versions(DirURL))),
 1947    setup_call_cleanup(
 1948        http_open(DirURL, In, []),
 1949        load_html(stream(In), DOM,
 1950                  [ syntax_errors(quiet)
 1951                  ]),
 1952        close(In)),
 1953    findall(MatchingURL,
 1954            absolute_matching_href(DOM, URL, MatchingURL),
 1955            MatchingURLs),
 1956    (   MatchingURLs == []
 1957    ->  print_message(warning, pack(no_matching_urls(URL)))
 1958    ;   true
 1959    ),
 1960    versioned_urls(MatchingURLs, VersionedURLs),
 1961    keysort(VersionedURLs, SortedVersions),
 1962    reverse(SortedVersions, Versions),
 1963    print_message(informational, pack(found_versions(Versions))).
 1964available_download_versions(URL, [Version-URL]) :-
 1965    (   pack_version_file(_Pack, Version0, URL)
 1966    ->  Version = Version0
 1967    ;   Version = unknown
 1968    ).
 github_url(+URL, -User, -Repo) is semidet
True when URL refers to a github repository.
 1974github_url(URL, User, Repo) :-
 1975    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1976    atomic_list_concat(['',User,Repo|_], /, Path).
 github_version(+User, +Repo, -Version, -VersionURI) is nondet
True when Version is a release version and VersionURI is the download location for the zip file.
 1984github_version(User, Repo, Version, VersionURI) :-
 1985    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1986    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1987    setup_call_cleanup(
 1988      http_open(ApiUri, In,
 1989                [ request_header('Accept'='application/vnd.github.v3+json')
 1990                ]),
 1991      json_read_dict(In, Dicts),
 1992      close(In)),
 1993    member(Dict, Dicts),
 1994    atom_string(Tag, Dict.name),
 1995    tag_version(Tag, Version),
 1996    atom_string(VersionURI, Dict.zipball_url).
 1997
 1998wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1999wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 2000
 2001ensure_slash(Dir, DirS) :-
 2002    (   sub_atom(Dir, _, _, 0, /)
 2003    ->  DirS = Dir
 2004    ;   atom_concat(Dir, /, DirS)
 2005    ).
 2006
 2007absolute_matching_href(DOM, Pattern, Match) :-
 2008    xpath(DOM, //a(@href), HREF),
 2009    uri_normalized(HREF, Pattern, Match),
 2010    wildcard_match(Pattern, Match).
 2011
 2012versioned_urls([], []).
 2013versioned_urls([H|T0], List) :-
 2014    file_base_name(H, File),
 2015    (   pack_version_file(_Pack, Version, File)
 2016    ->  List = [Version-H|T]
 2017    ;   List = T
 2018    ),
 2019    versioned_urls(T0, T).
 2020
 2021
 2022                 /*******************************
 2023                 *          DEPENDENCIES        *
 2024                 *******************************/
 update_dependency_db
Reload dependency declarations between packages.
 2030update_dependency_db :-
 2031    retractall(pack_requires(_,_)),
 2032    retractall(pack_provides_db(_,_)),
 2033    forall(current_pack(Pack),
 2034           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 2035               update_dependency_db(Pack, Infos)
 2036           )).
 2037
 2038update_dependency_db(Name, Info) :-
 2039    retractall(pack_requires(Name, _)),
 2040    retractall(pack_provides_db(Name, _)),
 2041    maplist(assert_dep(Name), Info).
 2042
 2043assert_dep(Pack, provides(Token)) :-
 2044    !,
 2045    assertz(pack_provides_db(Pack, Token)).
 2046assert_dep(Pack, requires(Token)) :-
 2047    !,
 2048    assertz(pack_requires(Pack, Token)).
 2049assert_dep(_, _).
 validate_dependencies is det
Validate all dependencies, reporting on failures
 2055validate_dependencies :-
 2056    unsatisfied_dependencies(Unsatisfied),
 2057    !,
 2058    print_message(warning, pack(unsatisfied(Unsatisfied))).
 2059validate_dependencies.
 2060
 2061
 2062unsatisfied_dependencies(Unsatisfied) :-
 2063    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 2064    keysort(Reqs0, Reqs1),
 2065    group_pairs_by_key(Reqs1, GroupedReqs),
 2066    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 2067    Unsatisfied \== [].
 2068
 2069satisfied_dependency(Needed-_By) :-
 2070    pack_provides(_, Needed),
 2071    !.
 2072satisfied_dependency(Needed-_By) :-
 2073    compound(Needed),
 2074    Needed =.. [Op, Pack, ReqVersion],
 2075    (   pack_provides(Pack, Pack)
 2076    ->  pack_info(Pack, _, version(PackVersion)),
 2077        version_data(PackVersion, PackData)
 2078    ;   Pack == prolog
 2079    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 2080        PackData = [Major,Minor,Patch]
 2081    ),
 2082    version_data(ReqVersion, ReqData),
 2083    cmp(Op, Cmp),
 2084    call(Cmp, PackData, ReqData).
 pack_provides(?Package, ?Token) is multi
True if Pack provides Token. A package always provides itself.
 2090pack_provides(Pack, Pack) :-
 2091    current_pack(Pack).
 2092pack_provides(Pack, Token) :-
 2093    pack_provides_db(Pack, Token).
 pack_depends_on(?Pack, ?Dependency) is nondet
True if Pack requires Dependency, direct or indirect.
 2099pack_depends_on(Pack, Dependency) :-
 2100    (   atom(Pack)
 2101    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 2102    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 2103    ).
 2104
 2105pack_depends_on_fwd(Pack, Dependency, Visited) :-
 2106    pack_depends_on_1(Pack, Dep1),
 2107    \+ memberchk(Dep1, Visited),
 2108    (   Dependency = Dep1
 2109    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 2110    ).
 2111
 2112pack_depends_on_bwd(Pack, Dependency, Visited) :-
 2113    pack_depends_on_1(Dep1, Dependency),
 2114    \+ memberchk(Dep1, Visited),
 2115    (   Pack = Dep1
 2116    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 2117    ).
 2118
 2119pack_depends_on_1(Pack, Dependency) :-
 2120    atom(Dependency),
 2121    !,
 2122    pack_provides(Dependency, Token),
 2123    pack_requires(Pack, Token).
 2124pack_depends_on_1(Pack, Dependency) :-
 2125    pack_requires(Pack, Token),
 2126    pack_provides(Dependency, Token).
 resolve_dependencies(+Dependencies, -Resolution) is multi
Resolve dependencies as reported by the remote package server.
Arguments:
Dependencies- is a list of dependency(Token, Pack, Version, URLs, SubDeps)
Resolution- is a list of items
  • Token-resolved(Pack)
  • Token-resolve(Pack, Version, URLs, SubResolve)
  • Token-unresolved
To be done
- Watch out for conflicts
- If there are different packs that resolve a token, make an intelligent choice instead of using the first
 2143resolve_dependencies(Dependencies, Resolution) :-
 2144    maplist(dependency_pair, Dependencies, Pairs0),
 2145    keysort(Pairs0, Pairs1),
 2146    group_pairs_by_key(Pairs1, ByToken),
 2147    maplist(resolve_dep, ByToken, Resolution).
 2148
 2149dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 2150                Token-(Pack-pack(Version,URLs, SubDeps))).
 2151
 2152resolve_dep(Token-Pairs, Token-Resolution) :-
 2153    (   resolve_dep2(Token-Pairs, Resolution)
 2154    *-> true
 2155    ;   Resolution = unresolved
 2156    ).
 2157
 2158resolve_dep2(Token-_, resolved(Pack)) :-
 2159    pack_provides(Pack, Token).
 2160resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 2161    keysort(Pairs, Sorted),
 2162    group_pairs_by_key(Sorted, ByPack),
 2163    member(Pack-Versions, ByPack),
 2164    Pack \== (-),
 2165    maplist(version_pack, Versions, VersionData),
 2166    sort(VersionData, ByVersion),
 2167    reverse(ByVersion, ByVersionLatest),
 2168    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 2169    atom_version(VersionAtom, Version),
 2170    include(dependency, SubDeps, Deps),
 2171    resolve_dependencies(Deps, SubResolves).
 2172
 2173version_pack(pack(VersionAtom,URLs,SubDeps),
 2174             pack(Version,URLs,SubDeps)) :-
 2175    atom_version(VersionAtom, Version).
 2176
 2177
 2178                 /*******************************
 2179                 *          RUN PROCESSES       *
 2180                 *******************************/
 run_process(+Executable, +Argv, +Options) is det
Run Executable. Defined options:
directory(+Dir)
Execute in the given directory
output(-Out)
Unify Out with a list of codes representing stdout of the command. Otherwise the output is handed to print_message/2 with level informational.
error(-Error)
As output(Out), but messages are printed at level error.
env(+Environment)
Environment passed to the new process.
 2197run_process(Executable, Argv, Options) :-
 2198    \+ option(output(_), Options),
 2199    \+ option(error(_), Options),
 2200    current_prolog_flag(unix, true),
 2201    current_prolog_flag(threads, true),
 2202    !,
 2203    process_create_options(Options, Extra),
 2204    process_create(Executable, Argv,
 2205                   [ stdout(pipe(Out)),
 2206                     stderr(pipe(Error)),
 2207                     process(PID)
 2208                   | Extra
 2209                   ]),
 2210    thread_create(relay_output([output-Out, error-Error]), Id, []),
 2211    process_wait(PID, Status),
 2212    thread_join(Id, _),
 2213    (   Status == exit(0)
 2214    ->  true
 2215    ;   throw(error(process_error(process(Executable, Argv), Status), _))
 2216    ).
 2217run_process(Executable, Argv, Options) :-
 2218    process_create_options(Options, Extra),
 2219    setup_call_cleanup(
 2220        process_create(Executable, Argv,
 2221                       [ stdout(pipe(Out)),
 2222                         stderr(pipe(Error)),
 2223                         process(PID)
 2224                       | Extra
 2225                       ]),
 2226        (   read_stream_to_codes(Out, OutCodes, []),
 2227            read_stream_to_codes(Error, ErrorCodes, []),
 2228            process_wait(PID, Status)
 2229        ),
 2230        (   close(Out),
 2231            close(Error)
 2232        )),
 2233    print_error(ErrorCodes, Options),
 2234    print_output(OutCodes, Options),
 2235    (   Status == exit(0)
 2236    ->  true
 2237    ;   throw(error(process_error(process(Executable, Argv), Status), _))
 2238    ).
 2239
 2240process_create_options(Options, Extra) :-
 2241    option(directory(Dir), Options, .),
 2242    (   option(env(Env), Options)
 2243    ->  Extra = [cwd(Dir), env(Env)]
 2244    ;   Extra = [cwd(Dir)]
 2245    ).
 2246
 2247relay_output([]) :- !.
 2248relay_output(Output) :-
 2249    pairs_values(Output, Streams),
 2250    wait_for_input(Streams, Ready, infinite),
 2251    relay(Ready, Output, NewOutputs),
 2252    relay_output(NewOutputs).
 2253
 2254relay([], Outputs, Outputs).
 2255relay([H|T], Outputs0, Outputs) :-
 2256    selectchk(Type-H, Outputs0, Outputs1),
 2257    (   at_end_of_stream(H)
 2258    ->  close(H),
 2259        relay(T, Outputs1, Outputs)
 2260    ;   read_pending_codes(H, Codes, []),
 2261        relay(Type, Codes),
 2262        relay(T, Outputs0, Outputs)
 2263    ).
 2264
 2265relay(error,  Codes) :-
 2266    set_prolog_flag(message_context, []),
 2267    print_error(Codes, []).
 2268relay(output, Codes) :-
 2269    print_output(Codes, []).
 2270
 2271print_output(OutCodes, Options) :-
 2272    option(output(Codes), Options),
 2273    !,
 2274    Codes = OutCodes.
 2275print_output(OutCodes, _) :-
 2276    print_message(informational, pack(process_output(OutCodes))).
 2277
 2278print_error(OutCodes, Options) :-
 2279    option(error(Codes), Options),
 2280    !,
 2281    Codes = OutCodes.
 2282print_error(OutCodes, _) :-
 2283    phrase(classify_message(Level), OutCodes, _),
 2284    print_message(Level, pack(process_output(OutCodes))).
 2285
 2286classify_message(error) -->
 2287    string(_), "fatal:",
 2288    !.
 2289classify_message(error) -->
 2290    string(_), "error:",
 2291    !.
 2292classify_message(warning) -->
 2293    string(_), "warning:",
 2294    !.
 2295classify_message(informational) -->
 2296    [].
 2297
 2298string([]) --> [].
 2299string([H|T]) --> [H], string(T).
 pack_attach(+Dir, +Options) is det
Attach a single package in Dir. The Dir is expected to contain the file pack.pl and a prolog directory. Options processed:
duplicate(+Action)
What to do if the same package is already installed in a different directory. Action is one of
warning
Warn and ignore the package
keep
Silently ignore the package
replace
Unregister the existing and insert the new package
search(+Where)
Determines the order of searching package library directories. Default is last, alternative is first.
See also
- attach_packs/2 to attach multiple packs from a directory.
 2322pack_attach(Dir, Options) :-
 2323    '$pack_attach'(Dir, Options).
 2324
 2325
 2326                 /*******************************
 2327                 *        USER INTERACTION      *
 2328                 *******************************/
 2329
 2330:- multifile prolog:message//1.
 menu(Question, +Alternatives, +Default, -Selection, +Options)
 2334menu(_Question, _Alternatives, Default, Selection, Options) :-
 2335    option(interactive(false), Options),
 2336    !,
 2337    Selection = Default.
 2338menu(Question, Alternatives, Default, Selection, _) :-
 2339    length(Alternatives, N),
 2340    between(1, 5, _),
 2341       print_message(query, Question),
 2342       print_menu(Alternatives, Default, 1),
 2343       print_message(query, pack(menu(select))),
 2344       read_selection(N, Choice),
 2345    !,
 2346    (   Choice == default
 2347    ->  Selection = Default
 2348    ;   nth1(Choice, Alternatives, Selection=_)
 2349    ->  true
 2350    ).
 2351
 2352print_menu([], _, _).
 2353print_menu([Value=Label|T], Default, I) :-
 2354    (   Value == Default
 2355    ->  print_message(query, pack(menu(default_item(I, Label))))
 2356    ;   print_message(query, pack(menu(item(I, Label))))
 2357    ),
 2358    I2 is I + 1,
 2359    print_menu(T, Default, I2).
 2360
 2361read_selection(Max, Choice) :-
 2362    get_single_char(Code),
 2363    (   answered_default(Code)
 2364    ->  Choice = default
 2365    ;   code_type(Code, digit(Choice)),
 2366        between(1, Max, Choice)
 2367    ->  true
 2368    ;   print_message(warning, pack(menu(reply(1,Max)))),
 2369        fail
 2370    ).
 confirm(+Question, +Default, +Options) is semidet
Ask for confirmation.
Arguments:
Default- is one of yes, no or none.
 2378confirm(_Question, Default, Options) :-
 2379    Default \== none,
 2380    option(interactive(false), Options, true),
 2381    !,
 2382    Default == yes.
 2383confirm(Question, Default, _) :-
 2384    between(1, 5, _),
 2385       print_message(query, pack(confirm(Question, Default))),
 2386       read_yes_no(YesNo, Default),
 2387    !,
 2388    format(user_error, '~N', []),
 2389    YesNo == yes.
 2390
 2391read_yes_no(YesNo, Default) :-
 2392    get_single_char(Code),
 2393    code_yes_no(Code, Default, YesNo),
 2394    !.
 2395
 2396code_yes_no(0'y, _, yes).
 2397code_yes_no(0'Y, _, yes).
 2398code_yes_no(0'n, _, no).
 2399code_yes_no(0'N, _, no).
 2400code_yes_no(_, none, _) :- !, fail.
 2401code_yes_no(C, Default, Default) :-
 2402    answered_default(C).
 2403
 2404answered_default(0'\r).
 2405answered_default(0'\n).
 2406answered_default(0'\s).
 2407
 2408
 2409                 /*******************************
 2410                 *            MESSAGES          *
 2411                 *******************************/
 2412
 2413:- multifile prolog:message//1. 2414
 2415prolog:message(pack(Message)) -->
 2416    message(Message).
 2417
 2418:- discontiguous
 2419    message//1,
 2420    label//1. 2421
 2422message(invalid_info(Term)) -->
 2423    [ 'Invalid package description: ~q'-[Term] ].
 2424message(directory_exists(Dir)) -->
 2425    [ 'Package target directory exists and is not empty:', nl,
 2426      '\t~q'-[Dir]
 2427    ].
 2428message(already_installed(pack(Pack, Version))) -->
 2429    { atom_version(AVersion, Version) },
 2430    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2431message(already_installed(Pack)) -->
 2432    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2433message(invalid_name(File)) -->
 2434    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2435    no_tar_gz(File).
 2436
 2437no_tar_gz(File) -->
 2438    { sub_atom(File, _, _, 0, '.tar.gz') },
 2439    !,
 2440    [ nl,
 2441      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2442    ].
 2443no_tar_gz(_) --> [].
 2444
 2445message(kept_foreign(Pack)) -->
 2446    [ 'Found foreign libraries for target platform.'-[], nl,
 2447      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2448    ].
 2449message(no_pack_installed(Pack)) -->
 2450    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2451message(no_packages_installed) -->
 2452    { setting(server, ServerBase) },
 2453    [ 'There are no extra packages installed.', nl,
 2454      'Please visit ~wlist.'-[ServerBase]
 2455    ].
 2456message(remove_with(Pack)) -->
 2457    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2458    ].
 2459message(unsatisfied(Packs)) -->
 2460    [ 'The following dependencies are not satisfied:', nl ],
 2461    unsatisfied(Packs).
 2462message(depends(Pack, Deps)) -->
 2463    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2464    pack_list(Deps).
 2465message(remove(PackDir)) -->
 2466    [ 'Removing ~q and contents'-[PackDir] ].
 2467message(remove_existing_pack(PackDir)) -->
 2468    [ 'Remove old installation in ~q'-[PackDir] ].
 2469message(install_from(Pack, Version, git(URL))) -->
 2470    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2471message(install_from(Pack, Version, URL)) -->
 2472    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2473message(select_install_from(Pack, Version)) -->
 2474    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2475message(install_downloaded(File)) -->
 2476    { file_base_name(File, Base),
 2477      size_file(File, Size) },
 2478    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2479message(git_post_install(PackDir, Pack)) -->
 2480    (   { is_foreign_pack(PackDir) }
 2481    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2482    ;   [ 'Activate pack "~w"'-[Pack] ]
 2483    ).
 2484message(no_meta_data(BaseDir)) -->
 2485    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2486message(inquiry(Server)) -->
 2487    [ 'Verify package status (anonymously)', nl,
 2488      '\tat "~w"'-[Server]
 2489    ].
 2490message(search_no_matches(Name)) -->
 2491    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2492message(rebuild(Pack)) -->
 2493    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2494message(upgrade(Pack, From, To)) -->
 2495    [ 'Upgrade "~w" from '-[Pack] ],
 2496    msg_version(From), [' to '-[]], msg_version(To).
 2497message(up_to_date(Pack)) -->
 2498    [ 'Package "~w" is up-to-date'-[Pack] ].
 2499message(query_versions(URL)) -->
 2500    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2501message(no_matching_urls(URL)) -->
 2502    [ 'Could not find any matching URL: ~q'-[URL] ].
 2503message(found_versions([Latest-_URL|More])) -->
 2504    { length(More, Len),
 2505      atom_version(VLatest, Latest)
 2506    },
 2507    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2508message(process_output(Codes)) -->
 2509    { split_lines(Codes, Lines) },
 2510    process_lines(Lines).
 2511message(contacting_server(Server)) -->
 2512    [ 'Contacting server at ~w ...'-[Server], flush ].
 2513message(server_reply(true(_))) -->
 2514    [ at_same_line, ' ok'-[] ].
 2515message(server_reply(false)) -->
 2516    [ at_same_line, ' done'-[] ].
 2517message(server_reply(exception(E))) -->
 2518    [ 'Server reported the following error:'-[], nl ],
 2519    '$messages':translate_message(E).
 2520message(cannot_create_dir(Alias)) -->
 2521    { findall(PackDir,
 2522              absolute_file_name(Alias, PackDir, [solutions(all)]),
 2523              PackDirs0),
 2524      sort(PackDirs0, PackDirs)
 2525    },
 2526    [ 'Cannot find a place to create a package directory.'-[],
 2527      'Considered:'-[]
 2528    ],
 2529    candidate_dirs(PackDirs).
 2530message(no_match(Name)) -->
 2531    [ 'No registered pack matches "~w"'-[Name] ].
 2532message(conflict(version, [PackV, FileV])) -->
 2533    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2534    [', file claims version '-[]], msg_version(FileV).
 2535message(conflict(name, [PackInfo, FileInfo])) -->
 2536    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2537    [', file claims ~w: ~p'-[FileInfo]].
 2538message(no_prolog_response(ContentType, String)) -->
 2539    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2540      '~s'-[String]
 2541    ].
 2542message(pack(no_upgrade_info(Pack))) -->
 2543    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2544
 2545candidate_dirs([]) --> [].
 2546candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2547
 2548message(no_mingw) -->
 2549    [ 'Cannot find MinGW and/or MSYS.'-[] ].
 2550
 2551                                                % Questions
 2552message(resolve_remove) -->
 2553    [ nl, 'Please select an action:', nl, nl ].
 2554message(create_pack_dir) -->
 2555    [ nl, 'Create directory for packages', nl ].
 2556message(menu(item(I, Label))) -->
 2557    [ '~t(~d)~6|   '-[I] ],
 2558    label(Label).
 2559message(menu(default_item(I, Label))) -->
 2560    [ '~t(~d)~6| * '-[I] ],
 2561    label(Label).
 2562message(menu(select)) -->
 2563    [ nl, 'Your choice? ', flush ].
 2564message(confirm(Question, Default)) -->
 2565    message(Question),
 2566    confirm_default(Default),
 2567    [ flush ].
 2568message(menu(reply(Min,Max))) -->
 2569    (  { Max =:= Min+1 }
 2570    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2571    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2572    ).
 2573
 2574% Alternate hashes for found for the same file
 2575
 2576message(alt_hashes(URL, _Alts)) -->
 2577    { git_url(URL, _)
 2578    },
 2579    !,
 2580    [ 'GIT repository was updated without updating version' ].
 2581message(alt_hashes(URL, Alts)) -->
 2582    { file_base_name(URL, File)
 2583    },
 2584    [ 'Found multiple versions of "~w".'-[File], nl,
 2585      'This could indicate a compromised or corrupted file', nl
 2586    ],
 2587    alt_hashes(Alts).
 2588message(continue_with_alt_hashes(Count, URL)) -->
 2589    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2590message(continue_with_modified_hash(_URL)) -->
 2591    [ 'Pack may be compromised.  Continue anyway'
 2592    ].
 2593message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2594    [ 'Content of ~q has changed.'-[URL]
 2595    ].
 2596
 2597alt_hashes([]) --> [].
 2598alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2599
 2600alt_hash(alt_hash(Count, URLs, Hash)) -->
 2601    [ '~t~d~8| ~w'-[Count, Hash] ],
 2602    alt_urls(URLs).
 2603
 2604alt_urls([]) --> [].
 2605alt_urls([H|T]) -->
 2606    [ nl, '    ~w'-[H] ],
 2607    alt_urls(T).
 2608
 2609% Installation dependencies gathered from inquiry server.
 2610
 2611message(install_dependencies(Resolution)) -->
 2612    [ 'Package depends on the following:' ],
 2613    msg_res_tokens(Resolution, 1).
 2614
 2615msg_res_tokens([], _) --> [].
 2616msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2617
 2618msg_res_token(Token-unresolved, L) -->
 2619    res_indent(L),
 2620    [ '"~w" cannot be satisfied'-[Token] ].
 2621msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2622    !,
 2623    res_indent(L),
 2624    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2625    { L2 is L+1 },
 2626    msg_res_tokens(SubResolves, L2).
 2627msg_res_token(Token-resolved(Pack), L) -->
 2628    !,
 2629    res_indent(L),
 2630    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2631
 2632res_indent(L) -->
 2633    { I is L*2 },
 2634    [ nl, '~*c'-[I,0'\s] ].
 2635
 2636message(resolve_deps) -->
 2637    [ nl, 'What do you wish to do' ].
 2638label(install_deps) -->
 2639    [ 'Install proposed dependencies' ].
 2640label(install_no_deps) -->
 2641    [ 'Only install requested package' ].
 2642
 2643
 2644message(git_fetch(Dir)) -->
 2645    [ 'Running "git fetch" in ~q'-[Dir] ].
 2646
 2647% inquiry is blank
 2648
 2649message(inquiry_ok(Reply, File)) -->
 2650    { memberchk(downloads(Count), Reply),
 2651      memberchk(rating(VoteCount, Rating), Reply),
 2652      !,
 2653      length(Stars, Rating),
 2654      maplist(=(0'*), Stars)
 2655    },
 2656    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2657      [ File, Count, Stars, VoteCount ]
 2658    ].
 2659message(inquiry_ok(Reply, File)) -->
 2660    { memberchk(downloads(Count), Reply)
 2661    },
 2662    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2663
 2664                                                % support predicates
 2665unsatisfied([]) --> [].
 2666unsatisfied([Needed-[By]|T]) -->
 2667    [ '  - "~w" is needed by package "~w"'-[Needed, By], nl ],
 2668    unsatisfied(T).
 2669unsatisfied([Needed-By|T]) -->
 2670    [ '  - "~w" is needed by the following packages:'-[Needed], nl ],
 2671    pack_list(By),
 2672    unsatisfied(T).
 2673
 2674pack_list([]) --> [].
 2675pack_list([H|T]) -->
 2676    [ '    - Package "~w"'-[H], nl ],
 2677    pack_list(T).
 2678
 2679process_lines([]) --> [].
 2680process_lines([H|T]) -->
 2681    [ '~s'-[H] ],
 2682    (   {T==[]}
 2683    ->  []
 2684    ;   [nl], process_lines(T)
 2685    ).
 2686
 2687split_lines([], []) :- !.
 2688split_lines(All, [Line1|More]) :-
 2689    append(Line1, [0'\n|Rest], All),
 2690    !,
 2691    split_lines(Rest, More).
 2692split_lines(Line, [Line]).
 2693
 2694label(remove_only(Pack)) -->
 2695    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2696label(remove_deps(Pack, Deps)) -->
 2697    { length(Deps, Count) },
 2698    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2699label(create_dir(Dir)) -->
 2700    [ '~w'-[Dir] ].
 2701label(install_from(git(URL))) -->
 2702    !,
 2703    [ 'GIT repository at ~w'-[URL] ].
 2704label(install_from(URL)) -->
 2705    [ '~w'-[URL] ].
 2706label(cancel) -->
 2707    [ 'Cancel' ].
 2708
 2709confirm_default(yes) -->
 2710    [ ' Y/n? ' ].
 2711confirm_default(no) -->
 2712    [ ' y/N? ' ].
 2713confirm_default(none) -->
 2714    [ ' y/n? ' ].
 2715
 2716msg_version(Version) -->
 2717    { atom(Version) },
 2718    !,
 2719    [ '~w'-[Version] ].
 2720msg_version(VersionData) -->
 2721    !,
 2722    { atom_version(Atom, VersionData) },
 2723    [ '~w'-[Atom] ]